[Flang][PowerPC] Implement PPC mtfsf/mtfsfi intrinsics

Implements the PowerPC mtfsf and mtfsfi intrinsics as well as introduces semantic error checking code for PowerPC intrinsics

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D144876

flang/include/flang/Semantics/expression.h

@@ -352,6 +352,7 @@ class ExpressionAnalyzer {
       const parser::ProcComponentRef &, ActualArguments &&, bool isSubroutine);
   std::optional<characteristics::Procedure> CheckCall(
       parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
+  bool CheckPPCIntrinsic(const ProcedureDesignator &, ActualArguments &);
   using AdjustActuals =
       std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
   bool ResolveForward(const Symbol &);

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -334,6 +334,10 @@ struct IntrinsicLibrary {
   /// is ignored because this is already reflected in the result type.
   mlir::Value genConversion(mlir::Type, llvm::ArrayRef<mlir::Value>);
 
+  // PPC intrinsic handlers.
+  template <bool isImm>
+  void genMtfsf(llvm::ArrayRef<fir::ExtendedValue>);
+
   /// In the template helper below:
   ///  - "FN func" is a callback to generate the related intrinsic runtime call.
   ///  - "FD funcDim" is a callback to generate the "dim" runtime call.
@@ -880,6 +884,18 @@ static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/true},
 };
 
+// PPC specific intrinsic handlers.
+static constexpr IntrinsicHandler ppcHandlers[]{
+    {"__ppc_mtfsf",
+     &I::genMtfsf<false>,
+     {{{"mask", asValue}, {"r", asValue}}},
+     /*isElemental=*/false},
+    {"__ppc_mtfsfi",
+     &I::genMtfsf<true>,
+     {{{"bf", asValue}, {"i", asValue}}},
+     /*isElemental=*/false},
+};
+
 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
   auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
     return name.compare(handler.name) > 0;
@@ -889,6 +905,15 @@ static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
                                                               : nullptr;
 }
 
+static const IntrinsicHandler *findPPCIntrinsicHandler(llvm::StringRef name) {
+  auto compare = [](const IntrinsicHandler &ppcHandler, llvm::StringRef name) {
+    return name.compare(ppcHandler.name) > 0;
+  };
+  auto result = llvm::lower_bound(ppcHandlers, name, compare);
+  return result != std::end(ppcHandlers) && result->name == name ? result
+                                                                 : nullptr;
+}
+
 /// To make fir output more readable for debug, one can outline all intrinsic
 /// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
 static llvm::cl::opt<bool> outlineAllIntrinsics(
@@ -980,6 +1005,20 @@ static mlir::FunctionType genF64F64F64F64FuncType(mlir::MLIRContext *context) {
   return mlir::FunctionType::get(context, {t, t, t}, {t});
 }
 
+template <int Bits>
+static mlir::FunctionType genVoidIntF64FuncType(mlir::MLIRContext *context) {
+  auto t = mlir::IntegerType::get(context, Bits);
+  auto u = mlir::FloatType::getF64(context);
+  return mlir::FunctionType::get(context, {t, u}, std::nullopt);
+}
+
+template <int BitsA, int BitsB>
+static mlir::FunctionType genVoidIntIntFuncType(mlir::MLIRContext *context) {
+  auto t = mlir::IntegerType::get(context, BitsA);
+  auto u = mlir::IntegerType::get(context, BitsB);
+  return mlir::FunctionType::get(context, {t, u}, std::nullopt);
+}
+
 template <int Bits>
 static mlir::FunctionType genIntF64FuncType(mlir::MLIRContext *context) {
   auto t = mlir::FloatType::getF64(context);
@@ -1865,15 +1904,30 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
             this->resultMustBeFreed};
   }
 
-  if (!resultType)
-    // Subroutine should have a handler, they are likely missing for now.
-    crashOnMissingIntrinsic(loc, name);
+  // If targeting PowerPC, check PPC intrinsic handlers.
+  auto mod = builder.getModule();
+  if (fir::getTargetTriple(mod).isPPC()) {
+    if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name)) {
+      bool outline = ppcHandler->outline || outlineAllIntrinsics;
+      return {std::visit(
+                  [&](auto &generator) -> fir::ExtendedValue {
+                    return invokeHandler(generator, *ppcHandler, resultType,
+                                         args, outline, *this);
+                  },
+                  ppcHandler->generator),
+              this->resultMustBeFreed};
+    }
+  }
 
   // Try the runtime if no special handler was defined for the
   // intrinsic being called. Maths runtime only has numerical elemental.
   // No optional arguments are expected at this point, the code will
   // crash if it gets absent optional.
 
