[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
Sun Nov 5 17:46:58 PST 2023


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

>From bbc5842150e48bdca05b2f45ac62fb4be0fe5865 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Tue, 31 Oct 2023 13:35:38 -0400
Subject: [PATCH 1/2] [Flang] Add partial support for procedure pointer.

---
 flang/lib/Lower/Bridge.cpp                    |  9 ++-
 flang/lib/Lower/ConvertCall.cpp               | 16 +++--
 .../lib/Lower/ConvertProcedureDesignator.cpp  |  4 ++
 flang/lib/Lower/ConvertType.cpp               |  8 ++-
 flang/lib/Lower/ConvertVariable.cpp           | 58 +++++++++++++++++--
 5 files changed, 81 insertions(+), 14 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 82e1ece4efeafe7..a8bbab55d762c3f 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,10 +327,16 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // compatible interface in Fortran, but that have different signatures in
   // FIR.
   if (funcPointer) {
-    operands.push_back(
-        funcPointer.getType().isa<fir::BoxProcType>()
-            ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
-            : builder.createConvert(loc, funcType, funcPointer));
+    if (isProcPtr) {
+      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
+      auto boxProcTy{fir::BoxProcType::get(builder.getContext(), funcType)};
+      auto func{builder.createConvert(loc, boxProcTy, funcPointer)};
+      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));
   }
 
   // Deal with potential mismatches in arguments types. Passing an array to a
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..dbcaaced169ce3c 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -248,8 +248,12 @@ 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)) {
+      Fortran::evaluate::ProcedureDesignator proc(ultimate);
+      return Fortran::lower::translateSignature(proc, converter);
+    }
+
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 57fb9fc432de2ff..0d9a99c8bbcb025 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,16 @@ 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 +1768,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 b67528580ba9fcca29fd6cdb45ae909842a9d500 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sun, 5 Nov 2023 20:38:46 -0500
Subject: [PATCH 2/2] [Flang] Lowering procedure pointer actual/dummy argument.

---
 .../flang/Optimizer/HLFIR/HLFIRDialect.h      |  6 +++
 flang/lib/Lower/CallInterface.cpp             | 42 ++++++++++---------
 flang/lib/Lower/ConvertCall.cpp               | 16 +++++++
 3 files changed, 44 insertions(+), 20 deletions(-)

diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
index aa68d0811c4868a..e8f28485298277d 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
@@ -67,6 +67,12 @@ inline bool isBoxAddressType(mlir::Type type) {
   return type && type.isa<fir::BaseBoxType>();
 }
 
+/// Is this a fir.boxproc address type?
+inline bool isBoxProcAddressType(mlir::Type type) {
+  type = fir::dyn_cast_ptrEleTy(type);
+  return type && type.isa<fir::BoxProcType>();
+}
+
 /// Is this a fir.box or fir.class address or value type?
 inline bool isBoxAddressOrValueType(mlir::Type type) {
   return fir::unwrapRefType(type).isa<fir::BaseBoxType>();
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 43bbbb933658a8a..26ec743ff10d274 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1053,30 +1053,32 @@ class Fortran::lower::CallInterfaceImpl {
       const DummyCharacteristics *characteristics,
       const Fortran::evaluate::characteristics::DummyProcedure &proc,
       const FortranEntity &entity) {
-    if (proc.attrs.test(
-            Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer))
-      TODO(interface.converter.getCurrentLocation(),
-           "procedure pointer arguments");
-    // Otherwise, it is a dummy procedure.
     const Fortran::evaluate::characteristics::Procedure &procedure =
         proc.procedure.value();
     mlir::Type funcType =
         getProcedureDesignatorType(&procedure, interface.converter);
-    std::optional<Fortran::evaluate::DynamicType> resultTy =
-        getResultDynamicType(procedure);
-    if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
-      // The result length of dummy procedures that are character functions must
-      // be passed so that the dummy procedure can be called if it has assumed
-      // length on the callee side.
-      mlir::Type tupleType =
-          fir::factory::getCharacterProcedureTupleType(funcType);
-      llvm::StringRef charProcAttr = fir::getCharacterProcedureDummyAttrName();
-      addFirOperand(tupleType, nextPassedArgPosition(), Property::CharProcTuple,
-                    {mlir::NamedAttribute{
-                        mlir::StringAttr::get(&mlirContext, charProcAttr),
-                        mlir::UnitAttr::get(&mlirContext)}});
-      addPassedArg(PassEntityBy::CharProcTuple, entity, characteristics);
-      return;
+    if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure::
+                            Attr::Pointer)) {
+      funcType = fir::ReferenceType::get(funcType);
+    } else { // Otherwise, it is a dummy procedure.
+      std::optional<Fortran::evaluate::DynamicType> resultTy =
+          getResultDynamicType(procedure);
+      if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
+        // The result length of dummy procedures that are character functions
+        // must be passed so that the dummy procedure can be called if it has
+        // assumed length on the callee side.
+        mlir::Type tupleType =
+            fir::factory::getCharacterProcedureTupleType(funcType);
+        llvm::StringRef charProcAttr =
+            fir::getCharacterProcedureDummyAttrName();
+        addFirOperand(tupleType, nextPassedArgPosition(),
+                      Property::CharProcTuple,
+                      {mlir::NamedAttribute{
+                          mlir::StringAttr::get(&mlirContext, charProcAttr),
+                          mlir::UnitAttr::get(&mlirContext)}});
+        addPassedArg(PassEntityBy::CharProcTuple, entity, characteristics);
+        return;
+      }
     }
     addFirOperand(funcType, nextPassedArgPosition(), Property::BaseAddress);
     addPassedArg(PassEntityBy::BaseAddress, entity, characteristics);
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index a8bbab55d762c3f..1a21751561ad67f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -878,6 +878,22 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
+  // Handles the procedure pointer actual/dummy arguments.
+  // It could have a combination of
+  //     acutal             dummy
+  // 2.  procedure pointer  procedure pointer
+  // 3.  procedure pointer  procedure
+  // 4.  procedure          procedure pointer
+  if (hlfir::isBoxProcAddressType(actual.getType()) ||
+      hlfir::isBoxProcAddressType(dummyType)) {
+    if (actual.getType() != dummyType &&
+        hlfir::isBoxProcAddressType(actual.getType())) {
+      auto baseAddr{actual.getFirBase()};
+      actual = hlfir::Entity{builder.create<fir::LoadOp>(loc, baseAddr)};
+    }
+    return PreparedDummyArgument{actual, /*cleanups=*/{}};
+  }
+
   // Do nothing if this is a procedure argument. It is already a
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {



More information about the flang-commits mailing list