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

[pscoro]

Summary

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

[pscoro]

We are looking for community input regarding the error handling for these intrinsics (and more PowerPC intrinsics to come):

• Are we ok we doing semantic checking in the handler functions like we are doing for mtfsf/mtfsfi (ie checking if constant op and in valid range)
• How should the errors be reported? The problem with using mlir::emitError is it seems to return code 0 instead of an error code >= 1, but we don't want to use fir::emitFatalError since it crashes, we would just like to terminate compilation with non-zero exit code.

[jeanPerier]

In D144876#4155708, @pscoro wrote:

We are looking for community input regarding the error handling for these intrinsics (and more PowerPC intrinsics to come):

• Are we ok we doing semantic checking in the handler functions like we are doing for mtfsf/mtfsfi (ie checking if constant op and in valid range)

So far, the semantic and evaluate libraries are the place to report user errors. Lowering is only expected to throw errors for internal errors (which may be caused by the lack of a proper semantic check), hence the usage of fir::emitFatalError. As long as having a value out of range will not put the compiler in a bad state (like reading something out of bound at compile time), lowering should rely on the value having been checked by semantics and not re-do checks.

I would say that check-expression.cpp could be the place to detect porcedures from the ppc module and to call some ppc specific validation routine: https://github.com/llvm/llvm-project/blob/27004e027312a59e3b6645f5df58e97c2a2da6ef/flang/lib/Evaluate/check-expression.cpp#L653

Better check with @klausler here though.

[klausler]

In D144876#4158418, @jeanPerier wrote:

I would say that check-expression.cpp could be the place to detect porcedures from the ppc module and to call some ppc specific validation routine: https://github.com/llvm/llvm-project/blob/27004e027312a59e3b6645f5df58e97c2a2da6ef/flang/lib/Evaluate/check-expression.cpp#L653

Better check with @klausler here though.

flang/lib/Semantics/check-call.cpp is the best place to check calls in general. If any of these new intrinsic module procedures can appear in a specification expression or constant expression, then flang/lib/Evaluate/check-expression.cpp is where that infrastructure resides.

[pscoro]

Move semantic error checking to check-call.cpp

[pscoro]

Ping.

I moved the semantic error checking code for PowerPC intrinsics into check-call.cpp. It is called from within expression.cpp
This implementation checks if an intrinsic name (after resolution) begins with "__ppc_" to determine if its a PPC intrinsic (PPC builtins scope must exist). We decided to go with this option since it can be argued that a name collision with (for e.g.) __ppc_mtfsf would be at the fault of the user, especially because double underscore names are typically reserved for the compiler.

An alternative that we also tried was creating a new flag in the Symbol class called PPCIntrinsic and setting it for the generic intrinsic when making the symbol in resolve-names.cpp. We believed the community would be less inclined to this option because of the introduction of the new symbol flag. However, let me know if this option is preferred.

[pscoro]

Ping

[klausler]

Looks okay to me before lowering; please get @clementval to review that bit.

[clementval]

Looks ok for me. Just small nits.

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

1009

Maybe it would be easier to read if you follow the same naming scheme with Void for the return type.

2031

Sounds fine for me so go ahead with an example.

[pscoro]

Addressed nits

[klausler]

flang/lib/Semantics/check-call.cpp

1234

Use CHECK(), not assert().

1238

This isn't unreachable code. Use DIE(...) or common::die(...).

1259

braced initialization here

flang/lib/Semantics/check-call.h

42

Please give names to those "int" arguments in the prototype so that a reader of this code has a fighting chance at knowing what they're supposed to mean.

flang/lib/Semantics/expression.cpp

2521

Delete "const auto ppcBuiltinScope = ". The identifier is not used and even if it were, it's now a bool, not a Scope.

[tschuett]

flang/lib/Semantics/check-call.cpp

1237

In most cases, you can remove the .has_value(). It is redundant.

1265

