diff --git a/flang/include/flang/Lower/ConvertCall.h b/flang/include/flang/Lower/ConvertCall.h --- a/flang/include/flang/Lower/ConvertCall.h +++ b/flang/include/flang/Lower/ConvertCall.h @@ -40,6 +40,10 @@ mlir::Value argumentHostAssocs(Fortran::lower::AbstractConverter &converter, mlir::Value arg); +/// Is \p procRef an intrinsic module procedure that should be lowered as +/// intrinsic procedures (with Optimizer/Builder/IntrinsicCall.h)? +bool isIntrinsicModuleProcRef(const Fortran::evaluate::ProcedureRef &procRef); + /// Lower a ProcedureRef to HLFIR. If this is a function call, return the /// lowered result value. Return nothing otherwise. std::optional convertCallToHLFIR( diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -35,7 +35,8 @@ static llvm::cl::opt useHlfirIntrinsicOps( "use-hlfir-intrinsic-ops", llvm::cl::init(true), - llvm::cl::desc("Lower via HLFIR transformational intrinsic operations such as hlfir.sum")); + llvm::cl::desc("Lower via HLFIR transformational intrinsic operations such " + "as hlfir.sum")); /// Helper to package a Value and its properties into an ExtendedValue. static fir::ExtendedValue toExtendedValue(mlir::Location loc, mlir::Value base, @@ -561,6 +562,8 @@ fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); } + std::string getProcedureName() const { return procRef.proc().GetName(); } + /// Is this a call to an elemental procedure with at least one array argument? bool isElementalProcWithArrayArgs() const { if (procRef.IsElemental()) @@ -1146,7 +1149,7 @@ /// pre-lowered but have not yet been prepared according to the interface. static std::optional genIntrinsicRefCore(PreparedActualArguments &loweredActuals, - const Fortran::evaluate::SpecificIntrinsic &intrinsic, + const Fortran::evaluate::SpecificIntrinsic *intrinsic, const fir::IntrinsicArgumentLoweringRules *argLowering, CallContext &callContext) { llvm::SmallVector operands; @@ -1213,10 +1216,10 @@ std::optional scalarResultType; if (callContext.resultType) scalarResultType = hlfir::getFortranElementType(*callContext.resultType); + const std::string intrinsicName = callContext.getProcedureName(); // Let the intrinsic library lower the intrinsic procedure call. - auto [resultExv, mustBeFreed] = - genIntrinsicCall(callContext.getBuilder(), loc, intrinsic.name, - scalarResultType, operands); + auto [resultExv, mustBeFreed] = genIntrinsicCall( + callContext.getBuilder(), loc, intrinsicName, scalarResultType, operands); if (!fir::getBase(resultExv)) return std::nullopt; hlfir::EntityWithAttributes resultEntity = extendedValueToHlfirEntity( @@ -1229,7 +1232,7 @@ // (this is the only intrinsic implemented in that way so far). The // ownership of this address cannot be taken here since it may not be a // temp. - if (intrinsic.name == "merge") + if (intrinsicName == "merge") asExpr = builder.create(loc, resultEntity); else asExpr = builder.create( @@ -1243,11 +1246,12 @@ /// pre-lowered but have not yet been prepared according to the interface. static std::optional genHLFIRIntrinsicRefCore(PreparedActualArguments &loweredActuals, - const Fortran::evaluate::SpecificIntrinsic &intrinsic, + const Fortran::evaluate::SpecificIntrinsic *intrinsic, const fir::IntrinsicArgumentLoweringRules *argLowering, CallContext &callContext) { if (!useHlfirIntrinsicOps) - return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering, callContext); + return genIntrinsicRefCore(loweredActuals, intrinsic, argLowering, + callContext); fir::FirOpBuilder &builder = callContext.getBuilder(); mlir::Location loc = callContext.loc; @@ -1293,8 +1297,8 @@ return hlfir::ExprType::get(builder.getContext(), resultShape, elementType, /*polymorphic=*/false); }; - - if (intrinsic.name == "sum") { + const std::string intrinsicName = callContext.getProcedureName(); + if (intrinsicName == "sum") { llvm::SmallVector operands = getOperandVector(loweredActuals); assert(operands.size() == 3); mlir::Value array = operands[0]; @@ -1308,7 +1312,7 @@ builder.create(loc, resultTy, array, dim, mask); return {hlfir::EntityWithAttributes{sumOp.getResult()}}; } - if (intrinsic.name == "matmul") { + if (intrinsicName == "matmul") { llvm::SmallVector operands = getOperandVector(loweredActuals); mlir::Type resultTy = computeResultType(operands[0], *callContext.resultType); @@ -1317,7 +1321,7 @@ return {hlfir::EntityWithAttributes{matmulOp.getResult()}}; } - if (intrinsic.name == "transpose") { + if (intrinsicName == "transpose") { llvm::SmallVector operands = getOperandVector(loweredActuals); hlfir::ExprType::Shape resultShape; mlir::Type normalisedResult = @@ -1509,7 +1513,7 @@ : public ElementalCallBuilder { public: ElementalIntrinsicCallBuilder( - const Fortran::evaluate::SpecificIntrinsic &intrinsic, + const Fortran::evaluate::SpecificIntrinsic *intrinsic, const fir::IntrinsicArgumentLoweringRules *argLowering, bool isFunction) : intrinsic{intrinsic}, argLowering{argLowering}, isFunction{isFunction} { } @@ -1530,11 +1534,12 @@ mlir::Value computeDynamicCharacterResultLength(PreparedActualArguments &loweredActuals, CallContext &callContext) { - if (intrinsic.name == "adjustr" || intrinsic.name == "adjustl" || - intrinsic.name == "merge") - return hlfir::genCharLength( - callContext.loc, callContext.getBuilder(), - loweredActuals[0].value().getOriginalActual()); + if (intrinsic) + if (intrinsic->name == "adjustr" || intrinsic->name == "adjustl" || + intrinsic->name == "merge") + return hlfir::genCharLength( + callContext.loc, callContext.getBuilder(), + loweredActuals[0].value().getOriginalActual()); // Character MIN/MAX is the min/max of the arguments length that are // present. TODO(callContext.loc, @@ -1542,7 +1547,7 @@ } private: - const Fortran::evaluate::SpecificIntrinsic &intrinsic; + const Fortran::evaluate::SpecificIntrinsic *intrinsic; const fir::IntrinsicArgumentLoweringRules *argLowering; const bool isFunction; }; @@ -1581,18 +1586,22 @@ } /// Lower an intrinsic procedure reference. +/// \p intrinsic is null if this is an intrinsic module procedure that must be +/// lowered as if it were an intrinsic module procedure (like C_LOC which is a +/// procedure from intrinsic module iso_c_binding). Otherwise, \p intrinsic +/// must not be null. static std::optional -genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic, +genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic, CallContext &callContext) { mlir::Location loc = callContext.loc; auto &converter = callContext.converter; - if (Fortran::lower::intrinsicRequiresCustomOptionalHandling( - callContext.procRef, intrinsic, converter)) + if (intrinsic && Fortran::lower::intrinsicRequiresCustomOptionalHandling( + callContext.procRef, *intrinsic, converter)) TODO(loc, "special cases of intrinsic with optional arguments"); PreparedActualArguments loweredActuals; const fir::IntrinsicArgumentLoweringRules *argLowering = - fir::getIntrinsicArgumentLowering(intrinsic.name); + fir::getIntrinsicArgumentLowering(callContext.getProcedureName()); for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) { auto *expr = Fortran::evaluate::UnwrapExpr(arg.value()); @@ -1638,7 +1647,9 @@ genProcedureRef(CallContext &callContext) { mlir::Location loc = callContext.loc; if (auto *intrinsic = callContext.procRef.proc().GetSpecificIntrinsic()) - return genIntrinsicRef(*intrinsic, callContext); + return genIntrinsicRef(intrinsic, callContext); + if (Fortran::lower::isIntrinsicModuleProcRef(callContext.procRef)) + return genIntrinsicRef(nullptr, callContext); if (callContext.isStatementFunctionCall()) return genStmtFunctionRef(loc, callContext.converter, callContext.symMap, @@ -1699,6 +1710,17 @@ return genUserCall(loweredActuals, caller, callSiteType, callContext); } +bool Fortran::lower::isIntrinsicModuleProcRef( + const Fortran::evaluate::ProcedureRef &procRef) { + const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol(); + if (!symbol) + return false; + const Fortran::semantics::Symbol *module = + symbol->GetUltimate().owner().GetSymbol(); + return module && module->attrs().test(Fortran::semantics::Attr::INTRINSIC) && + module->name().ToString().find("omp_lib") == std::string::npos; +} + std::optional Fortran::lower::convertCallToHLFIR( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const evaluate::ProcedureRef &procRef, std::optional resultType, diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -589,17 +589,6 @@ return obj.GetLastSymbol().GetUltimate(); } -static bool -isIntrinsicModuleProcRef(const Fortran::evaluate::ProcedureRef &procRef) { - const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol(); - if (!symbol) - return false; - const Fortran::semantics::Symbol *module = - symbol->GetUltimate().owner().GetSymbol(); - return module && module->attrs().test(Fortran::semantics::Attr::INTRINSIC) && - module->name().ToString().find("omp_lib") == std::string::npos; -} - // Return true if TRANSPOSE should be lowered without a runtime call. static bool isTransposeOptEnabled(const Fortran::lower::AbstractConverter &converter) { @@ -2442,7 +2431,7 @@ procRef.proc().GetSpecificIntrinsic()) return genIntrinsicRef(procRef, resultType, *intrinsic); - if (isIntrinsicModuleProcRef(procRef)) + if (Fortran::lower::isIntrinsicModuleProcRef(procRef)) return genIntrinsicRef(procRef, resultType); if (isStatementFunctionCall(procRef)) @@ -4795,7 +4784,7 @@ // The intrinsic procedure is called once per element of the array. return genElementalIntrinsicProcRef(procRef, retTy, *intrin); } - if (isIntrinsicModuleProcRef(procRef)) + if (Fortran::lower::isIntrinsicModuleProcRef(procRef)) return genElementalIntrinsicProcRef(procRef, retTy); if (ScalarExprLowering::isStatementFunctionCall(procRef)) fir::emitFatalError(loc, "statement function cannot be elemental"); diff --git a/flang/test/Lower/HLFIR/intrinsic-module-procedures.f90 b/flang/test/Lower/HLFIR/intrinsic-module-procedures.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/intrinsic-module-procedures.f90 @@ -0,0 +1,23 @@ +! Test lowering of intrinsic module procedures to HLFIR. This +! test is not meant to test every intrinsic module procedure, +! it only tests that the HFLIR procedure reference lowering +! infrastructure properly detects and dispatches intrinsic module +! procedure calls. +! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s + +subroutine foo(cptr, x) + use iso_c_binding, only : c_ptr, c_loc + type(c_ptr) :: cptr + integer :: x + cptr = c_loc(x) +end subroutine +! CHECK-LABEL: func.func @_QPfoo( +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ecptr" +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ex" +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1 : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[VAL_9]] to %[[VAL_7]] : !fir.ref