[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