[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
Tue Oct 31 10:39:43 PDT 2023
https://github.com/DanielCChen updated https://github.com/llvm/llvm-project/pull/70461
>From 14151eccd9332d6f478904683cd502e8a50c14a0 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] [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;
}
More information about the flang-commits
mailing list