+  if (!resultType)
+    // Subroutine should have a handler, they are likely missing for now.
+    crashOnMissingIntrinsic(loc, name);
+
   // FIXME: using toValue to get the type won't work with array arguments.
   llvm::SmallVector<mlir::Value> mlirArgs;
   for (const fir::ExtendedValue &extendedVal : args) {
@@ -1971,12 +2025,20 @@ static std::string typeToString(mlir::Type t) {
 /// arguments. The mangling pattern is:
 ///    fir.<generic name>.<result type>.<arg type>...
 /// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4
+/// For subroutines no result type is return but in order to still provide
+/// a unique mangled name, we use "void" as the return type. As in:
+///    fir.<generic name>.void.<arg type>...
+/// e.g. FREE(INTEGER(4)) is mangled as fir.free.void.i4
 static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic,
                                             mlir::FunctionType funTy) {
   std::string name = "fir.";
   name.append(intrinsic.str()).append(".");
-  assert(funTy.getNumResults() == 1 && "only function mangling supported");
-  name.append(typeToString(funTy.getResult(0)));
+  if (funTy.getNumResults() == 1)
+    name.append(typeToString(funTy.getResult(0)));
+  else if (funTy.getNumResults() == 0)
+    name.append("void");
+  else
+    llvm_unreachable("more than one result value for function");
   unsigned e = funTy.getNumInputs();
   for (decltype(e) i = 0; i < e; ++i)
     name.append(".").append(typeToString(funTy.getInput(i)));
@@ -5520,6 +5582,31 @@ mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
   return result;
 }
 
+//===----------------------------------------------------------------------===//
+// PowerPC specific intrinsic handlers.
+//===----------------------------------------------------------------------===//
+template <bool isImm>
+void IntrinsicLibrary::genMtfsf(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 2);
+  llvm::SmallVector<mlir::Value> scalarArgs;
+  for (const fir::ExtendedValue &arg : args)
+    if (arg.getUnboxed())
+      scalarArgs.emplace_back(fir::getBase(arg));
+    else
+      mlir::emitError(loc, "nonscalar intrinsic argument");
+
+  mlir::FunctionType libFuncType;
+  mlir::func::FuncOp funcOp;
+  if (isImm) {
+    libFuncType = genVoidIntIntFuncType<32, 32>(builder.getContext());
+    funcOp = builder.addNamedFunction(loc, "llvm.ppc.mtfsfi", libFuncType);
+  } else {
+    libFuncType = genVoidIntF64FuncType<32>(builder.getContext());
+    funcOp = builder.addNamedFunction(loc, "llvm.ppc.mtfsf", libFuncType);
+  }
+  builder.create<fir::CallOp>(loc, funcOp, scalarArgs);
+}
+
 //===----------------------------------------------------------------------===//
 // Argument lowering rules interface for intrinsic or intrinsic module
 // procedure.

flang/lib/Semantics/check-call.cpp

@@ -1228,6 +1228,57 @@ bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
            .AnyFatalError();
 }
 
