[flang-commits] [flang] [Flang] Add partial support for lowering procedure pointer assignment. (PR #70461)

Daniel Chen via flang-commits flang-commits at lists.llvm.org
Fri Oct 27 20:26:03 PDT 2023


https://github.com/DanielCChen updated https://github.com/llvm/llvm-project/pull/70461

>From 6ca8970b425dcb478af03b1d2efbf26c0a91a63d Mon Sep 17 00:00:00 2001
From: Daniel Chen <cdchen at ca.ibm.com>
Date: Fri, 27 Oct 2023 10:35:31 -0400
Subject: [PATCH 1/4] [Flang] Add partial support for lowering procedure
 pointer assignment.

---
 flang/lib/Lower/Bridge.cpp                    |  9 ++-
 flang/lib/Lower/ConvertCall.cpp               | 10 +++-
 .../lib/Lower/ConvertProcedureDesignator.cpp  |  4 ++
 flang/lib/Lower/ConvertType.cpp               | 51 +++++++++++++++-
 flang/lib/Lower/ConvertVariable.cpp           | 59 +++++++++++++++++--
 5 files changed, 122 insertions(+), 11 deletions(-)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 9875e37393ef869..b2f00fac481f909 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3224,8 +3224,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
-    if (Fortran::evaluate::IsProcedure(assign.rhs))
-      TODO(loc, "procedure pointer assignment");
+
+    if (Fortran::evaluate::IsProcedure(assign.rhs)) {
+      auto lhs{fir::getBase(genExprAddr(assign.lhs, stmtCtx, &loc))};
+      auto rhs{fir::getBase(genExprAddr(assign.rhs, stmtCtx, &loc))};
+      builder->create<fir::StoreOp>(loc, rhs, lhs);
+      return;
+    }
 
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index bc9426827c3ba1d..6918001a3f17baa 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -165,8 +165,10 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // will be used only if there is no explicit length in the local interface).
   mlir::Value funcPointer;
   mlir::Value charFuncPointerLength;
+  bool isProcPtr = false;
   if (const Fortran::semantics::Symbol *sym =
           caller.getIfIndirectCallSymbol()) {
+    isProcPtr = Fortran::semantics::IsProcedurePointer(sym);
     funcPointer = fir::getBase(converter.getSymbolExtendedValue(*sym, &symMap));
     if (!funcPointer)
       fir::emitFatalError(loc, "failed to find indirect call symbol address");
@@ -325,7 +327,13 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // compatible interface in Fortran, but that have different signatures in
   // FIR.
   if (funcPointer) {
-    operands.push_back(
+    if (isProcPtr) {
+      auto funcVal{builder.create<fir::LoadOp>(loc, funcPointer)};
+      auto boxProcTy{fir::BoxProcType::get(builder.getContext(), funcType)};
+      auto func{builder.createConvert(loc, boxProcTy, funcVal)};
+      operands.push_back(builder.create<fir::BoxAddrOp>(loc, funcType, func));
+    } else
+      operands.push_back(
         funcPointer.getType().isa<fir::BoxProcType>()
             ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
             : builder.createConvert(loc, funcType, funcPointer));
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 20ade1a04049fc4..b02fb3eb38141c8 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -98,6 +98,10 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+  if (std::optional<fir::FortranVariableOpInterface> varDef =
+          symMap.lookupVariableDefinition(*proc.GetSymbol()))
+    return *varDef;
+
   fir::ExtendedValue procExv =
       convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
   // Directly package the procedure address as a fir.boxproc or
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 1ed3b602621b449..25e301dbf8a4b29 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -24,6 +24,10 @@
 #define DEBUG_TYPE "flang-lower-type"
 
 using Fortran::common::VectorElementCategory;
+using Fortran::semantics::Details;
+using Fortran::semantics::ProcEntityDetails;
+using Fortran::semantics::SubprogramDetails;
+using Fortran::semantics::UseDetails;
 
 //===--------------------------------------------------------------------===//
 // Intrinsic type translation helpers
@@ -248,8 +252,22 @@ struct TypeBuilderImpl {
     // links, the fir type is built based on the ultimate symbol. This relies
     // on the fact volatile and asynchronous are not reflected in fir types.
     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
-    if (Fortran::semantics::IsProcedurePointer(ultimate))
-      TODO(loc, "procedure pointers");
+
+    if (Fortran::semantics::IsProcedurePointer(ultimate)) {
+      const auto procDetails{ultimate.detailsIf<ProcEntityDetails>()};
+      if (!procDetails)
+        fir::emitFatalError(loc, "Procedure pointer must be ProcEntity.");
+
+      // Procedure pointer with an explicit interface
+      if (const auto procIface{procDetails->procInterface()})
+        return genProcType(procIface, loc);
+
+      // Procedure pointer with an implicit interface
+      llvm::SmallVector<mlir::Type> resTys;
+      llvm::SmallVector<mlir::Type> argTys;
+      return mlir::FunctionType::get(context, argTys, resTys);
+    }
+
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
@@ -560,6 +578,35 @@ struct TypeBuilderImpl {
     derivedTypeInConstruction.pop_back();
   }
 
+  mlir::Type genProcType(const Fortran::semantics::Symbol *proc,
+                         mlir::Location loc) {
+    if (auto procDetails{proc->detailsIf<SubprogramDetails>()})
+      return genFunctionType(*procDetails);
+
+    // Use association. Need to get to the ultimate definition.
+    if (auto procDetails{proc->detailsIf<UseDetails>()}) {
+      auto sym{procDetails->symbol()};
+      for (;sym.detailsIf<UseDetails>();)
+        sym = sym.detailsIf<UseDetails>()->symbol();
+      if (auto pd{sym.detailsIf<SubprogramDetails>()})
+        return genFunctionType(*pd);
+    }
+    fir::emitFatalError(loc, "Procedure pointer error.");
+  }
+
+  mlir::FunctionType genFunctionType(const SubprogramDetails &details) {
+    llvm::SmallVector<mlir::Type> resTys;
+    llvm::SmallVector<mlir::Type> argTys;
+    if (details.isFunction())
+      resTys.emplace_back(genSymbolType(details.result()));
+    for (auto args : details.dummyArgs())
+      if (args->attrs().test(Fortran::semantics::Attr::VALUE))
+        argTys.emplace_back(genSymbolType(*args));
+      else
+        argTys.emplace_back(fir::ReferenceType::get(genSymbolType(*args)));
+    return mlir::FunctionType::get(context, argTys, resTys);
+  }
+
   /// Stack derived type being processed to avoid infinite loops in case of
   /// recursive derived types. The depth of derived types is expected to be
   /// shallow (<10), so a SmallVector is sufficient.
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 57fb9fc432de2ff..54dd5709b4a7ce9 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -479,8 +479,20 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   if (global && globalIsInitialized(global))
     return global;
 
-  if (Fortran::semantics::IsProcedurePointer(sym))
-    TODO(loc, "procedure pointer globals");
+  if (Fortran::semantics::IsProcedurePointer(sym)) {
+    auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+    global = builder.createGlobal(loc, boxProcTy, globalName, linkage,
+                                  mlir::Attribute{}, isConst, var.isTarget());
+    Fortran::lower::createGlobalInitialization(
+        builder, global, [&](fir::FirOpBuilder &builder) {
+          mlir::Value initVal{builder.create<fir::ZeroOp>(loc, symTy)};
+          auto emBoxVal{
+              builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
+          builder.create<fir::HasValueOp>(loc, emBoxVal);
+        });
+    global.setVisibility(mlir::SymbolTable::Visibility::Public);
+    return global;
+  }
 
   // If this is an array, check to see if we can use a dense attribute
   // with a tensor mlir type. This optimization currently only supports
@@ -645,8 +657,19 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
       var.getSymbol().GetUltimate();
   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
   bool isTarg = var.isTarget();
+
   // Let the builder do all the heavy lifting.
-  return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
+  if (!Fortran::semantics::IsProcedurePointer(ultimateSymbol))
+    return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
+
+  // Local procedure pointer.
+  auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+  auto res{builder.allocateLocal(loc, boxProcTy, nm, symNm, shape, lenParams,
+                                 isTarg)};
+  mlir::Value initVal{builder.create<fir::ZeroOp>(loc, ty)};
+  auto emBoxVal{builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
+  builder.create<fir::StoreOp>(loc, emBoxVal, res);
+  return res;
 }
 
 /// Must \p var be default initialized at runtime when entering its scope.
@@ -1542,7 +1565,8 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
   // is useful to maintain the address of the commonblock in an MLIR value and
   // query it. hlfir.declare need not be created for these.
   if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
-      !Fortran::semantics::IsProcedure(sym) &&
+      (!Fortran::semantics::IsProcedure(sym) ||
+       Fortran::semantics::IsPointer(sym)) &&
       !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
     bool isCrayPointee =
         sym.test(Fortran::semantics::Symbol::Flag::CrayPointee);
@@ -1683,6 +1707,17 @@ genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
                    /*lbounds=*/std::nullopt, force);
 }
 
+/// Map a procedure pointer
+static void
+genProcPointer(Fortran::lower::AbstractConverter &converter,
+               Fortran::lower::SymMap &symMap,
+               const Fortran::semantics::Symbol &sym,
+               mlir::Value addr, bool force = false) {
+  genDeclareSymbol(converter, symMap, sym, addr, mlir::Value {},
+                   /*shape=*/std::nullopt,
+                   /*lbounds=*/std::nullopt, force);
+}
+
 /// Map a symbol represented with a runtime descriptor to its FIR fir.box and
 /// evaluated specification expressions. Will optionally create fir.declare.
 static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
@@ -1734,8 +1769,20 @@ void Fortran::lower::mapSymbolAttributes(
 
       Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
     }
-    if (Fortran::semantics::IsPointer(sym))
-      TODO(loc, "procedure pointers");
+
+    // Procedure pointer.
+    if (Fortran::semantics::IsPointer(sym)) {
+      // global
+      mlir::Value boxAlloc = preAlloc;
+      // dummy or passed result
+      if (!boxAlloc)
+        if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
+          boxAlloc = symbox.getAddr();
+      // local
+      if (!boxAlloc)
+        boxAlloc = createNewLocal(converter, loc, var, preAlloc);
+      genProcPointer(converter, symMap, sym, boxAlloc, replace);
+    }
     return;
   }
 

>From 7575cac69c4936a5e7c785085bd800197f4faac2 Mon Sep 17 00:00:00 2001
From: Daniel Chen <cdchen at ca.ibm.com>
Date: Fri, 27 Oct 2023 11:05:44 -0400
Subject: [PATCH 2/4] [Flang] Fixing format.

---
 flang/lib/Lower/ConvertCall.cpp     |  6 +++---
 flang/lib/Lower/ConvertType.cpp     |  2 +-
 flang/lib/Lower/ConvertVariable.cpp | 11 +++++------
 3 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 6918001a3f17baa..dbe7ddcbd38e177 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -334,9 +334,9 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
       operands.push_back(builder.create<fir::BoxAddrOp>(loc, funcType, func));
     } else
       operands.push_back(
-        funcPointer.getType().isa<fir::BoxProcType>()
-            ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
-            : builder.createConvert(loc, funcType, funcPointer));
+          funcPointer.getType().isa<fir::BoxProcType>()
+              ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
+              : builder.createConvert(loc, funcType, funcPointer));
   }
 
   // Deal with potential mismatches in arguments types. Passing an array to a
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 25e301dbf8a4b29..3bda1c05a3f778b 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -586,7 +586,7 @@ struct TypeBuilderImpl {
     // Use association. Need to get to the ultimate definition.
     if (auto procDetails{proc->detailsIf<UseDetails>()}) {
       auto sym{procDetails->symbol()};
-      for (;sym.detailsIf<UseDetails>();)
+      for (; sym.detailsIf<UseDetails>();)
         sym = sym.detailsIf<UseDetails>()->symbol();
       if (auto pd{sym.detailsIf<SubprogramDetails>()})
         return genFunctionType(*pd);
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 54dd5709b4a7ce9..0d9a99c8bbcb025 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1708,12 +1708,11 @@ genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
 }
 
 /// Map a procedure pointer
-static void
-genProcPointer(Fortran::lower::AbstractConverter &converter,
-               Fortran::lower::SymMap &symMap,
-               const Fortran::semantics::Symbol &sym,
-               mlir::Value addr, bool force = false) {
-  genDeclareSymbol(converter, symMap, sym, addr, mlir::Value {},
+static void genProcPointer(Fortran::lower::AbstractConverter &converter,
+                           Fortran::lower::SymMap &symMap,
+                           const Fortran::semantics::Symbol &sym,
+                           mlir::Value addr, bool force = false) {
+  genDeclareSymbol(converter, symMap, sym, addr, mlir::Value{},
                    /*shape=*/std::nullopt,
                    /*lbounds=*/std::nullopt, force);
 }

>From 08df9fd0b75daf804d5918d569f491f4bdf010d9 Mon Sep 17 00:00:00 2001
From: Daniel Chen <cdchen at ca.ibm.com>
Date: Fri, 27 Oct 2023 17:00:41 -0400
Subject: [PATCH 3/4] [Flang] Address review comments.

---
 flang/lib/Lower/ConvertCall.cpp |  4 +--
 flang/lib/Lower/ConvertType.cpp | 43 ++-------------------------------
 2 files changed, 4 insertions(+), 43 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index dbe7ddcbd38e177..ef9cbdd6753c3cd 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -328,9 +328,9 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // FIR.
   if (funcPointer) {
     if (isProcPtr) {
-      auto funcVal{builder.create<fir::LoadOp>(loc, funcPointer)};
+      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
       auto boxProcTy{fir::BoxProcType::get(builder.getContext(), funcType)};
-      auto func{builder.createConvert(loc, boxProcTy, funcVal)};
+      auto func{builder.createConvert(loc, boxProcTy, funcPointer)};
       operands.push_back(builder.create<fir::BoxAddrOp>(loc, funcType, func));
     } else
       operands.push_back(
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 3bda1c05a3f778b..095699e6982edd4 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -254,18 +254,8 @@ struct TypeBuilderImpl {
     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
 
     if (Fortran::semantics::IsProcedurePointer(ultimate)) {
-      const auto procDetails{ultimate.detailsIf<ProcEntityDetails>()};
-      if (!procDetails)
-        fir::emitFatalError(loc, "Procedure pointer must be ProcEntity.");
-
-      // Procedure pointer with an explicit interface
-      if (const auto procIface{procDetails->procInterface()})
-        return genProcType(procIface, loc);
-
-      // Procedure pointer with an implicit interface
-      llvm::SmallVector<mlir::Type> resTys;
-      llvm::SmallVector<mlir::Type> argTys;
-      return mlir::FunctionType::get(context, argTys, resTys);
+      Fortran::evaluate::ProcedureDesignator proc(ultimate);
+      return Fortran::lower::translateSignature(proc, converter);
     }
 
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
@@ -578,35 +568,6 @@ struct TypeBuilderImpl {
     derivedTypeInConstruction.pop_back();
   }
 
-  mlir::Type genProcType(const Fortran::semantics::Symbol *proc,
-                         mlir::Location loc) {
-    if (auto procDetails{proc->detailsIf<SubprogramDetails>()})
-      return genFunctionType(*procDetails);
-
-    // Use association. Need to get to the ultimate definition.
-    if (auto procDetails{proc->detailsIf<UseDetails>()}) {
-      auto sym{procDetails->symbol()};
-      for (; sym.detailsIf<UseDetails>();)
-        sym = sym.detailsIf<UseDetails>()->symbol();
-      if (auto pd{sym.detailsIf<SubprogramDetails>()})
-        return genFunctionType(*pd);
-    }
-    fir::emitFatalError(loc, "Procedure pointer error.");
-  }
-
-  mlir::FunctionType genFunctionType(const SubprogramDetails &details) {
-    llvm::SmallVector<mlir::Type> resTys;
-    llvm::SmallVector<mlir::Type> argTys;
-    if (details.isFunction())
-      resTys.emplace_back(genSymbolType(details.result()));
-    for (auto args : details.dummyArgs())
-      if (args->attrs().test(Fortran::semantics::Attr::VALUE))
-        argTys.emplace_back(genSymbolType(*args));
-      else
-        argTys.emplace_back(fir::ReferenceType::get(genSymbolType(*args)));
-    return mlir::FunctionType::get(context, argTys, resTys);
-  }
-
   /// Stack derived type being processed to avoid infinite loops in case of
   /// recursive derived types. The depth of derived types is expected to be
   /// shallow (<10), so a SmallVector is sufficient.

>From 7e8a9a76bbcd9aa1c529e3b1f495178f33c4c13f Mon Sep 17 00:00:00 2001
From: Daniel Chen <cdchen at ca.ibm.com>
Date: Fri, 27 Oct 2023 23:25:45 -0400
Subject: [PATCH 4/4] [Flang] Remove unnecessary code.

---
 flang/lib/Lower/ConvertType.cpp | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 095699e6982edd4..dbcaaced169ce3c 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -24,10 +24,6 @@
 #define DEBUG_TYPE "flang-lower-type"
 
 using Fortran::common::VectorElementCategory;
-using Fortran::semantics::Details;
-using Fortran::semantics::ProcEntityDetails;
-using Fortran::semantics::SubprogramDetails;
-using Fortran::semantics::UseDetails;
 
 //===--------------------------------------------------------------------===//
 // Intrinsic type translation helpers



More information about the flang-commits mailing list