From ab9c4e9fff272dd88c92a2d2f3a2e5c66e07e6e2 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 7 Feb 2023 09:22:47 +0100 Subject: [PATCH] [flang][NFC] addSymbol/lookupSymbol clean-up HLFIR requires mapping symbol to a single mlir::Value (produced by a fir::FortranVariableOpInterface), while the current lowering maps the value to a fir::ExtdendedValue. So far, the HLFIR symbol query was a special one. Hence, all the code directly using symMap.lookupSymbol and symMap.addSymbol did not work with the lowering to HLFIR. Refactor the code so that symbol lookup and add symbol go through the converter in a centralize place that handles the HLFIR case (translate fir::FortranVariableOpInterface to fir::ExtdendedValue in lookups, and generate hlfir.declare when adding symbols). In the refactoring, fir::FortranVariableOpInterface is added as a symbolBox variant to avoid special casing all lookups (shallowLookup...). Remove some unused SymbolBox member function instead of updating them. Differential Revision: https://reviews.llvm.org/D143395 --- flang/include/flang/Lower/AbstractConverter.h | 4 +- flang/include/flang/Lower/ConvertVariable.h | 9 ++ flang/include/flang/Lower/SymbolMap.h | 94 ++++-------- flang/lib/Lower/Bridge.cpp | 141 ++++++++--------- flang/lib/Lower/ConvertCall.cpp | 6 +- flang/lib/Lower/ConvertExpr.cpp | 15 +- flang/lib/Lower/ConvertVariable.cpp | 145 +++++++++--------- flang/lib/Lower/HostAssociations.cpp | 2 +- flang/lib/Lower/SymbolMap.cpp | 48 +----- .../Lower/c-interoperability-c-pointer.f90 | 5 +- flang/test/Lower/call.f90 | 2 +- 11 files changed, 198 insertions(+), 273 deletions(-) diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 7a82c376020a..cd512e9d9f7e 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -56,6 +56,7 @@ class DerivedTypeSpec; } // namespace semantics namespace lower { +class SymMap; namespace pft { struct Variable; } @@ -81,7 +82,8 @@ public: 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; diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h index a77dcedea902..88e5e523045a 100644 --- a/flang/include/flang/Lower/ConvertVariable.h +++ b/flang/include/flang/Lower/ConvertVariable.h @@ -116,5 +116,14 @@ void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter, 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 diff --git a/flang/include/flang/Lower/SymbolMap.h b/flang/include/flang/Lower/SymbolMap.h index f6aa58632396..dc36a672f8c1 100644 --- a/flang/include/flang/Lower/SymbolMap.h +++ b/flang/include/flang/Lower/SymbolMap.h @@ -75,8 +75,9 @@ struct SymbolBox : public fir::details::matcher { // symbol). using Box = fir::BoxValue; - using VT = std::variant; + using VT = + std::variant; //===--------------------------------------------------------------------===// // Constructors @@ -88,16 +89,6 @@ struct SymbolBox : public fir::details::matcher { explicit operator bool() const { return !std::holds_alternative(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 //===--------------------------------------------------------------------===// @@ -107,60 +98,25 @@ struct SymbolBox : public fir::details::matcher { /// array, etc. mlir::Value getAddr() const { return match([](const None &) { return mlir::Value{}; }, + [](const fir::FortranVariableOpInterface &x) { + return fir::FortranVariableOpInterface(x).getBase(); + }, [](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 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; }); - } - - /// Does the boxed value have trivial lower bounds (== 1)? - bool hasSimpleLBounds() const { + std::optional + 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()) - 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 { return x; }, + [](const auto &x) -> std::optional { + return std::nullopt; + }); } /// Apply the lambda `func` to this box value. template - constexpr RT apply(RT(&&func)(const ON &)) const { + constexpr RT apply(RT (&&func)(const ON &)) const { if (auto *x = std::get_if(&box)) return func(*x); return RT{}; @@ -342,14 +298,22 @@ public: 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 - 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`. @@ -362,9 +326,7 @@ private: symbolMapStack.back().try_emplace(sym, box); } - llvm::SmallVector< - llvm::DenseMap>> + llvm::SmallVector> symbolMapStack; // Implied DO induction variables are not represented as Se::Symbol in diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index c0a5aa3c394c..5cf81c73d9f0 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -417,10 +417,31 @@ public: } 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 { @@ -432,13 +453,7 @@ public: 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 @@ -453,7 +468,7 @@ public: 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, @@ -778,10 +793,12 @@ private: /// 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 var = - localSymbols.lookupVariableDefinition(sym)) { + symMap->lookupVariableDefinition(sym)) { auto exv = hlfir::translateToExtendedValue(toLocation(), *builder, *var); return exv.match( @@ -792,7 +809,7 @@ private: } return {}; } - if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym)) + if (Fortran::lower::SymbolBox v = symMap->lookupSymbol(sym)) return v; return {}; } @@ -817,31 +834,37 @@ private: /// 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; + if (lowerToHighLevelFIR()) { + Fortran::lower::genDeclareSymbol(*this, localSymbols, sym, val, forced); + } else { + localSymbols.addSymbol(sym, val, forced); + } + return true; + } + + /// 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; localSymbols.addSymbol(sym, val, forced); return true; } - bool addCharSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, - mlir::Value len, bool forced = false) { - if (!forced && lookupSymbol(sym)) - return false; - // TODO: ensure val type is fir.array> like. Insert - // cast if needed. - localSymbols.addCharSymbol(sym, val, len, 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()) + return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(), + *box); + return exv; } /// Generate the address of loop variable \p sym. @@ -1635,7 +1658,7 @@ private: Fortran::lower::getAdaptToByRefAttr(*builder)}); mlir::Value cast = builder->createConvert(loc, toTy, inducVar); builder->create(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 @@ -2084,7 +2107,7 @@ private: *std::get(assoc.t).symbol; const Fortran::lower::SomeExpr &selector = *sym.get().expr(); - localSymbols.addSymbol(sym, genAssociateSelector(selector, stmtCtx)); + addSymbol(sym, genAssociateSelector(selector, stmtCtx)); } } else if (e.getIf()) { if (eval.lowerAsUnstructured()) @@ -2255,7 +2278,7 @@ private: for (auto &symbol : guardScope.GetSymbols()) { if (symbol->GetUltimate() .detailsIf()) { - localSymbols.addSymbol(symbol, exv); + addSymbol(symbol, exv); break; } } @@ -3208,27 +3231,6 @@ private: } } - 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(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(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(loc, val.getType()); - builder->create(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. @@ -3246,24 +3248,10 @@ private: 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()) - 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"); } @@ -3278,8 +3266,9 @@ private: // 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())); } } @@ -3381,7 +3370,7 @@ private: Fortran::lower::StatementContext stmtCtx; if (std::optional passedResult = callee.getPassedResult()) { - addSymbol(altResult.getSymbol(), resultArg.getAddr()); + mapBlockArgToDummyOrResult(altResult.getSymbol(), resultArg.getAddr()); Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols, stmtCtx); } else { diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 7f1da9105a74..751e57c55a27 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -121,7 +121,7 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult( 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(), @@ -347,8 +347,8 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult( 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( diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index cd9450e72909..e4ccddc84f1c 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -746,7 +746,7 @@ public: 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); @@ -841,15 +841,10 @@ public: /// 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()) + return fir::factory::genMutableBoxRead(builder, getLoc(), *box); + return exv; } ExtValue genLoad(const ExtValue &exv) { diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index a072f2f007fe..1b3036d295ae 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -248,10 +248,8 @@ mlir::Value Fortran::lower::genInitialDataTarget( assert(argExpr); const Fortran::semantics::Symbol *sym = Fortran::evaluate::GetFirstSymbol(*argExpr); - fir::ExtendedValue exv = - globalOpSymMap.lookupSymbol(sym).toExtendedValue(); - const auto *mold = exv.getBoxOf(); - 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; @@ -617,7 +615,7 @@ defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter, 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 @@ -683,7 +681,7 @@ static void finalizeAtRuntime(Fortran::lower::AbstractConverter &converter, 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(loc, builder.getI1Type(), @@ -716,46 +714,44 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter, 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()) { - // 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(op)) - return; - mlir::Location loc = converter.getCurrentLocation(); - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - if (Fortran::semantics::IsOptional(sym)) { - auto isPresent = builder.create( - 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()) { + // 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(op)) + return; + mlir::Location loc = converter.getCurrentLocation(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + if (Fortran::semantics::IsOptional(sym)) { + auto isPresent = builder.create( + 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); } } } @@ -780,7 +776,7 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter, 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); @@ -1488,11 +1484,10 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter, /// 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); @@ -1544,7 +1539,8 @@ static void genBoxDeclare(Fortran::lower::AbstractConverter &converter, 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, @@ -1580,7 +1576,7 @@ void Fortran::lower::mapSymbolAttributes( Fortran::lower::getDummyProcedureType(sym, converter); mlir::Value undefOp = builder.create(loc, dummyProcType); - genDeclareSymbol(converter, symMap, sym, undefOp); + Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp); } if (Fortran::semantics::IsPointer(sym)) TODO(loc, "procedure pointers"); @@ -1678,11 +1674,12 @@ void Fortran::lower::mapSymbolAttributes( "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; @@ -1853,15 +1850,28 @@ void Fortran::lower::mapSymbolAttributes( // 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()) + TODO(loc, "derived type argument passed by value"); + mlir::Type symType = converter.genType(sym); + addr = builder.create(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 { @@ -1873,8 +1883,8 @@ void Fortran::lower::mapSymbolAttributes( } } - genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds, - replace); + ::genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds, + replace); return; } @@ -1964,10 +1974,7 @@ void Fortran::lower::mapCallInterfaceSymbols( // 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; diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp index a4ab3b905f1f..bfbdfbb37039 100644 --- a/flang/lib/Lower/HostAssociations.cpp +++ b/flang/lib/Lower/HostAssociations.cpp @@ -517,7 +517,7 @@ void Fortran::lower::HostAssociations::hostProcedureBindings( 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()); } diff --git a/flang/lib/Lower/SymbolMap.cpp b/flang/lib/Lower/SymbolMap.cpp index f61071150df8..2d9c16346cac 100644 --- a/flang/lib/Lower/SymbolMap.cpp +++ b/flang/lib/Lower/SymbolMap.cpp @@ -33,17 +33,6 @@ void Fortran::lower::SymMap::addSymbol(Fortran::semantics::SymbolRef sym, }); } -Fortran::lower::SymbolBox toSymbolBox( - std::variant - symboxOrdefiningOp) { - if (const Fortran::lower::SymbolBox *symBox = - std::get_if(&symboxOrdefiningOp)) - return *symBox; - auto definingOp = - std::get(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(); @@ -51,7 +40,7 @@ Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef symRef) { jmap != jend; ++jmap) { auto iter = jmap->find(&*sym); if (iter != jmap->end()) - return toSymbolBox(iter->second); + return iter->second; } return SymbolBox::None{}; } @@ -61,7 +50,7 @@ Fortran::lower::SymbolBox Fortran::lower::SymMap::shallowLookupSymbol( 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{}; } @@ -79,7 +68,7 @@ Fortran::lower::SymbolBox Fortran::lower::SymMap::lookupOneLevelUpSymbol( for (++jmap; jmap != jend; ++jmap) { auto iter = jmap->find(&*sym); if (iter != jmap->end()) - return toSymbolBox(iter->second); + return iter->second; } return SymbolBox::None{}; } @@ -92,23 +81,6 @@ Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) { return {}; } -std::optional -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(&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) { @@ -123,18 +95,6 @@ Fortran::lower::operator<<(llvm::raw_ostream &os, return os; } -static llvm::raw_ostream & -dump(llvm::raw_ostream &os, - const std::variant &symboxOrdefiningOp) { - if (const Fortran::lower::SymbolBox *symBox = - std::get_if(&symboxOrdefiningOp)) - return os << *symBox; - auto definingOp = - std::get(symboxOrdefiningOp); - return os << definingOp << "\n"; -} - llvm::raw_ostream & Fortran::lower::operator<<(llvm::raw_ostream &os, const Fortran::lower::SymMap &symMap) { @@ -144,7 +104,7 @@ Fortran::lower::operator<<(llvm::raw_ostream &os, for (auto iter : i.value()) { os << " symbol @" << static_cast(iter.first) << " [" << *iter.first << "] ->\n "; - dump(os, iter.second); + os << iter.second; } os << " }>\n"; } diff --git a/flang/test/Lower/c-interoperability-c-pointer.f90 b/flang/test/Lower/c-interoperability-c-pointer.f90 index 0c783637fd1d..95c76c026431 100644 --- a/flang/test/Lower/c-interoperability-c-pointer.f90 +++ b/flang/test/Lower/c-interoperability-c-pointer.f90 @@ -33,12 +33,12 @@ end ! CHECK-LABEL: func.func @test_callee_c_ptr( ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {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.field) -> !fir.ref ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> i64 ! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref -! 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.field) -> !fir.ref ! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> @@ -57,12 +57,13 @@ end subroutine ! CHECK-LABEL: func.func @test_callee_c_funptr( ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {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.field) -> !fir.ref ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> i64 ! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref -! 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.field) -> !fir.ref ! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> diff --git a/flang/test/Lower/call.f90 b/flang/test/Lower/call.f90 index afcd8d8a3045..2c6ee34297ab 100644 --- a/flang/test/Lower/call.f90 +++ b/flang/test/Lower/call.f90 @@ -47,9 +47,9 @@ end function ! 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 -! 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 ! CHECK: %[[ARG0_I64:.*]] = fir.convert %[[ARG0_2]] : (i32) -> i64 ! CHECK: %[[ARG0_I8:.*]] = fir.convert %[[ARG0_I64]] : (i64) -> i8