+bool CheckArgumentIsConstantExprInRange(
+    const evaluate::ActualArguments &actuals, int index, int lowerBound,
+    int upperBound, parser::ContextualMessages &messages) {
+  CHECK(index >= 0 && index < actuals.size());
+
+  const std::optional<evaluate::ActualArgument> &argOptional{actuals[index]};
+  if (!argOptional) {
+    DIE("Actual argument should have value");
+    return false;
+  }
+
+  const evaluate::ActualArgument &arg{argOptional.value()};
+  const evaluate::Expr<evaluate::SomeType> *argExpr{arg.UnwrapExpr()};
+  CHECK(argExpr != nullptr);
+
+  if (!IsConstantExpr(*argExpr)) {
+    messages.Say("Actual argument #%d must be a constant expression"_err_en_US,
+        index + 1);
+    return false;
+  }
+
+  // This does not imply that the kind of the argument is 8. The kind
+  // for the intrinsic's argument should have been check prior. This is just
+  // a conversion so that we can read the constant value.
+  auto scalarValue{evaluate::ToInt64(argExpr)};
+  CHECK(scalarValue.has_value());
+
+  if (*scalarValue < lowerBound || *scalarValue > upperBound) {
+    messages.Say(
+        "Argument #%d must be a constant expression in range %d-%d"_err_en_US,
+        index + 1, lowerBound, upperBound);
+    return false;
+  }
+  return true;
+}
+
+bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
+    const evaluate::ActualArguments &actuals,
+    evaluate::FoldingContext &context) {
+  parser::ContextualMessages &messages{context.messages()};
+
+  if (specific.name() == "__ppc_mtfsf") {
+    return CheckArgumentIsConstantExprInRange(actuals, 0, 0, 7, messages);
+  }
+  if (specific.name() == "__ppc_mtfsfi") {
+    return CheckArgumentIsConstantExprInRange(actuals, 0, 0, 7, messages) &&
+        CheckArgumentIsConstantExprInRange(actuals, 1, 0, 15, messages);
+  }
+  return false;
+}
+
 bool CheckArguments(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
     const Scope &scope, bool treatingExternalAsImplicit,

flang/lib/Semantics/check-call.h

@@ -37,6 +37,13 @@ bool CheckArguments(const evaluate::characteristics::Procedure &,
     bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic);
 
+bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
+    const evaluate::ActualArguments &actuals,
+    evaluate::FoldingContext &context);
+bool CheckArgumentIsConstantExprInRange(
+    const evaluate::ActualArguments &actuals, int index, int lowerBound,
+    int upperBound, parser::ContextualMessages &messages);
+
 // Checks actual arguments for the purpose of resolving a generic interface.
 bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
     evaluate::ActualArguments &, const evaluate::FoldingContext &,

flang/lib/Semantics/expression.cpp

@@ -2518,6 +2518,11 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
         mightBeStructureConstructor)};
     resolution = pair.first;
     dueToAmbiguity = pair.second;
+    if (context_.GetPPCBuiltinsScope() &&
+        resolution->name().ToString().rfind("__ppc_", 0) == 0) {
+      semantics::CheckPPCIntrinsic(
+          *symbol, *resolution, arguments, GetFoldingContext());
+    }
     if (resolution) {
       // re-resolve name to the specific procedure
       name.symbol = const_cast<Symbol *>(resolution);

flang/module/__fortran_ppc_intrinsics.f90

@@ -157,4 +157,21 @@ end function func_r8r8i
     procedure :: __ppc_frsqrtes
   end interface frsqrtes
   public :: frsqrtes
+
+! mtfsf, mtfsfi
+  interface mtfsf
+    subroutine __ppc_mtfsf(mask, r)
+      integer(4), intent(in) :: mask
+      real(8), intent(in) :: r
+    end subroutine __ppc_mtfsf
+  end interface mtfsf
+  public :: mtfsf
+
+  interface mtfsfi
+    subroutine __ppc_mtfsfi(bf, i)
+      integer(4), intent(in) :: bf
+      integer(4), intent(in) :: i
+    end subroutine __ppc_mtfsfi
+  end interface mtfsfi
+  public :: mtfsfi
 end module __Fortran_PPC_intrinsics

flang/test/Lower/ppc-intrinsics.f90

@@ -185,3 +185,18 @@ subroutine frsqrtes_test(x)
 ! CHECK-FIR: fir.call @fir.__ppc_frsqrtes.f32.f32
 ! CHECK-LLVMIR: call contract float @llvm.ppc.frsqrtes(float %{{[0-9]}})
 end
+
+! CHECK-LABEL: mtfsf_test
+subroutine mtfsf_test(r)
+  real(8) :: r
+  call mtfsf(1, r)
+! CHECK-FIR: fir.call @fir.__ppc_mtfsf.void.i32.f64
+! CHECK-LLVMIR: call void @llvm.ppc.mtfsf(i32 {{[0-9]}}, double %{{[0-9]}})
+end
+
+! CHECK-LABEL: mtfsfi_test
+subroutine mtfsfi_test()
+  call mtfsfi(1, 2)
+! CHECK-FIR: fir.call @fir.__ppc_mtfsfi.void.i32.i32
+! CHECK-LLVMIR: call void @llvm.ppc.mtfsfi(i32 {{[0-9]}}, i32 {{[0-9]}})
+end