[flang-commits] [flang] [flang] allow intrinsic module procedures to be implemented in Fortran (PR #97743)

via flang-commits flang-commits at lists.llvm.org
Thu Jul 4 08:27:16 PDT 2024


https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/97743

Currently, all procedures from intrinsic modules that are not BIND(C) are expected to be intercepted by the compiler in lowering and to have a handler in IntrinsicCall.cpp.

As more "intrinsic" modules are being added (OpenMP, OpenACC, CUF, ...), this requirement is preventing seamless implementation of intrinsic modules in Fortran. Procedures from intrinsic modules are different from generic intrinsics defined in section 16 of the standard. They are declared in Fortran file seating in the intrinsic module directory and inside the compiler they look like regular user call except for the INTRINSIC attribute set on their module. So an easy implementation is just to have the implementation done in Fortran and linked to the runtime without any need for the compiler to necessarily understand and handle these calls in special ways.

This patch splits the lookup and generation part of IntrinsicCall.cpp so that it can be allowed to only intercept calls to procedure from intrinsic module if they have a handler. Otherwise, the assumption is that they should be implemented in Fortran.

Add explicit TODOs handler for the IEEE procedure that are known to not yet been implemented and won't be implemented via Fortran code so that this patch is an NFC for what is currently supported.

This patch also prevents doing two lookups in the intrinsic table (There was one to get argument lowering rules, and another one to generate the code).

>From 8217ecaaff4c92e7e2ffd895599a66907d78bd3d Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 4 Jul 2024 08:09:13 -0700
Subject: [PATCH] [flang] allow intrinsic module procedures to be implemented
 in Fortran

---
 .../flang/Optimizer/Builder/IntrinsicCall.h   |  34 +++
 flang/lib/Lower/ConvertCall.cpp               |  99 +++++---
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 217 +++++++++++++-----
 3 files changed, 252 insertions(+), 98 deletions(-)

diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index ec1fb411ff0e2..87a91820fd246 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -25,6 +25,7 @@
 namespace fir {
 
 class StatementContext;
+struct IntrinsicHandlerEntry;
 
 // TODO: Error handling interface ?
 // TODO: Implementation is incomplete. Many intrinsics to tbd.
@@ -38,6 +39,13 @@ genIntrinsicCall(fir::FirOpBuilder &, mlir::Location, llvm::StringRef name,
                  llvm::ArrayRef<fir::ExtendedValue> args,
                  Fortran::lower::AbstractConverter *converter = nullptr);
 
+std::pair<fir::ExtendedValue, bool>
+genIntrinsicCall(fir::FirOpBuilder &, mlir::Location,
+                 const IntrinsicHandlerEntry &,
+                 std::optional<mlir::Type> resultType,
+                 llvm::ArrayRef<fir::ExtendedValue> args,
+                 Fortran::lower::AbstractConverter *converter = nullptr);
+
 /// Enums used to templatize and share lowering of MIN and MAX.
 enum class Extremum { Min, Max };
 
@@ -156,6 +164,11 @@ struct IntrinsicLibrary {
   getRuntimeCallGenerator(llvm::StringRef name,
                           mlir::FunctionType soughtFuncType);
 
+  /// Helper to generate TODOs for module procedures that must be intercepted in
+  /// lowering and are not yet implemented.
+  template <const char *intrinsicName>
+  void genModuleProcTODO(llvm::ArrayRef<fir::ExtendedValue>);
+
   void genAbort(llvm::ArrayRef<fir::ExtendedValue>);
   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
@@ -676,6 +689,18 @@ static inline mlir::FunctionType genFuncType(mlir::MLIRContext *context,
   return mlir::FunctionType::get(context, argTypes, {resType});
 }
 
+/// Entry into the tables describing how an intrinsic must be lowered.
+struct IntrinsicHandlerEntry {
+  using RuntimeGeneratorRange =
+      std::pair<const MathOperation *, const MathOperation *>;
+  IntrinsicHandlerEntry(const IntrinsicHandler *handler) : entry{handler} {
+    assert(handler && "handler must not be nullptr");
+  };
+  IntrinsicHandlerEntry(RuntimeGeneratorRange rt) : entry{rt} {};
+  const IntrinsicArgumentLoweringRules *getArgumentLoweringRules() const;
+  std::variant<const IntrinsicHandler *, RuntimeGeneratorRange> entry;
+};
+
 //===----------------------------------------------------------------------===//
 // Helper functions for argument handling.
 //===----------------------------------------------------------------------===//
@@ -728,6 +753,15 @@ mlir::Value genLibSplitComplexArgsCall(fir::FirOpBuilder &builder,
                                        mlir::FunctionType libFuncType,
                                        llvm::ArrayRef<mlir::Value> args);
 
+/// Lookup for a handler or runtime call generator to lower intrinsic
+/// \p intrinsicName.
+std::optional<IntrinsicHandlerEntry>
+lookupIntrinsicHandler(fir::FirOpBuilder &, llvm::StringRef intrinsicName,
+                       std::optional<mlir::Type> resultType);
+
+/// Generate a TODO error message for an as yet unimplemented intrinsic.
+void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name);
+
 /// Return argument lowering rules for an intrinsic.
 /// Returns a nullptr if all the intrinsic arguments should be lowered by value.
 const IntrinsicArgumentLoweringRules *
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 5e20f9eee4fc9..54e29a1d60689 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1841,7 +1841,7 @@ static std::optional<hlfir::EntityWithAttributes> genCustomIntrinsicRefCore(
 static std::optional<hlfir::EntityWithAttributes>
 genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
                     const Fortran::evaluate::SpecificIntrinsic *intrinsic,
-                    const fir::IntrinsicArgumentLoweringRules *argLowering,
+                    const fir::IntrinsicHandlerEntry &intrinsicEntry,
                     CallContext &callContext) {
   auto &converter = callContext.converter;
   if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
@@ -1856,6 +1856,8 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
   auto &stmtCtx = callContext.stmtCtx;
   fir::FirOpBuilder &builder = callContext.getBuilder();
   mlir::Location loc = callContext.loc;
+  const fir::IntrinsicArgumentLoweringRules *argLowering =
+      intrinsicEntry.getArgumentLoweringRules();
   for (auto arg : llvm::enumerate(loweredActuals)) {
     if (!arg.value()) {
       operands.emplace_back(fir::getAbsentIntrinsicArgument());
@@ -1991,7 +1993,7 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
   const std::string intrinsicName = callContext.getProcedureName();
   // Let the intrinsic library lower the intrinsic procedure call.
   auto [resultExv, mustBeFreed] = genIntrinsicCall(
-      builder, loc, intrinsicName, scalarResultType, operands, &converter);
+      builder, loc, intrinsicEntry, scalarResultType, operands, &converter);
   for (const hlfir::CleanupFunction &fn : cleanupFns)
     fn();
   if (!fir::getBase(resultExv))
@@ -2023,18 +2025,16 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
 static std::optional<hlfir::EntityWithAttributes> genHLFIRIntrinsicRefCore(
     Fortran::lower::PreparedActualArguments &loweredActuals,
     const Fortran::evaluate::SpecificIntrinsic *intrinsic,
-    const fir::IntrinsicArgumentLoweringRules *argLowering,
+    const fir::IntrinsicHandlerEntry &intrinsicEntry,
     CallContext &callContext) {
-  if (!useHlfirIntrinsicOps)
-    return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
-                               callContext);
-
-  fir::FirOpBuilder &builder = callContext.getBuilder();
-  mlir::Location loc = callContext.loc;
-  const std::string intrinsicName = callContext.getProcedureName();
-
-  // transformational intrinsic ops always have a result type
-  if (callContext.resultType) {
+  // Try lowering transformational intrinsic ops to HLFIR ops if enabled
+  // (transformational always have a result type)
+  if (useHlfirIntrinsicOps && callContext.resultType) {
+    fir::FirOpBuilder &builder = callContext.getBuilder();
+    mlir::Location loc = callContext.loc;
+    const std::string intrinsicName = callContext.getProcedureName();
+    const fir::IntrinsicArgumentLoweringRules *argLowering =
+        intrinsicEntry.getArgumentLoweringRules();
     std::optional<hlfir::EntityWithAttributes> res =
         Fortran::lower::lowerHlfirIntrinsic(builder, loc, intrinsicName,
                                             loweredActuals, argLowering,
@@ -2044,7 +2044,7 @@ static std::optional<hlfir::EntityWithAttributes> genHLFIRIntrinsicRefCore(
   }
 
   // fallback to calling the intrinsic via fir.call
-  return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
+  return genIntrinsicRefCore(loweredActuals, intrinsic, intrinsicEntry,
                              callContext);
 }
 
@@ -2303,13 +2303,13 @@ class ElementalIntrinsicCallBuilder
 public:
   ElementalIntrinsicCallBuilder(
       const Fortran::evaluate::SpecificIntrinsic *intrinsic,
-      const fir::IntrinsicArgumentLoweringRules *argLowering, bool isFunction)
-      : intrinsic{intrinsic}, argLowering{argLowering}, isFunction{isFunction} {
-  }
+      const fir::IntrinsicHandlerEntry &intrinsicEntry, bool isFunction)
+      : intrinsic{intrinsic}, intrinsicEntry{intrinsicEntry},
+        isFunction{isFunction} {}
   std::optional<hlfir::Entity>
   genElementalKernel(Fortran::lower::PreparedActualArguments &loweredActuals,
                      CallContext &callContext) {
-    return genHLFIRIntrinsicRefCore(loweredActuals, intrinsic, argLowering,
+    return genHLFIRIntrinsicRefCore(loweredActuals, intrinsic, intrinsicEntry,
                                     callContext);
   }
   // Elemental intrinsic functions cannot modify their arguments.
@@ -2363,7 +2363,7 @@ class ElementalIntrinsicCallBuilder
 
 private:
   const Fortran::evaluate::SpecificIntrinsic *intrinsic;
-  const fir::IntrinsicArgumentLoweringRules *argLowering;
+  fir::IntrinsicHandlerEntry intrinsicEntry;
   const bool isFunction;
 };
 } // namespace
@@ -2436,11 +2436,16 @@ genCustomElementalIntrinsicRef(
       callContext.procRef, *intrinsic, callContext.resultType,
       prepareOptionalArg, prepareOtherArg, converter);
 
-  const fir::IntrinsicArgumentLoweringRules *argLowering =
-      fir::getIntrinsicArgumentLowering(callContext.getProcedureName());
+  std::optional<fir::IntrinsicHandlerEntry> intrinsicEntry =
+      fir::lookupIntrinsicHandler(callContext.getBuilder(),
+                                  callContext.getProcedureName(),
+                                  callContext.resultType);
+  assert(intrinsicEntry.has_value() &&
+         "intrinsic with custom handling for OPTIONAL arguments must have "
+         "lowering entries");
   // All of the custom intrinsic elementals with custom handling are pure
   // functions
-  return ElementalIntrinsicCallBuilder{intrinsic, argLowering,
+  return ElementalIntrinsicCallBuilder{intrinsic, *intrinsicEntry,
                                        /*isFunction=*/true}
       .genElementalCall(operands, /*isImpure=*/false, callContext);
 }
@@ -2517,21 +2522,15 @@ genCustomIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
 /// lowered as if it were an intrinsic module procedure (like C_LOC which is a
 /// procedure from intrinsic module iso_c_binding). Otherwise, \p intrinsic
 /// must not be null.
+
 static std::optional<hlfir::EntityWithAttributes>
 genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
+                const fir::IntrinsicHandlerEntry &intrinsicEntry,
                 CallContext &callContext) {
   mlir::Location loc = callContext.loc;
-  auto &converter = callContext.converter;
-  if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
-                       callContext.procRef, *intrinsic, converter)) {
-    if (callContext.isElementalProcWithArrayArgs())
-      return genCustomElementalIntrinsicRef(intrinsic, callContext);
-    return genCustomIntrinsicRef(intrinsic, callContext);
-  }
-
   Fortran::lower::PreparedActualArguments loweredActuals;
   const fir::IntrinsicArgumentLoweringRules *argLowering =
-      fir::getIntrinsicArgumentLowering(callContext.getProcedureName());
+      intrinsicEntry.getArgumentLoweringRules();
   for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) {
 
     if (!arg.value()) {
@@ -2581,12 +2580,12 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
   if (callContext.isElementalProcWithArrayArgs()) {
     // All intrinsic elemental functions are pure.
     const bool isFunction = callContext.resultType.has_value();
-    return ElementalIntrinsicCallBuilder{intrinsic, argLowering, isFunction}
+    return ElementalIntrinsicCallBuilder{intrinsic, intrinsicEntry, isFunction}
         .genElementalCall(loweredActuals, /*isImpure=*/!isFunction,
                           callContext);
   }
   std::optional<hlfir::EntityWithAttributes> result = genHLFIRIntrinsicRefCore(
-      loweredActuals, intrinsic, argLowering, callContext);
+      loweredActuals, intrinsic, intrinsicEntry, callContext);
   if (result && mlir::isa<hlfir::ExprType>(result->getType())) {
     fir::FirOpBuilder *bldr = &callContext.getBuilder();
     callContext.stmtCtx.attachCleanup(
@@ -2595,18 +2594,43 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
   return result;
 }
 
+static std::optional<hlfir::EntityWithAttributes>
+genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
+                CallContext &callContext) {
+  mlir::Location loc = callContext.loc;
+  auto &converter = callContext.converter;
+  if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling(
+                       callContext.procRef, *intrinsic, converter)) {
+    if (callContext.isElementalProcWithArrayArgs())
+      return genCustomElementalIntrinsicRef(intrinsic, callContext);
+    return genCustomIntrinsicRef(intrinsic, callContext);
+  }
+  std::optional<fir::IntrinsicHandlerEntry> intrinsicEntry =
+      fir::lookupIntrinsicHandler(callContext.getBuilder(),
+                                  callContext.getProcedureName(),
+                                  callContext.resultType);
+  if (!intrinsicEntry)
+    fir::crashOnMissingIntrinsic(loc, callContext.getProcedureName());
+  return genIntrinsicRef(intrinsic, *intrinsicEntry, callContext);
+}
+
 /// Main entry point to lower procedure references, regardless of what they are.
 static std::optional<hlfir::EntityWithAttributes>
 genProcedureRef(CallContext &callContext) {
   mlir::Location loc = callContext.loc;
+  fir::FirOpBuilder &builder = callContext.getBuilder();
   if (auto *intrinsic = callContext.procRef.proc().GetSpecificIntrinsic())
     return genIntrinsicRef(intrinsic, callContext);
-  // If it is an intrinsic module procedure reference - then treat as
-  // intrinsic unless it is bind(c) (since implementation is external from
-  // module).
+  // Intercept non BIND(C) module procedure reference that have lowering
+  // handlers defined for there name. Otherwise, lower them as user
+  // procedure calls and expect the implementation to be part of
+  // runtime libraries with the proper name mangling.
   if (Fortran::lower::isIntrinsicModuleProcRef(callContext.procRef) &&
       !callContext.isBindcCall())
-    return genIntrinsicRef(nullptr, callContext);
+    if (std::optional<fir::IntrinsicHandlerEntry> intrinsicEntry =
+            fir::lookupIntrinsicHandler(builder, callContext.getProcedureName(),
+                                        callContext.resultType))
+      return genIntrinsicRef(nullptr, *intrinsicEntry, callContext);
 
   if (callContext.isStatementFunctionCall())
     return genStmtFunctionRef(loc, callContext.converter, callContext.symMap,
@@ -2641,7 +2665,6 @@ genProcedureRef(CallContext &callContext) {
           // TYPE(*) cannot be ALLOCATABLE/POINTER (C709) so there is no
           // need to cover the case of passing an ALLOCATABLE/POINTER to an
           // OPTIONAL.
-          fir::FirOpBuilder &builder = callContext.getBuilder();
           isPresent =
               builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), actual)
                   .getResult();
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index a1cef7437fa2d..f4541bf30676a 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -95,6 +95,17 @@ static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
   return !isStaticallyAbsent(exv);
 }
 
+/// IEEE module procedure names not yet implemented for genModuleProcTODO.
+static constexpr char ieee_int[] = "ieee_int";
+static constexpr char ieee_get_underflow_mode[] = "ieee_get_underflow_mode";
+static constexpr char ieee_next_after[] = "ieee_next_after";
+static constexpr char ieee_next_down[] = "ieee_next_down";
+static constexpr char ieee_next_up[] = "ieee_next_up";
+static constexpr char ieee_real[] = "ieee_real";
+static constexpr char ieee_rem[] = "ieee_rem";
+static constexpr char ieee_rint[] = "ieee_rint";
+static constexpr char ieee_set_underflow_mode[] = "ieee_set_underflow_mode";
+
 using I = IntrinsicLibrary;
 
 /// Flag to indicate that an intrinsic argument has to be handled as
@@ -321,6 +332,8 @@ static constexpr IntrinsicHandler handlers[]{
        {"radix", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"ieee_get_status", &I::genIeeeGetOrSetStatus</*isGet=*/true>},
+    {"ieee_get_underflow_mode", &I::genModuleProcTODO<ieee_get_underflow_mode>},
+    {"ieee_int", &I::genModuleProcTODO<ieee_int>},
     {"ieee_is_finite", &I::genIeeeIsFinite},
     {"ieee_is_nan", &I::genIeeeIsNan},
     {"ieee_is_negative", &I::genIeeeIsNegative},
@@ -342,12 +355,18 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/false>},
     {"ieee_min_num_mag",
      &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/true>},
+    {"ieee_next_after", &I::genModuleProcTODO<ieee_next_after>},
+    {"ieee_next_down", &I::genModuleProcTODO<ieee_next_down>},
+    {"ieee_next_up", &I::genModuleProcTODO<ieee_next_up>},
     {"ieee_quiet_eq", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OEQ>},
     {"ieee_quiet_ge", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGE>},
     {"ieee_quiet_gt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGT>},
     {"ieee_quiet_le", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLE>},
     {"ieee_quiet_lt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLT>},
     {"ieee_quiet_ne", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::UNE>},
+    {"ieee_real", &I::genModuleProcTODO<ieee_real>},
+    {"ieee_rem", &I::genModuleProcTODO<ieee_rem>},
+    {"ieee_rint", &I::genModuleProcTODO<ieee_rint>},
     {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
     {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
     {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>},
@@ -360,6 +379,7 @@ static constexpr IntrinsicHandler handlers[]{
        {"radix", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"ieee_set_status", &I::genIeeeGetOrSetStatus</*isGet=*/false>},
+    {"ieee_set_underflow_mode", &I::genModuleProcTODO<ieee_set_underflow_mode>},
     {"ieee_signaling_eq",
      &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},
     {"ieee_signaling_ge",
@@ -1493,17 +1513,11 @@ static_assert(mathOps.Verify() && "map must be sorted");
 /// \p bestMatchDistance specifies the FunctionDistance between
 /// the requested operation and the non-exact match.
 static const MathOperation *
-searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name,
+searchMathOperation(fir::FirOpBuilder &builder,
+                    const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,
                     mlir::FunctionType funcType,
                     const MathOperation **bestNearMatch,
                     FunctionDistance &bestMatchDistance) {
-  auto range = mathOps.equal_range(name);
-  auto mod = builder.getModule();
-
-  // Search ppcMathOps only if targetting PowerPC arch
-  if (fir::getTargetTriple(mod).isPPC() && range.first == range.second) {
-    range = checkPPCMathOperationsRange(name);
-  }
   for (auto iter = range.first; iter != range.second && iter; ++iter) {
     const auto &impl = *iter;
     auto implType = impl.typeGenerator(builder.getContext(), builder);
@@ -1649,8 +1663,46 @@ llvm::StringRef genericName(llvm::StringRef specificName) {
   return name.drop_back(name.size() - size);
 }
 
+std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>
+lookupRuntimeGenerator(llvm::StringRef name, bool isPPCTarget) {
+  if (auto range = mathOps.equal_range(name); range.first != range.second)
+    return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>(
+        range);
+  // Search ppcMathOps only if targetting PowerPC arch
+  if (isPPCTarget)
+    if (auto range = checkPPCMathOperationsRange(name);
+        range.first != range.second)
+      return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>(
+          range);
+  return std::nullopt;
+}
+
+std::optional<IntrinsicHandlerEntry>
+lookupIntrinsicHandler(fir::FirOpBuilder &builder,
+                       llvm::StringRef intrinsicName,
+                       std::optional<mlir::Type> resultType) {
+  llvm::StringRef name = genericName(intrinsicName);
+  if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
+    return std::make_optional<IntrinsicHandlerEntry>(handler);
+  bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC();
+  // If targeting PowerPC, check PPC intrinsic handlers.
+  if (isPPCTarget)
+    if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name))
+      return std::make_optional<IntrinsicHandlerEntry>(ppcHandler);
+  // Subroutines should have a handler.
+  if (!resultType)
+    return std::nullopt;
+  // Try the runtime if no special handler was defined for the
+  // intrinsic being called. Maths runtime only has numerical elemental.
+  if (auto runtimeGeneratorRange = lookupRuntimeGenerator(name, isPPCTarget))
+    return std::make_optional<IntrinsicHandlerEntry>(*runtimeGeneratorRange);
+  return std::nullopt;
+}
+
 /// Generate a TODO error message for an as yet unimplemented intrinsic.
-void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
+void crashOnMissingIntrinsic(mlir::Location loc,
+                             llvm::StringRef intrinsicName) {
+  llvm::StringRef name = genericName(intrinsicName);
   if (isIntrinsicModuleProcedure(name))
     TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
   else if (isCoarrayIntrinsic(name))
@@ -1782,46 +1834,33 @@ invokeHandler(IntrinsicLibrary::DualGenerator generator,
   return std::invoke(generator, lib, resultType, args);
 }
 
-std::pair<fir::ExtendedValue, bool>
-IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
-                                   std::optional<mlir::Type> resultType,
-                                   llvm::ArrayRef<fir::ExtendedValue> args) {
-  llvm::StringRef name = genericName(specificName);
-  if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
-    bool outline = handler->outline || outlineAllIntrinsics;
-    return {Fortran::common::visit(
-                [&](auto &generator) -> fir::ExtendedValue {
-                  return invokeHandler(generator, *handler, resultType, args,
-                                       outline, *this);
-                },
-                handler->generator),
-            this->resultMustBeFreed};
-  }
-
-  // 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 {Fortran::common::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.
+static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper(
+    const IntrinsicHandler *handler, std::optional<mlir::Type> resultType,
+    llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) {
+  assert(handler && "must be set");
+  bool outline = handler->outline || outlineAllIntrinsics;
+  return {Fortran::common::visit(
+              [&](auto &generator) -> fir::ExtendedValue {
+                return invokeHandler(generator, *handler, resultType, args,
+                                     outline, lib);
+              },
+              handler->generator),
+          lib.resultMustBeFreed};
+}
 
-  if (!resultType)
-    // Subroutine should have a handler, they are likely missing for now.
-    crashOnMissingIntrinsic(loc, name);
+static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper(
+    const IntrinsicHandlerEntry::RuntimeGeneratorRange &, mlir::FunctionType,
+    fir::FirOpBuilder &, mlir::Location);
 
+static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper(
+    const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,
+    std::optional<mlir::Type> resultType,
+    llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) {
+  assert(resultType.has_value() && "RuntimeGenerator are for functions only");
+  assert(range.first != nullptr && "range should not be empty");
+  fir::FirOpBuilder &builder = lib.builder;
+  mlir::Location loc = lib.loc;
+  llvm::StringRef name = range.first->key;
   // FIXME: using toValue to get the type won't work with array arguments.
   llvm::SmallVector<mlir::Value> mlirArgs;
   for (const fir::ExtendedValue &extendedVal : args) {
@@ -1836,10 +1875,39 @@ IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
       getFunctionType(*resultType, mlirArgs, builder);
 
   IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
-      getRuntimeCallGenerator(name, soughtFuncType);
-  return {genElementalCall(runtimeCallGenerator, name, *resultType, args,
-                           /*outline=*/outlineAllIntrinsics),
-          resultMustBeFreed};
+      getRuntimeCallGeneratorHelper(range, soughtFuncType, builder, loc);
+  return {lib.genElementalCall(runtimeCallGenerator, name, *resultType, args,
+                               /*outline=*/outlineAllIntrinsics),
+          lib.resultMustBeFreed};
+}
+
+std::pair<fir::ExtendedValue, bool>
+genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
+                 const IntrinsicHandlerEntry &intrinsic,
+                 std::optional<mlir::Type> resultType,
+                 llvm::ArrayRef<fir::ExtendedValue> args,
+                 Fortran::lower::AbstractConverter *converter) {
+  IntrinsicLibrary library{builder, loc, converter};
+  return std::visit(
+      [&](auto handler) -> auto {
+        return genIntrinsicCallHelper(handler, resultType, args, library);
+      },
+      intrinsic.entry);
+}
+
+std::pair<fir::ExtendedValue, bool>
+IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
+                                   std::optional<mlir::Type> resultType,
+                                   llvm::ArrayRef<fir::ExtendedValue> args) {
+  std::optional<IntrinsicHandlerEntry> intrinsic =
+      lookupIntrinsicHandler(builder, specificName, resultType);
+  if (!intrinsic.has_value())
+    crashOnMissingIntrinsic(loc, specificName);
+  return std::visit(
+      [&](auto handler) -> auto {
+        return genIntrinsicCallHelper(handler, resultType, args, *this);
+      },
+      intrinsic->entry);
 }
 
 mlir::Value
@@ -2082,19 +2150,19 @@ fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
   return mlir::Value{};
 }
 
-IntrinsicLibrary::RuntimeCallGenerator
-IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
-                                          mlir::FunctionType soughtFuncType) {
-  mlir::FunctionType actualFuncType;
-  const MathOperation *mathOp = nullptr;
-
+static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper(
+    const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,
+    mlir::FunctionType soughtFuncType, fir::FirOpBuilder &builder,
+    mlir::Location loc) {
+  assert(range.first != nullptr && "range should not be empty");
+  llvm::StringRef name = range.first->key;
   // Look for a dedicated math operation generator, which
   // normally produces a single MLIR operation implementing
   // the math operation.
   const MathOperation *bestNearMatch = nullptr;
   FunctionDistance bestMatchDistance;
-  mathOp = searchMathOperation(builder, name, soughtFuncType, &bestNearMatch,
-                               bestMatchDistance);
+  const MathOperation *mathOp = searchMathOperation(
+      builder, range, soughtFuncType, &bestNearMatch, bestMatchDistance);
   if (!mathOp && bestNearMatch) {
     // Use the best near match, optionally issuing an error,
     // if types conversions cause precision loss.
@@ -2109,7 +2177,8 @@ IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
     crashOnMissingIntrinsic(loc, nameAndType);
   }
 
-  actualFuncType = mathOp->typeGenerator(builder.getContext(), builder);
+  mlir::FunctionType actualFuncType =
+      mathOp->typeGenerator(builder.getContext(), builder);
 
   assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
          actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
@@ -2128,6 +2197,17 @@ IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
   };
 }
 
+IntrinsicLibrary::RuntimeCallGenerator
+IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
+                                          mlir::FunctionType soughtFuncType) {
+  bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC();
+  std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange> range =
+      lookupRuntimeGenerator(name, isPPCTarget);
+  if (!range.has_value())
+    crashOnMissingIntrinsic(loc, name);
+  return getRuntimeCallGeneratorHelper(*range, soughtFuncType, builder, loc);
+}
+
 mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
     llvm::StringRef name, mlir::FunctionType signature) {
   // Unrestricted intrinsics signature follows implicit rules: argument
@@ -2214,6 +2294,12 @@ mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
   return builder.convertWithSemantics(loc, resultType, args[0]);
 }
 
+template <const char *intrinsicName>
+void IntrinsicLibrary::genModuleProcTODO(
+    llvm::ArrayRef<fir::ExtendedValue> args) {
+  crashOnMissingIntrinsic(loc, intrinsicName);
+}
+
 // ABORT
 void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 0);
@@ -7076,6 +7162,17 @@ getIntrinsicArgumentLowering(llvm::StringRef specificName) {
   return nullptr;
 }
 
+const IntrinsicArgumentLoweringRules *
+IntrinsicHandlerEntry::getArgumentLoweringRules() const {
+  if (const IntrinsicHandler *const *handler =
+          std::get_if<const IntrinsicHandler *>(&entry)) {
+    assert(*handler);
+    if (!(*handler)->argLoweringRules.hasDefaultRules())
+      return &(*handler)->argLoweringRules;
+  }
+  return nullptr;
+}
+
 /// Return how argument \p argName should be lowered given the rules for the
 /// intrinsic function.
 fir::ArgLoweringRule



More information about the flang-commits mailing list