1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
//===- ConvertProcedureDesignator.cpp -- Procedure Designator ---*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#include "flang/Lower/ConvertProcedureDesignator.h"
#include "flang/Evaluate/intrinsics.h"
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/CallInterface.h"
#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Dialect/FIROps.h"
static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,
Fortran::lower::SymMap &symMap) {
for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))
if (!symMap.lookupSymbol(sym))
return false;
return true;
}
fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
const Fortran::evaluate::ProcedureDesignator &proc,
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
proc.GetSpecificIntrinsic()) {
mlir::FunctionType signature =
Fortran::lower::translateSignature(proc, converter);
// Intrinsic lowering is based on the generic name, so retrieve it here in
// case it is different from the specific name. The type of the specific
// intrinsic is retained in the signature.
std::string genericName =
converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(
intrinsic->name);
mlir::SymbolRefAttr symbolRefAttr =
fir::getUnrestrictedIntrinsicSymbolRefAttr(builder, loc, genericName,
signature);
mlir::Value funcPtr =
builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr);
return funcPtr;
}
const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
assert(symbol && "expected symbol in ProcedureDesignator");
mlir::Value funcPtr;
mlir::Value funcPtrResultLength;
if (Fortran::semantics::IsDummy(*symbol)) {
Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol);
assert(val && "Dummy procedure not in symbol map");
funcPtr = val.getAddr();
if (fir::isCharacterProcedureTuple(funcPtr.getType(),
/*acceptRawFunc=*/false))
std::tie(funcPtr, funcPtrResultLength) =
fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);
} else {
std::string name = converter.mangleName(*symbol);
mlir::func::FuncOp func =
Fortran::lower::getOrDeclareFunction(name, proc, converter);
funcPtr = builder.create<fir::AddrOfOp>(loc, func.getFunctionType(),
builder.getSymbolRefAttr(name));
}
if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
// The result length, if available here, must be propagated along the
// procedure address so that call sites where the result length is assumed
// can retrieve the length.
Fortran::evaluate::DynamicType resultType = proc.GetType().value();
if (const auto &lengthExpr = resultType.GetCharLength()) {
// The length expression may refer to dummy argument symbols that are
// meaningless without any actual arguments. Leave the length as
// unknown in that case, it be resolved on the call site
// with the actual arguments.
if (areAllSymbolsInExprMapped(*lengthExpr, symMap)) {
mlir::Value rawLen = fir::getBase(
converter.genExprValue(toEvExpr(*lengthExpr), stmtCtx));
// F2018 7.4.4.2 point 5.
funcPtrResultLength =
fir::factory::genMaxWithZero(builder, loc, rawLen);
}
}
if (!funcPtrResultLength)
funcPtrResultLength = builder.createIntegerConstant(
loc, builder.getCharacterLengthType(), -1);
return fir::CharBoxValue{funcPtr, funcPtrResultLength};
}
return funcPtr;
}
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) {
fir::ExtendedValue procExv =
convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
// Directly package the procedure address as a fir.boxproc or
// tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Value funcAddr = fir::getBase(procExv);
if (!funcAddr.getType().isa<fir::BoxProcType>()) {
mlir::Type boxTy =
Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))
funcAddr = builder.create<fir::EmboxProcOp>(
loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
else
funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
}
mlir::Value res = procExv.match(
[&](const fir::CharBoxValue &box) -> mlir::Value {
mlir::Type tupleTy =
fir::factory::getCharacterProcedureTupleType(funcAddr.getType());
return fir::factory::createCharacterProcedureTuple(
builder, loc, tupleTy, funcAddr, box.getLen());
},
[funcAddr](const auto &) { return funcAddr; });
return hlfir::EntityWithAttributes{res};
}
|
