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-exception
6//
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 in
43 // case it is different from the specific name. The type of the specific
44 // 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 builder.create<fir::AddrOfOp>(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 builder.create<fir::AddrOfOp>(loc, func.getFunctionType(), nameAttr);
73 }
74 if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
75 // The result length, if available here, must be propagated along the
76 // procedure address so that call sites where the result length is assumed
77 // 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 are
81 // meaningless without any actual arguments. Leave the length as
82 // unknown in that case, it be resolved on the call site
83 // 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 allocate
93 // the function result with the character length specified
94 // by the boxed value. If the result length cannot be
95 // computed statically, set it to zero (we used to use -1,
96 // but this could cause assertions in LLVM after inlining
97 // 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 the
115 /// base address can be directly addressed.
116 if (mlir::isa<fir::BaseBoxType>(base.getType()))
117 base = builder.create<fir::BoxAddrOp>(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 pointer
123 // 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 = builder.create<hlfir::DesignateOp>(
128 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 or
169 // 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 = builder.create<fir::EmboxProcOp>(
178 loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
179 else
180 funcAddr = builder.create<fir::EmboxProcOp>(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 converter.getFirOpBuilder().create<fir::LoadOp>(loc, pointerComp);
216}
217

source code of flang/lib/Lower/ConvertProcedureDesignator.cpp