217 lines · cpp
1//===- ConvertProcedureDesignator.cpp -- Procedure Designator ---*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Lower/ConvertProcedureDesignator.h"10#include "flang/Evaluate/intrinsics.h"11#include "flang/Lower/AbstractConverter.h"12#include "flang/Lower/CallInterface.h"13#include "flang/Lower/ConvertCall.h"14#include "flang/Lower/ConvertExprToHLFIR.h"15#include "flang/Lower/ConvertVariable.h"16#include "flang/Lower/Support/Utils.h"17#include "flang/Lower/SymbolMap.h"18#include "flang/Optimizer/Builder/Character.h"19#include "flang/Optimizer/Builder/IntrinsicCall.h"20#include "flang/Optimizer/Builder/Todo.h"21#include "flang/Optimizer/Dialect/FIROps.h"22#include "flang/Optimizer/HLFIR/HLFIROps.h"23 24static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,25 Fortran::lower::SymMap &symMap) {26 for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))27 if (!symMap.lookupSymbol(sym))28 return false;29 return true;30}31 32fir::ExtendedValue Fortran::lower::convertProcedureDesignator(33 mlir::Location loc, Fortran::lower::AbstractConverter &converter,34 const Fortran::evaluate::ProcedureDesignator &proc,35 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {36 fir::FirOpBuilder &builder = converter.getFirOpBuilder();37 38 if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =39 proc.GetSpecificIntrinsic()) {40 mlir::FunctionType signature =41 Fortran::lower::translateSignature(proc, converter);42 // Intrinsic lowering is based on the generic name, so retrieve it here in43 // case it is different from the specific name. The type of the specific44 // intrinsic is retained in the signature.45 std::string genericName =46 converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(47 intrinsic->name);48 mlir::SymbolRefAttr symbolRefAttr =49 fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName,50 signature);51 mlir::Value funcPtr =52 fir::AddrOfOp::create(builder, loc, signature, symbolRefAttr);53 return funcPtr;54 }55 const Fortran::semantics::Symbol *symbol = proc.GetSymbol();56 assert(symbol && "expected symbol in ProcedureDesignator");57 mlir::Value funcPtr;58 mlir::Value funcPtrResultLength;59 if (Fortran::semantics::IsDummy(*symbol)) {60 Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol);61 assert(val && "Dummy procedure not in symbol map");62 funcPtr = val.getAddr();63 if (fir::isCharacterProcedureTuple(funcPtr.getType(),64 /*acceptRawFunc=*/false))65 std::tie(funcPtr, funcPtrResultLength) =66 fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);67 } else {68 mlir::func::FuncOp func =69 Fortran::lower::getOrDeclareFunction(proc, converter);70 mlir::SymbolRefAttr nameAttr = builder.getSymbolRefAttr(func.getSymName());71 funcPtr =72 fir::AddrOfOp::create(builder, loc, func.getFunctionType(), nameAttr);73 }74 if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {75 // The result length, if available here, must be propagated along the76 // procedure address so that call sites where the result length is assumed77 // can retrieve the length.78 Fortran::evaluate::DynamicType resultType = proc.GetType().value();79 if (const auto &lengthExpr = resultType.GetCharLength()) {80 // The length expression may refer to dummy argument symbols that are81 // meaningless without any actual arguments. Leave the length as82 // unknown in that case, it be resolved on the call site83 // with the actual arguments.84 if (areAllSymbolsInExprMapped(*lengthExpr, symMap)) {85 mlir::Value rawLen = fir::getBase(86 converter.genExprValue(toEvExpr(*lengthExpr), stmtCtx));87 // F2018 7.4.4.2 point 5.88 funcPtrResultLength =89 fir::factory::genMaxWithZero(builder, loc, rawLen);90 }91 }92 // The caller of the function pointer will have to allocate93 // the function result with the character length specified94 // by the boxed value. If the result length cannot be95 // computed statically, set it to zero (we used to use -1,96 // but this could cause assertions in LLVM after inlining97 // exposed alloca of size -1).98 if (!funcPtrResultLength)99 funcPtrResultLength = builder.createIntegerConstant(100 loc, builder.getCharacterLengthType(), 0);101 return fir::CharBoxValue{funcPtr, funcPtrResultLength};102 }103 return funcPtr;104}105 106static hlfir::EntityWithAttributes designateProcedurePointerComponent(107 mlir::Location loc, Fortran::lower::AbstractConverter &converter,108 const Fortran::evaluate::Symbol &procComponentSym, mlir::Value base,109 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {110 fir::FirOpBuilder &builder = converter.getFirOpBuilder();111 fir::FortranVariableFlagsAttr attributes =112 Fortran::lower::translateSymbolAttributes(builder.getContext(),113 procComponentSym);114 /// Passed argument may be a descriptor. This is a scalar reference, so the115 /// base address can be directly addressed.116 if (mlir::isa<fir::BaseBoxType>(base.getType()))117 base = fir::BoxAddrOp::create(builder, loc, base);118 std::string fieldName = converter.getRecordTypeFieldName(procComponentSym);119 auto recordType =120 mlir::cast<fir::RecordType>(hlfir::getFortranElementType(base.getType()));121 mlir::Type fieldType = recordType.getType(fieldName);122 // Note: semantics turns x%p() into x%t%p() when the procedure pointer123 // component is part of parent component t.124 if (!fieldType)125 TODO(loc, "passing type bound procedure (extension)");126 mlir::Type designatorType = fir::ReferenceType::get(fieldType);127 mlir::Value compRef = hlfir::DesignateOp::create(128 builder, loc, designatorType, base, fieldName,129 /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},130 /*substring=*/mlir::ValueRange{},131 /*complexPart=*/std::nullopt,132 /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{}, attributes);133 return hlfir::EntityWithAttributes{compRef};134}135 136static hlfir::EntityWithAttributes convertProcedurePointerComponent(137 mlir::Location loc, Fortran::lower::AbstractConverter &converter,138 const Fortran::evaluate::Component &procComponent,139 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {140 fir::ExtendedValue baseExv = Fortran::lower::convertDataRefToValue(141 loc, converter, procComponent.base(), symMap, stmtCtx);142 mlir::Value base = fir::getBase(baseExv);143 const Fortran::semantics::Symbol &procComponentSym =144 procComponent.GetLastSymbol();145 return designateProcedurePointerComponent(loc, converter, procComponentSym,146 base, symMap, stmtCtx);147}148 149hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(150 mlir::Location loc, Fortran::lower::AbstractConverter &converter,151 const Fortran::evaluate::ProcedureDesignator &proc,152 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {153 const auto *sym = proc.GetSymbol();154 if (sym) {155 if (sym->GetUltimate().attrs().test(Fortran::semantics::Attr::INTRINSIC))156 TODO(loc, "Procedure pointer with intrinsic target.");157 if (std::optional<fir::FortranVariableOpInterface> varDef =158 symMap.lookupVariableDefinition(*sym))159 return *varDef;160 }161 162 if (const Fortran::evaluate::Component *procComponent = proc.GetComponent())163 return convertProcedurePointerComponent(loc, converter, *procComponent,164 symMap, stmtCtx);165 166 fir::ExtendedValue procExv =167 convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);168 // Directly package the procedure address as a fir.boxproc or169 // tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.170 fir::FirOpBuilder &builder = converter.getFirOpBuilder();171 172 mlir::Value funcAddr = fir::getBase(procExv);173 if (!mlir::isa<fir::BoxProcType>(funcAddr.getType())) {174 mlir::Type boxTy =175 Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());176 if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))177 funcAddr = fir::EmboxProcOp::create(178 builder, loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});179 else180 funcAddr = fir::EmboxProcOp::create(builder, loc, boxTy, funcAddr);181 }182 183 mlir::Value res = procExv.match(184 [&](const fir::CharBoxValue &box) -> mlir::Value {185 mlir::Type tupleTy =186 fir::factory::getCharacterProcedureTupleType(funcAddr.getType());187 return fir::factory::createCharacterProcedureTuple(188 builder, loc, tupleTy, funcAddr, box.getLen());189 },190 [funcAddr](const auto &) { return funcAddr; });191 return hlfir::EntityWithAttributes{res};192}193 194mlir::Value Fortran::lower::convertProcedureDesignatorInitialTarget(195 Fortran::lower::AbstractConverter &converter, mlir::Location loc,196 const Fortran::semantics::Symbol &sym) {197 Fortran::lower::SymMap globalOpSymMap;198 Fortran::lower::StatementContext stmtCtx;199 Fortran::evaluate::ProcedureDesignator proc(sym);200 auto procVal{Fortran::lower::convertProcedureDesignatorToHLFIR(201 loc, converter, proc, globalOpSymMap, stmtCtx)};202 return fir::getBase(Fortran::lower::convertToAddress(203 loc, converter, procVal, stmtCtx, procVal.getType()));204}205 206mlir::Value Fortran::lower::derefPassProcPointerComponent(207 mlir::Location loc, Fortran::lower::AbstractConverter &converter,208 const Fortran::evaluate::ProcedureDesignator &proc, mlir::Value passedArg,209 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {210 const Fortran::semantics::Symbol *procComponentSym = proc.GetSymbol();211 assert(procComponentSym &&212 "failed to retrieve pointer procedure component symbol");213 hlfir::EntityWithAttributes pointerComp = designateProcedurePointerComponent(214 loc, converter, *procComponentSym, passedArg, symMap, stmtCtx);215 return fir::LoadOp::create(converter.getFirOpBuilder(), loc, pointerComp);216}217