[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 14:00:55 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/3] [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/3] [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/3] [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.
More information about the flang-commits
mailing list