scalarValue.value() and *scalarValueshould be the same.

[klausler]

flang/lib/Semantics/check-call.cpp

1236

If you really want to copy the actual argument, it doesn't need to be const. If you want a reference to the actual argument, you need to put '&' before the name "argOptional". Either way, use braced initialization here.

1242

You probably want this to be a const reference, not a const-qualified copy.

[pscoro]

Addressed comments

[klausler]

flang/lib/Semantics/check-call.cpp

1234

As long as you're verifying "index", might as well ensure that it's >=0 too.

1243

Braced initialization

1246

This is not an unreachable code error. Just use CHECK(argExpr != nullptr) or (later) use the DEREF() macro.

1261

This is not an unreachable code situation.

[pscoro]

Addressed additional comments

[pscoro]

Ping.

All previous comments addressed.

[pscoro]

Ping

[klausler]

flang/lib/Semantics/check-call.cpp

1248

Better wording: "Actual argument #%d must be a constant expression".

1257

The error isn't about type conversion; it's that the value was not a constant. The crash message is misleading.

If you don't want to reword it, replace this if block with a CHECK(scalarValue.has_value()).

1263

s/expected to be/must be a/

When formatting non-"int" integer types in messages, use %jd formatting and cast the values to std::intmax_t.

[pscoro]

flang/lib/Semantics/check-call.cpp

1263

Sorry, just confused what you mean by non-"int" integer types. In this case index, upperBound and lowerBound are all of int type. I see other examples in flang where %jd with a static_cast to intmax_t is used when the actual type of the variable is not int. Wondering which variable here you wanted casted here

[pscoro]

Addressed nits

[klausler]

flang/lib/Semantics/check-call.cpp

1263

Sorry, I misread this code, and assumed that the values had come from ToInt64. Never mind!

[pscoro]

Will wait until tomorrow in case anyone in community has any last minute comments, will land this in the morning.

Thanks for the review!

[pscoro]

Missing semicolon

[pscoro]

Sorry about the -Wsign-compare problem in check-call.cpp, thanks @DamonFool for catching it so quickly. I must have been building with different error options locally and missed that error. Will try to be more careful going forward.

We were unsure for scenarios like this, where a trivial error accidentally lands, what the best course of action is. Should we be reverting the patch that caused the issue or should we be opening up a new patch to do the fix (considering its quick/trivial).

[DamonFool]

In D144876#4243507, @pscoro wrote:

We were unsure for scenarios like this, where a trivial error accidentally lands, what the best course of action is. Should we be reverting the patch that caused the issue or should we be opening up a new patch to do the fix (considering its quick/trivial).

Maybe, it would be better to just fix it.
Thanks.

flang/include/flang/Semantics/expression.h

struct CalleeAndArguments {
     std::variant<ProcedureDesignator, SymbolRef> u;
     ActualArguments arguments;
   };
 
   std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
       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 &);
   std::pair<const Symbol *, bool /* failure due ambiguity */> ResolveGeneric(
       const Symbol &, const ActualArguments &, const AdjustActuals &,
       bool isSubroutine, bool mightBeStructureConstructor = false);
   void EmitGenericResolutionError(
       const Symbol &, bool dueToNullActuals, bool isSubroutine);

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

