} // namespace semantics
namespace lower {
+class SymMap;
namespace pft {
struct Variable;
}
virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0;
virtual fir::ExtendedValue
- getSymbolExtendedValue(const Fortran::semantics::Symbol &sym) = 0;
+ getSymbolExtendedValue(const Fortran::semantics::Symbol &sym,
+ Fortran::lower::SymMap *symMap = nullptr) = 0;
/// Get the binding of an implied do variable by name.
virtual mlir::Value impliedDoBinding(llvm::StringRef name) = 0;
fir::FortranVariableFlagsAttr
translateSymbolAttributes(mlir::MLIRContext *mlirContext,
const Fortran::semantics::Symbol &sym);
+
+/// Map a symbol to a given fir::ExtendedValue. This will generate an
+/// hlfir.declare when lowering to HLFIR and map the hlfir.declare result to the
+/// symbol.
+void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap,
+ const Fortran::semantics::Symbol &sym,
+ const fir::ExtendedValue &exv, bool force = false);
+
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERT_VARIABLE_H
// symbol).
using Box = fir::BoxValue;
- using VT = std::variant<Intrinsic, FullDim, Char, CharFullDim,
- PointerOrAllocatable, Box, None>;
+ using VT =
+ std::variant<Intrinsic, FullDim, Char, CharFullDim, PointerOrAllocatable,
+ Box, fir::FortranVariableOpInterface, None>;
//===--------------------------------------------------------------------===//
// Constructors
explicit operator bool() const { return !std::holds_alternative<None>(box); }
- fir::ExtendedValue toExtendedValue() const {
- return match(
- [](const Fortran::lower::SymbolBox::Intrinsic &box)
- -> fir::ExtendedValue { return box.getAddr(); },
- [](const Fortran::lower::SymbolBox::None &) -> fir::ExtendedValue {
- llvm::report_fatal_error("symbol not mapped");
- },
- [](const auto &box) -> fir::ExtendedValue { return box; });
- }
-
//===--------------------------------------------------------------------===//
// Accessors
//===--------------------------------------------------------------------===//
/// array, etc.
mlir::Value getAddr() const {
return match([](const None &) { return mlir::Value{}; },
- [](const auto &x) { return x.getAddr(); });
- }
-
- /// Does the boxed value have an intrinsic type?
- bool isIntrinsic() const {
- return match([](const Intrinsic &) { return true; },
- [](const Char &) { return true; },
- [](const PointerOrAllocatable &x) {
- return !x.isDerived() && !x.isUnlimitedPolymorphic();
+ [](const fir::FortranVariableOpInterface &x) {
+ return fir::FortranVariableOpInterface(x).getBase();
},
- [](const Box &x) {
- return !x.isDerived() && !x.isUnlimitedPolymorphic();
- },
- [](const auto &x) { return false; });
- }
-
- /// Does the boxed value have a rank greater than zero?
- bool hasRank() const {
- return match([](const Intrinsic &) { return false; },
- [](const Char &) { return false; },
- [](const None &) { return false; },
- [](const PointerOrAllocatable &x) { return x.hasRank(); },
- [](const Box &x) { return x.hasRank(); },
- [](const auto &x) { return x.getExtents().size() > 0; });
+ [](const auto &x) { return x.getAddr(); });
}
- /// Does the boxed value have trivial lower bounds (== 1)?
- bool hasSimpleLBounds() const {
+ std::optional<fir::FortranVariableOpInterface>
+ getIfFortranVariableOpInterface() {
return match(
- [](const FullDim &arr) { return arr.getLBounds().empty(); },
- [](const CharFullDim &arr) { return arr.getLBounds().empty(); },
- [](const Box &arr) { return arr.getLBounds().empty(); },
- [](const auto &) { return false; });
- }
-
- /// Does the boxed value have a constant shape?
- bool hasConstantShape() const {
- if (auto eleTy = fir::dyn_cast_ptrEleTy(getAddr().getType()))
- if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>())
- return !arrTy.hasDynamicExtents();
- return false;
- }
-
- /// Get the lbound if the box explicitly contains it.
- mlir::Value getLBound(unsigned dim) const {
- return match([&](const FullDim &box) { return box.getLBounds()[dim]; },
- [&](const CharFullDim &box) { return box.getLBounds()[dim]; },
- [&](const Box &box) { return box.getLBounds()[dim]; },
- [](const auto &) { return mlir::Value{}; });
+ [](const fir::FortranVariableOpInterface &x)
+ -> std::optional<fir::FortranVariableOpInterface> { return x; },
+ [](const auto &x) -> std::optional<fir::FortranVariableOpInterface> {
+ return std::nullopt;
+ });
}
/// Apply the lambda `func` to this box value.
template <typename ON, typename RT>
- constexpr RT apply(RT(&&func)(const ON &)) const {
+ constexpr RT apply(RT (&&func)(const ON &)) const {
if (auto *x = std::get_if<ON>(&box))
return func(*x);
return RT{};
void addVariableDefinition(semantics::SymbolRef symRef,
fir::FortranVariableOpInterface definingOp,
bool force = false) {
- const auto *sym = &symRef.get().GetUltimate();
- if (force)
- symbolMapStack.back().erase(sym);
- symbolMapStack.back().try_emplace(sym, definingOp);
+ makeSym(symRef, SymbolBox(definingOp), force);
+ }
+
+ void copySymbolBinding(semantics::SymbolRef src,
+ semantics::SymbolRef target) {
+ auto symBox = lookupSymbol(src);
+ assert(symBox && "source binding does not exists");
+ makeSym(target, symBox, /*force=*/false);
}
std::optional<fir::FortranVariableOpInterface>
- lookupVariableDefinition(semantics::SymbolRef sym);
+ lookupVariableDefinition(semantics::SymbolRef sym) {
+ if (auto symBox = lookupSymbol(sym))
+ return symBox.getIfFortranVariableOpInterface();
+ return std::nullopt;
+ }
private:
/// Add `symbol` to the current map and bind a `box`.
symbolMapStack.back().try_emplace(sym, box);
}
- llvm::SmallVector<
- llvm::DenseMap<const semantics::Symbol *,
- std::variant<SymbolBox, fir::FortranVariableOpInterface>>>
+ llvm::SmallVector<llvm::DenseMap<const semantics::Symbol *, SymbolBox>>
symbolMapStack;
// Implied DO induction variables are not represented as Se::Symbol in
}
fir::ExtendedValue
- getSymbolExtendedValue(const Fortran::semantics::Symbol &sym) override final {
- Fortran::lower::SymbolBox sb = lookupSymbol(sym);
- assert(sb && "symbol box not found");
- return sb.toExtendedValue();
+ symBoxToExtendedValue(const Fortran::lower::SymbolBox &symBox) {
+ return symBox.match(
+ [](const Fortran::lower::SymbolBox::Intrinsic &box)
+ -> fir::ExtendedValue { return box.getAddr(); },
+ [](const Fortran::lower::SymbolBox::None &) -> fir::ExtendedValue {
+ llvm::report_fatal_error("symbol not mapped");
+ },
+ [&](const fir::FortranVariableOpInterface &x) -> fir::ExtendedValue {
+ return hlfir::translateToExtendedValue(getCurrentLocation(),
+ getFirOpBuilder(), x);
+ },
+ [](const auto &box) -> fir::ExtendedValue { return box; });
+ }
+
+ fir::ExtendedValue
+ getSymbolExtendedValue(const Fortran::semantics::Symbol &sym,
+ Fortran::lower::SymMap *symMap) override final {
+ Fortran::lower::SymbolBox sb = lookupSymbol(sym, symMap);
+ if (!sb) {
+ LLVM_DEBUG(llvm::dbgs() << "unknown symbol: " << sym << "\nmap: "
+ << (symMap ? *symMap : localSymbols) << '\n');
+ fir::emitFatalError(getCurrentLocation(),
+ "symbol is not mapped to any IR value");
+ }
+ return symBoxToExtendedValue(sb);
}
mlir::Value impliedDoBinding(llvm::StringRef name) override final {
void copySymbolBinding(Fortran::lower::SymbolRef src,
Fortran::lower::SymbolRef target) override final {
- if (lowerToHighLevelFIR()) {
- auto srcDef = localSymbols.lookupVariableDefinition(src);
- assert(srcDef && "source binding does not exists");
- localSymbols.addVariableDefinition(target, *srcDef);
- } else {
- localSymbols.addSymbol(target, lookupSymbol(src).toExtendedValue());
- }
+ localSymbols.copySymbolBinding(src, target);
}
/// Add the symbol binding to the inner-most level of the symbol map and
void bindSymbol(Fortran::lower::SymbolRef sym,
const fir::ExtendedValue &exval) override final {
- localSymbols.addSymbol(sym, exval, /*forced=*/true);
+ addSymbol(sym, exval, /*forced=*/true);
}
bool lookupLabelSet(Fortran::lower::SymbolRef sym,
/// Find the symbol in the local map or return null.
Fortran::lower::SymbolBox
- lookupSymbol(const Fortran::semantics::Symbol &sym) {
+ lookupSymbol(const Fortran::semantics::Symbol &sym,
+ Fortran::lower::SymMap *symMap = nullptr) {
+ symMap = symMap ? symMap : &localSymbols;
if (lowerToHighLevelFIR()) {
if (std::optional<fir::FortranVariableOpInterface> var =
- localSymbols.lookupVariableDefinition(sym)) {
+ symMap->lookupVariableDefinition(sym)) {
auto exv =
hlfir::translateToExtendedValue(toLocation(), *builder, *var);
return exv.match(
}
return {};
}
- if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
+ if (Fortran::lower::SymbolBox v = symMap->lookupSymbol(sym))
return v;
return {};
}
/// Add the symbol to the local map and return `true`. If the symbol is
/// already in the map and \p forced is `false`, the map is not updated.
/// Instead the value `false` is returned.
- bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val,
- bool forced = false) {
+ bool addSymbol(const Fortran::semantics::SymbolRef sym,
+ fir::ExtendedValue val, bool forced = false) {
if (!forced && lookupSymbol(sym))
return false;
- localSymbols.addSymbol(sym, val, forced);
+ if (lowerToHighLevelFIR()) {
+ Fortran::lower::genDeclareSymbol(*this, localSymbols, sym, val, forced);
+ } else {
+ localSymbols.addSymbol(sym, val, forced);
+ }
return true;
}
- bool addCharSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val,
- mlir::Value len, bool forced = false) {
+ /// Map a block argument to a result or dummy symbol. This is not the
+ /// definitive mapping. The specification expression have not been lowered
+ /// yet. The final mapping will be done using this pre-mapping in
+ /// Fortran::lower::mapSymbolAttributes.
+ bool mapBlockArgToDummyOrResult(const Fortran::semantics::SymbolRef sym,
+ mlir::Value val, bool forced = false) {
if (!forced && lookupSymbol(sym))
return false;
- // TODO: ensure val type is fir.array<len x fir.char<kind>> like. Insert
- // cast if needed.
- localSymbols.addCharSymbol(sym, val, len, forced);
+ localSymbols.addSymbol(sym, val, forced);
return true;
}
fir::ExtendedValue getExtendedValue(Fortran::lower::SymbolBox sb) {
- return sb.match(
- [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &box) {
- return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(),
- box);
- },
- [&sb](auto &) { return sb.toExtendedValue(); });
+ fir::ExtendedValue exv = symBoxToExtendedValue(sb);
+ // Dereference pointers and allocatables.
+ if (const auto *box = exv.getBoxOf<fir::MutableBoxValue>())
+ return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(),
+ *box);
+ return exv;
}
/// Generate the address of loop variable \p sym.
Fortran::lower::getAdaptToByRefAttr(*builder)});
mlir::Value cast = builder->createConvert(loc, toTy, inducVar);
builder->create<fir::StoreOp>(loc, cast, tmp);
- localSymbols.addSymbol(*sym, tmp, /*force=*/true);
+ addSymbol(*sym, tmp, /*force=*/true);
}
/// Process a concurrent header for a FORALL. (Concurrent headers for DO
*std::get<Fortran::parser::Name>(assoc.t).symbol;
const Fortran::lower::SomeExpr &selector =
*sym.get<Fortran::semantics::AssocEntityDetails>().expr();
- localSymbols.addSymbol(sym, genAssociateSelector(selector, stmtCtx));
+ addSymbol(sym, genAssociateSelector(selector, stmtCtx));
}
} else if (e.getIf<Fortran::parser::EndAssociateStmt>()) {
if (eval.lowerAsUnstructured())
for (auto &symbol : guardScope.GetSymbols()) {
if (symbol->GetUltimate()
.detailsIf<Fortran::semantics::AssocEntityDetails>()) {
- localSymbols.addSymbol(symbol, exv);
+ addSymbol(symbol, exv);
break;
}
}
}
}
- void mapCPtrArgByValue(const Fortran::semantics::Symbol &sym,
- mlir::Value val) {
- mlir::Type symTy = Fortran::lower::translateSymbolToFIRType(*this, sym);
- mlir::Location loc = toLocation();
- mlir::Value res = builder->create<fir::AllocaOp>(loc, symTy);
- mlir::Value resAddr =
- fir::factory::genCPtrOrCFunptrAddr(*builder, loc, res, symTy);
- mlir::Value argAddrVal =
- builder->createConvert(loc, fir::unwrapRefType(resAddr.getType()), val);
- builder->create<fir::StoreOp>(loc, argAddrVal, resAddr);
- addSymbol(sym, res);
- }
-
- void mapTrivialByValue(const Fortran::semantics::Symbol &sym,
- mlir::Value val) {
- mlir::Location loc = toLocation();
- mlir::Value res = builder->create<fir::AllocaOp>(loc, val.getType());
- builder->create<fir::StoreOp>(loc, val, res);
- addSymbol(sym, res);
- }
-
/// Map mlir function block arguments to the corresponding Fortran dummy
/// variables. When the result is passed as a hidden argument, the Fortran
/// result is also mapped. The symbol map is used to hold this mapping.
fir::factory::CharacterExprHelper charHelp{*builder, loc};
mlir::Value box =
charHelp.createEmboxChar(arg.firArgument, arg.firLength);
- addSymbol(arg.entity->get(), box);
+ mapBlockArgToDummyOrResult(arg.entity->get(), box);
} else {
if (arg.entity.has_value()) {
- if (arg.passBy == PassBy::Value) {
- mlir::Type argTy = arg.firArgument.getType();
- if (argTy.isa<fir::RecordType>())
- TODO(toLocation(), "derived type argument passed by value");
- if (Fortran::semantics::IsBuiltinCPtr(arg.entity->get()) &&
- Fortran::lower::isCPtrArgByValueType(argTy)) {
- mapCPtrArgByValue(arg.entity->get(), arg.firArgument);
- return;
- }
- if (fir::isa_trivial(argTy)) {
- mapTrivialByValue(arg.entity->get(), arg.firArgument);
- return;
- }
- }
- addSymbol(arg.entity->get(), arg.firArgument);
+ mapBlockArgToDummyOrResult(arg.entity->get(), arg.firArgument);
} else {
assert(funit.parentHasTupleHostAssoc() && "expect tuple argument");
}
// FIXME: need to make sure things are OK here. addSymbol may not be OK
if (funit.primaryResult &&
passedResult->entity->get() != *funit.primaryResult)
- addSymbol(*funit.primaryResult,
- getSymbolAddress(passedResult->entity->get()));
+ mapBlockArgToDummyOrResult(
+ *funit.primaryResult,
+ getSymbolAddress(passedResult->entity->get()));
}
}
Fortran::lower::StatementContext stmtCtx;
if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
passedResult = callee.getPassedResult()) {
- addSymbol(altResult.getSymbol(), resultArg.getAddr());
+ mapBlockArgToDummyOrResult(altResult.getSymbol(), resultArg.getAddr());
Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols,
stmtCtx);
} else {
mlir::Value charFuncPointerLength;
if (const Fortran::semantics::Symbol *sym =
caller.getIfIndirectCallSymbol()) {
- funcPointer = symMap.lookupSymbol(*sym).getAddr();
+ funcPointer = fir::getBase(converter.getSymbolExtendedValue(*sym, &symMap));
if (!funcPointer)
fir::emitFatalError(loc, "failed to find indirect call symbol address");
if (fir::isCharacterProcedureTuple(funcPointer.getType(),
const Fortran::evaluate::Component *component =
caller.getCallDescription().proc().GetComponent();
assert(component && "expect component for type-bound procedure call.");
- fir::ExtendedValue pass =
- symMap.lookupSymbol(component->GetFirstSymbol()).toExtendedValue();
+ fir::ExtendedValue pass = converter.getSymbolExtendedValue(
+ component->GetFirstSymbol(), &symMap);
mlir::Value passObject = fir::getBase(pass);
if (fir::isa_ref_type(passObject.getType()))
passObject = builder.create<fir::ConvertOp>(
return std::visit(
Fortran::common::visitors{
[&](const Fortran::evaluate::SymbolRef &sym) -> ExtValue {
- return symMap.lookupSymbol(*sym).toExtendedValue();
+ return converter.getSymbolExtendedValue(*sym, &symMap);
},
[&](const Fortran::evaluate::Component &comp) -> ExtValue {
return genComponent(comp);
/// Returns a reference to a symbol or its box/boxChar descriptor if it has
/// one.
ExtValue gen(Fortran::semantics::SymbolRef sym) {
- if (Fortran::lower::SymbolBox val = symMap.lookupSymbol(sym))
- return val.match(
- [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &boxAddr) {
- return fir::factory::genMutableBoxRead(builder, getLoc(), boxAddr);
- },
- [&val](auto &) { return val.toExtendedValue(); });
- LLVM_DEBUG(llvm::dbgs()
- << "unknown symbol: " << sym << "\nmap: " << symMap << '\n');
- fir::emitFatalError(getLoc(), "symbol is not mapped to any IR value");
+ fir::ExtendedValue exv = converter.getSymbolExtendedValue(sym, &symMap);
+ if (const auto *box = exv.getBoxOf<fir::MutableBoxValue>())
+ return fir::factory::genMutableBoxRead(builder, getLoc(), *box);
+ return exv;
}
ExtValue genLoad(const ExtValue &exv) {
assert(argExpr);
const Fortran::semantics::Symbol *sym =
Fortran::evaluate::GetFirstSymbol(*argExpr);
- fir::ExtendedValue exv =
- globalOpSymMap.lookupSymbol(sym).toExtendedValue();
- const auto *mold = exv.getBoxOf<fir::MutableBoxValue>();
- fir::BaseBoxType boxType = mold->getBoxTy();
+ assert(sym && "MOLD must be a pointer or allocatable symbol");
+ mlir::Type boxType = converter.genType(*sym);
mlir::Value box =
fir::factory::createUnallocatedBox(builder, loc, boxType, {});
return box;
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
const Fortran::semantics::Symbol &sym = var.getSymbol();
- fir::ExtendedValue exv = symMap.lookupSymbol(sym).toExtendedValue();
+ fir::ExtendedValue exv = converter.getSymbolExtendedValue(sym, &symMap);
if (Fortran::semantics::IsOptional(sym)) {
// 15.5.2.12 point 3, absent optional dummies are not initialized.
// Creating descriptor/passing null descriptor to the runtime would
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
const Fortran::semantics::Symbol &sym = var.getSymbol();
- fir::ExtendedValue exv = symMap.lookupSymbol(sym).toExtendedValue();
+ fir::ExtendedValue exv = converter.getSymbolExtendedValue(sym, &symMap);
if (Fortran::semantics::IsOptional(sym)) {
// Only finalize if present.
auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
if (Fortran::semantics::IsDummy(sym) &&
Fortran::semantics::IsIntentOut(sym) &&
Fortran::semantics::IsAllocatable(sym)) {
- if (auto symbox = symMap.lookupSymbol(sym)) {
- fir::ExtendedValue extVal = symbox.toExtendedValue();
- if (auto mutBox = extVal.getBoxOf<fir::MutableBoxValue>()) {
- // The dummy argument is not passed in the ENTRY so it should not be
- // deallocated.
- if (mlir::Operation *op = mutBox->getAddr().getDefiningOp())
- if (mlir::isa<fir::AllocaOp>(op))
- return;
- mlir::Location loc = converter.getCurrentLocation();
- fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- if (Fortran::semantics::IsOptional(sym)) {
- auto isPresent = builder.create<fir::IsPresentOp>(
- loc, builder.getI1Type(), fir::getBase(extVal));
- builder.genIfThen(loc, isPresent)
- .genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
+ fir::ExtendedValue extVal = converter.getSymbolExtendedValue(sym, &symMap);
+ if (auto mutBox = extVal.getBoxOf<fir::MutableBoxValue>()) {
+ // The dummy argument is not passed in the ENTRY so it should not be
+ // deallocated.
+ if (mlir::Operation *op = mutBox->getAddr().getDefiningOp())
+ if (mlir::isa<fir::AllocaOp>(op))
+ return;
+ mlir::Location loc = converter.getCurrentLocation();
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ if (Fortran::semantics::IsOptional(sym)) {
+ auto isPresent = builder.create<fir::IsPresentOp>(
+ loc, builder.getI1Type(), fir::getBase(extVal));
+ builder.genIfThen(loc, isPresent)
+ .genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
+ .end();
+ } else {
+ if (mutBox->isDerived() || mutBox->isPolymorphic() ||
+ mutBox->isUnlimitedPolymorphic()) {
+ mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
+ builder, loc, *mutBox);
+ builder.genIfThen(loc, isAlloc)
+ .genThen([&]() {
+ if (mutBox->isPolymorphic()) {
+ mlir::Value declaredTypeDesc;
+ assert(sym.GetType());
+ if (const Fortran::semantics::DerivedTypeSpec
+ *derivedTypeSpec = sym.GetType()->AsDerived()) {
+ declaredTypeDesc = Fortran::lower::getTypeDescAddr(
+ converter, loc, *derivedTypeSpec);
+ }
+ genDeallocateBox(converter, *mutBox, loc, declaredTypeDesc);
+ } else {
+ genDeallocateBox(converter, *mutBox, loc);
+ }
+ })
.end();
} else {
- if (mutBox->isDerived() || mutBox->isPolymorphic() ||
- mutBox->isUnlimitedPolymorphic()) {
- mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
- builder, loc, *mutBox);
- builder.genIfThen(loc, isAlloc)
- .genThen([&]() {
- if (mutBox->isPolymorphic()) {
- mlir::Value declaredTypeDesc;
- assert(sym.GetType());
- if (const Fortran::semantics::DerivedTypeSpec
- *derivedTypeSpec = sym.GetType()->AsDerived()) {
- declaredTypeDesc = Fortran::lower::getTypeDescAddr(
- converter, loc, *derivedTypeSpec);
- }
- genDeallocateBox(converter, *mutBox, loc, declaredTypeDesc);
- } else {
- genDeallocateBox(converter, *mutBox, loc);
- }
- })
- .end();
- } else {
- genDeallocateBox(converter, *mutBox, loc);
- }
+ genDeallocateBox(converter, *mutBox, loc);
}
}
}
auto *builder = &converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
fir::ExtendedValue exv =
- symMap.lookupSymbol(var.getSymbol()).toExtendedValue();
+ converter.getSymbolExtendedValue(var.getSymbol(), &symMap);
converter.getFctCtx().attachCleanup([builder, loc, exv]() {
mlir::Value box = builder->createBox(loc, exv);
fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
/// Map a symbol to its FIR address and evaluated specification expressions
/// provided as a fir::ExtendedValue. Will optionally create fir.declare.
-static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
- Fortran::lower::SymMap &symMap,
- const Fortran::semantics::Symbol &sym,
- const fir::ExtendedValue &exv,
- bool force = false) {
+void Fortran::lower::genDeclareSymbol(
+ Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap, const Fortran::semantics::Symbol &sym,
+ const fir::ExtendedValue &exv, bool force) {
if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const mlir::Location loc = genLocation(converter, sym);
bool replace = false) {
if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
fir::BoxValue boxValue{box, lbounds, explicitParams, explicitExtents};
- genDeclareSymbol(converter, symMap, sym, std::move(boxValue), replace);
+ Fortran::lower::genDeclareSymbol(converter, symMap, sym,
+ std::move(boxValue), replace);
return;
}
symMap.addBoxSymbol(sym, box, lbounds, explicitParams, explicitExtents,
Fortran::lower::getDummyProcedureType(sym, converter);
mlir::Value undefOp = builder.create<fir::UndefOp>(loc, dummyProcType);
- genDeclareSymbol(converter, symMap, sym, undefOp);
+ Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
}
if (Fortran::semantics::IsPointer(sym))
TODO(loc, "procedure pointers");
"handled above");
// The box is read right away because lowering code does not expect
// a non pointer/allocatable symbol to be mapped to a MutableBox.
- genDeclareSymbol(converter, symMap, sym,
- fir::factory::genMutableBoxRead(
- builder, loc,
- fir::factory::createTempMutableBox(
- builder, loc, converter.genType(var))));
+ Fortran::lower::genDeclareSymbol(
+ converter, symMap, sym,
+ fir::factory::genMutableBoxRead(
+ builder, loc,
+ fir::factory::createTempMutableBox(builder, loc,
+ converter.genType(var))));
return true;
}
return false;
// Allocate or extract raw address for the entity
if (!addr) {
if (arg) {
- if (fir::isa_trivial(arg.getType())) {
- // FIXME: Argument passed in registers (like scalar VALUE in BIND(C)
- // procedures) Should allocate local + store. Nothing done for now to
- // keep the NFC aspect.
- addr = arg;
+ mlir::Type argType = arg.getType();
+ const bool isCptrByVal = Fortran::semantics::IsBuiltinCPtr(sym) &&
+ Fortran::lower::isCPtrArgByValueType(argType);
+ if (isCptrByVal || !fir::conformsWithPassByRef(argType)) {
+ // Dummy argument passed in register. Place the value in memory at that
+ // point since lowering expect symbols to be mapped to memory addresses.
+ if (argType.isa<fir::RecordType>())
+ TODO(loc, "derived type argument passed by value");
+ mlir::Type symType = converter.genType(sym);
+ addr = builder.create<fir::AllocaOp>(loc, symType);
+ if (isCptrByVal) {
+ // Place the void* address into the CPTR address component.
+ mlir::Value addrComponent =
+ fir::factory::genCPtrOrCFunptrAddr(builder, loc, addr, symType);
+ builder.createStoreWithConvert(loc, arg, addrComponent);
+ } else {
+ builder.createStoreWithConvert(loc, arg, addr);
+ }
} else {
// Dummy address, or address of result whose storage is passed by the
// caller.
- assert(fir::isa_ref_type(arg.getType()) && "must be a memory address");
+ assert(fir::isa_ref_type(argType) && "must be a memory address");
addr = arg;
}
} else {
}
}
- genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds,
- replace);
+ ::genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds,
+ replace);
return;
}
// variables, whether or not the host symbol is actually referred to in
// `B`. Hence it is possible to simply lookup the variable associated to
// the host symbol without having to go back to the tuple argument.
- Fortran::lower::SymbolBox hostValue =
- symMap.lookupSymbol(hostDetails->symbol());
- assert(hostValue && "callee host symbol must be mapped on caller side");
- symMap.addSymbol(sym, hostValue.toExtendedValue());
+ symMap.copySymbolBinding(hostDetails->symbol(), sym);
// The SymbolBox associated to the host symbols is complete, skip
// instantiateVariable that would try to allocate a new storage.
continue;
mlir::Type varTy = tupTy.getType(indexInTuple);
mlir::Value eleOff = genTupleCoor(builder, loc, varTy, hostTuple, off);
InstantiateHostTuple instantiateHostTuple{
- symMap.lookupSymbol(s.value()).toExtendedValue(), eleOff, loc};
+ converter.getSymbolExtendedValue(*s.value(), &symMap), eleOff, loc};
walkCaptureCategories(instantiateHostTuple, converter, *s.value());
}
});
}
-Fortran::lower::SymbolBox toSymbolBox(
- std::variant<Fortran::lower::SymbolBox, fir::FortranVariableOpInterface>
- symboxOrdefiningOp) {
- if (const Fortran::lower::SymbolBox *symBox =
- std::get_if<Fortran::lower::SymbolBox>(&symboxOrdefiningOp))
- return *symBox;
- auto definingOp =
- std::get<fir::FortranVariableOpInterface>(symboxOrdefiningOp);
- TODO(definingOp.getLoc(), "FortranVariableOpInterface lookup as SymbolBox");
-}
-
Fortran::lower::SymbolBox
Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef symRef) {
Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
jmap != jend; ++jmap) {
auto iter = jmap->find(&*sym);
if (iter != jmap->end())
- return toSymbolBox(iter->second);
+ return iter->second;
}
return SymbolBox::None{};
}
auto &map = symbolMapStack.back();
auto iter = map.find(&symRef.get().GetUltimate());
if (iter != map.end())
- return toSymbolBox(iter->second);
+ return iter->second;
return SymbolBox::None{};
}
for (++jmap; jmap != jend; ++jmap) {
auto iter = jmap->find(&*sym);
if (iter != jmap->end())
- return toSymbolBox(iter->second);
+ return iter->second;
}
return SymbolBox::None{};
}
return {};
}
-std::optional<fir::FortranVariableOpInterface>
-Fortran::lower::SymMap::lookupVariableDefinition(semantics::SymbolRef symRef) {
- Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
- for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend();
- jmap != jend; ++jmap) {
- auto iter = jmap->find(&*sym);
- if (iter != jmap->end()) {
- if (const auto *varDef =
- std::get_if<fir::FortranVariableOpInterface>(&iter->second))
- return *varDef;
- else
- return std::nullopt;
- }
- }
- return std::nullopt;
-}
-
llvm::raw_ostream &
Fortran::lower::operator<<(llvm::raw_ostream &os,
const Fortran::lower::SymbolBox &symBox) {
return os;
}
-static llvm::raw_ostream &
-dump(llvm::raw_ostream &os,
- const std::variant<Fortran::lower::SymbolBox,
- fir::FortranVariableOpInterface> &symboxOrdefiningOp) {
- if (const Fortran::lower::SymbolBox *symBox =
- std::get_if<Fortran::lower::SymbolBox>(&symboxOrdefiningOp))
- return os << *symBox;
- auto definingOp =
- std::get<fir::FortranVariableOpInterface>(symboxOrdefiningOp);
- return os << definingOp << "\n";
-}
-
llvm::raw_ostream &
Fortran::lower::operator<<(llvm::raw_ostream &os,
const Fortran::lower::SymMap &symMap) {
for (auto iter : i.value()) {
os << " symbol @" << static_cast<const void *>(iter.first) << " ["
<< *iter.first << "] ->\n ";
- dump(os, iter.second);
+ os << iter.second;
}
os << " }>\n";
}
! CHECK-LABEL: func.func @test_callee_c_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i64> {fir.bindc_name = "ptr1"}) attributes {fir.bindc_name = "test_callee_c_ptr"} {
+! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_ptrElocal"}
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i64>) -> i64
! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref<i64>
-! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_ptrElocal"}
! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK-LABEL: func.func @test_callee_c_funptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i64> {fir.bindc_name = "ptr1"}) attributes {fir.bindc_name = "test_callee_c_funptr"} {
+! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_funptrElocal"}
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i64>) -> i64
! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref<i64>
-! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_funptrElocal"}
+
! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
! CHECK-LABEL: func.func @f_int_to_char(
! CHECK-SAME: %[[ARG0:.*]]: i32 {fir.bindc_name = "i"}) -> !fir.char<1> attributes {fir.bindc_name = "f_int_to_char"} {
! CHECK: %[[CHARBOX:.*]] = fir.alloca !fir.char<1> {adapt.valuebyref}
+! CHECK: %[[RESULT:.*]] = fir.alloca !fir.char<1> {bindc_name = "f_int_to_char", uniq_name = "_QFf_int_to_charEf_int_to_char"}
! CHECK: %[[INT_I:.*]] = fir.alloca i32
! CHECK: fir.store %[[ARG0]] to %[[INT_I]] : !fir.ref<i32>
-! CHECK: %[[RESULT:.*]] = fir.alloca !fir.char<1> {bindc_name = "f_int_to_char", uniq_name = "_QFf_int_to_charEf_int_to_char"}
! CHECK: %[[ARG0_2:.*]] = fir.load %[[INT_I]] : !fir.ref<i32>
! CHECK: %[[ARG0_I64:.*]] = fir.convert %[[ARG0_2]] : (i32) -> i64
! CHECK: %[[ARG0_I8:.*]] = fir.convert %[[ARG0_I64]] : (i64) -> i8