struct IntrinsicLibrary {
   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   /// Implement all conversion functions like DBLE, the first argument is
   /// the value to convert. There may be an additional KIND arguments that
   /// 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.
   ///  - "FC funcChar" is a callback to generate the character runtime call.
   /// Helper for MinLoc/MaxLoc.
   template <typename FN, typename FD>
   fir::ExtendedValue genExtremumloc(FN func, FD funcDim, llvm::StringRef errMsg,
                                     mlir::Type,
static constexpr IntrinsicHandler handlers[]{
      &I::genVerify,
      {{{"string", asAddr},
        {"set", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}},
      /*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;
   };
   auto result = llvm::lower_bound(handlers, name, compare);
   return result != std::end(handlers) && result->name == name ? result
                                                               : 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(
     "outline-intrinsics",
     llvm::cl::desc(
         "Lower all intrinsic procedure implementation in their own functions"),
     llvm::cl::init(false));
 

 }
 
 static mlir::FunctionType genF64F64F64F64FuncType(mlir::MLIRContext *context) {
   auto t = mlir::FloatType::getF64(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);
   auto r = mlir::IntegerType::get(context, Bits);
   return mlir::FunctionType::get(context, {t}, {r});
 }
 
 template <int Bits>
 static mlir::FunctionType genIntF32FuncType(mlir::MLIRContext *context) {
return {std::visit(
                 [&](auto &generator) -> fir::ExtendedValue {
                   return invokeHandler(generator, *handler, resultType, args,
                                        outline, *this);
                 },
                 handler->generator),
             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) {
     mlir::Value val = toValue(extendedVal, builder, loc);
     if (!val)
       // If an absent optional gets there, most likely its handler has just
       // not yet been defined.
       crashOnMissingIntrinsic(loc, name);

 /// Returns a name suitable to define mlir functions for Fortran intrinsic
 /// Procedure. These names are guaranteed to not conflict with user defined
 /// procedures. This is needed to implement Fortran generic intrinsics as
 /// several mlir functions specialized for the argument types.
 /// The result is guaranteed to be distinct for different mlir::FunctionType
 /// 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");
+  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)));
   return name;
 }
 
 template <typename GeneratorType>
 mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
for (auto arg : args.drop_front()) {
     mlir::Value mask =
         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
   }
   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.
 //===----------------------------------------------------------------------===//
 
 const fir::IntrinsicArgumentLoweringRules *
 fir::getIntrinsicArgumentLowering(llvm::StringRef specificName) {
   llvm::StringRef name = genericName(specificName);
   if (const IntrinsicHandler *handler = findIntrinsicHandler(name))

flang/lib/Semantics/check-call.h

 // its characteristics are known because it is a subroutine or function
 // defined at the top level in the same source file.  Returns false if
 // messages were created, true if all is well.
 bool CheckArguments(const evaluate::characteristics::Procedure &,
     evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
     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 &,
     bool allowActualArgumentConversions = false);
 } // namespace Fortran::semantics
 #endif

flang/lib/Semantics/check-call.cpp

bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
     bool allowActualArgumentConversions) {
   return proc.HasExplicitInterface() &&
       !CheckExplicitInterface(proc, actuals, context, nullptr, nullptr,
           allowActualArgumentConversions)
            .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,
     const evaluate::SpecificIntrinsic *intrinsic) {
   bool explicitInterface{proc.HasExplicitInterface()};
   parser::ContextualMessages &messages{context.messages()};
   if (!explicitInterface || treatingExternalAsImplicit) {
     parser::Messages buffer;

flang/lib/Semantics/expression.cpp

auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
   bool isExplicitIntrinsic{ultimate.attrs().test(semantics::Attr::INTRINSIC)};
   const Symbol *resolution{nullptr};
   if (isGenericInterface || isExplicitIntrinsic) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
     auto pair{ResolveGeneric(*symbol, arguments, noAdjustment, isSubroutine,
         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);
     }
   } else if (IsProcedure(ultimate) &&
       ultimate.attrs().test(semantics::Attr::ABSTRACT)) {
     Say("Abstract procedure interface '%s' may not be referenced"_err_en_US,
         name.source);

flang/module/__fortran_ppc_intrinsics.f90

! frsqrte, frsqrtes
   end interface frsqrte
   public :: frsqrte
 
   procedure(func_r4r4x) :: __ppc_frsqrtes
   interface frsqrtes
     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

 
 !CHECK-LABEL: frsqrtes_test(x)
 subroutine frsqrtes_test(x)
   real :: x, y
   y = frsqrtes(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