[flang-commits] [flang] 9e37301 - [flang][NFC] Simplify mapSymbolAttributes in symbol lowering
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Tue Oct 18 02:10:57 PDT 2022
Author: Jean Perier
Date: 2022-10-18T11:08:07+02:00
New Revision: 9e37301cf483237695325e199393ba5a84b7fc1e
URL: https://github.com/llvm/llvm-project/commit/9e37301cf483237695325e199393ba5a84b7fc1e
DIFF: https://github.com/llvm/llvm-project/commit/9e37301cf483237695325e199393ba5a84b7fc1e.diff
LOG: [flang][NFC] Simplify mapSymbolAttributes in symbol lowering
mapSymbolAttributes currently has a lot of very similar code for
each kind of explicit shape and scalar symbols.
Refactor it so that the change to lower symbols with fir.declare
can be added in centralized places instead of being scattered.
This is a preparation patch and fir.declare is not yet added.
Differential Revision: https://reviews.llvm.org/D136061
Added:
Modified:
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/test/Lower/HLFIR/expr-addr.f90
flang/test/Lower/HLFIR/expr-box.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 1ef6538d700b7..c98e335d85bd5 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2887,12 +2887,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// is not something that fits well with equivalence lowering.
for (const Fortran::lower::pft::Variable &altResult :
deferredFuncResultList) {
+ Fortran::lower::StatementContext stmtCtx;
if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
- passedResult = callee.getPassedResult())
+ passedResult = callee.getPassedResult()) {
addSymbol(altResult.getSymbol(), resultArg.getAddr());
- Fortran::lower::StatementContext stmtCtx;
- Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols,
- stmtCtx, primaryFuncResultStorage);
+ Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols,
+ stmtCtx);
+ } else {
+ Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols,
+ stmtCtx, primaryFuncResultStorage);
+ }
}
// If this is a host procedure with host associations, then create the tuple
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 363526ac667de..ff8eba4458eef 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1293,6 +1293,81 @@ recoverShapeVector(llvm::ArrayRef<std::int64_t> shapeVec, mlir::Value initVal) {
return result;
}
+/// Map a symbol to its FIR address and evaluated specification expressions.
+/// Not for symbols lowered to fir.box.
+/// Will optionally create fir.declare.
+static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap,
+ const Fortran::semantics::Symbol &sym,
+ mlir::Value base, mlir::Value len = {},
+ llvm::ArrayRef<mlir::Value> shape = llvm::None,
+ llvm::ArrayRef<mlir::Value> lbounds = llvm::None,
+ bool force = false) {
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+ TODO(genLocation(converter, sym),
+ "generate fir.declare when lowering symbol");
+
+ if (len) {
+ if (!shape.empty()) {
+ if (!lbounds.empty())
+ symMap.addCharSymbolWithBounds(sym, base, len, shape, lbounds, force);
+ else
+ symMap.addCharSymbolWithShape(sym, base, len, shape, force);
+ } else {
+ symMap.addCharSymbol(sym, base, len, force);
+ }
+ } else {
+ if (!shape.empty()) {
+ if (!lbounds.empty())
+ symMap.addSymbolWithBounds(sym, base, shape, lbounds, force);
+ else
+ symMap.addSymbolWithShape(sym, base, shape, force);
+ } else {
+ symMap.addSymbol(sym, base, force);
+ }
+ }
+}
+
+/// 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) {
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+ TODO(genLocation(converter, sym),
+ "generate fir.declare from ExtendedValue");
+ symMap.addSymbol(sym, exv);
+}
+
+/// Map an allocatable or pointer symbol to its FIR address and evaluated
+/// specification expressions. Will optionally create fir.declare.
+static void
+genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap,
+ const Fortran::semantics::Symbol &sym,
+ fir::MutableBoxValue box, bool force = false) {
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+ TODO(genLocation(converter, sym),
+ "generate fir.declare for allocatable or pointers");
+ symMap.addAllocatableOrPointer(sym, box, force);
+}
+
+/// Map a symbol represented with a runtime descriptor to its FIR fir.box and
+/// evaluated specification expressions. Will optionally create fir.declare.
+static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap,
+ const Fortran::semantics::Symbol &sym,
+ mlir::Value box, llvm::ArrayRef<mlir::Value> lbounds,
+ llvm::ArrayRef<mlir::Value> explicitParams,
+ llvm::ArrayRef<mlir::Value> explicitExtents,
+ bool replace = false) {
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+ TODO(genLocation(converter, sym), "generate fir.declare for box");
+ symMap.addBoxSymbol(sym, box, lbounds, explicitParams, explicitExtents,
+ replace);
+}
+
/// Lower specification expressions and attributes of variable \p var and
/// add it to the symbol map. For a global or an alias, the address must be
/// pre-computed and provided in \p preAlloc. A dummy argument for the current
@@ -1321,7 +1396,8 @@ void Fortran::lower::mapSymbolAttributes(
mlir::Type dummyProcType =
Fortran::lower::getDummyProcedureType(sym, converter);
mlir::Value undefOp = builder.create<fir::UndefOp>(loc, dummyProcType);
- symMap.addSymbol(sym, undefOp);
+
+ genDeclareSymbol(converter, symMap, sym, undefOp);
}
if (Fortran::semantics::IsPointer(sym))
TODO(loc, "procedure pointers");
@@ -1363,7 +1439,8 @@ void Fortran::lower::mapSymbolAttributes(
}
fir::MutableBoxValue box = Fortran::lower::createMutableBox(
converter, loc, var, boxAlloc, nonDeferredLenParams);
- symMap.addAllocatableOrPointer(var.getSymbol(), box, replace);
+ genAllocatableOrPointerDeclare(converter, symMap, var.getSymbol(), box,
+ replace);
return;
}
@@ -1383,8 +1460,8 @@ void Fortran::lower::mapSymbolAttributes(
lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents, symMap,
stmtCtx);
- symMap.addBoxSymbol(sym, dummyArg, lbounds, explicitParams,
- explicitExtents, replace);
+ genBoxDeclare(converter, symMap, sym, dummyArg, lbounds, explicitParams,
+ explicitExtents, replace);
return;
}
}
@@ -1416,10 +1493,11 @@ 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.
- symMap.addSymbol(sym, fir::factory::genMutableBoxRead(
- builder, loc,
- fir::factory::createTempMutableBox(
- builder, loc, converter.genType(var))));
+ genDeclareSymbol(converter, symMap, sym,
+ fir::factory::genMutableBoxRead(
+ builder, loc,
+ fir::factory::createTempMutableBox(
+ builder, loc, converter.genType(var))));
return true;
}
return false;
@@ -1505,461 +1583,114 @@ void Fortran::lower::mapSymbolAttributes(
}
};
- // Lower length expression for non deferred and non dummy assumed length
- // characters.
- auto genExplicitCharLen =
- [&](llvm::Optional<Fortran::lower::SomeExpr> charLen) -> mlir::Value {
- if (!charLen)
- fir::emitFatalError(loc, "expected explicit character length");
- mlir::Value rawLen = genValue(*charLen);
- // If the length expression is negative, the length is zero. See
- // F2018 7.4.4.2 point 5.
- return fir::factory::genMaxWithZero(builder, loc, rawLen);
- };
-
- ba.match(
- //===--------------------------------------------------------------===//
- // Trivial case.
- //===--------------------------------------------------------------===//
- [&](const Fortran::lower::details::ScalarSym &) {
- if (isDummy) {
- // This is an argument.
- if (!symMap.lookupSymbol(sym))
- mlir::emitError(loc, "symbol \"")
- << toStringRef(sym.name()) << "\" must already be in map";
- return;
- } else if (isResult) {
- // Some Fortran results may be passed by argument (e.g. derived
- // types)
- if (symMap.lookupSymbol(sym))
- return;
- }
- // Otherwise, it's a local variable or function result.
- mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
- symMap.addSymbol(sym, local);
- },
-
- //===--------------------------------------------------------------===//
- // The non-trivial cases are when we have an argument or local that has
- // a repetition value. Arguments might be passed as simple pointers and
- // need to be cast to a multi-dimensional array with constant bounds
- // (possibly with a missing column), bounds computed in the callee
- // (here), or with bounds from the caller (boxed somewhere else). Locals
- // have the same properties except they are never boxed arguments from
- // the caller and never having a missing column size.
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::ScalarStaticChar &x) {
- // type is a CHARACTER, determine the LEN value
- auto charLen = x.charLen();
- if (replace) {
- Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
- if (symBox) {
- std::pair<mlir::Value, mlir::Value> unboxchar =
- charHelp.createUnboxChar(symBox.getAddr());
- mlir::Value boxAddr = unboxchar.first;
- // Set/override LEN with a constant
- mlir::Value len =
- builder.createIntegerConstant(loc, idxTy, charLen);
- symMap.addCharSymbol(sym, boxAddr, len, true);
- return;
- }
- }
- mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
- if (preAlloc) {
- symMap.addCharSymbol(sym, preAlloc, len);
- return;
- }
- mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
- symMap.addCharSymbol(sym, local, len);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::ScalarDynamicChar &x) {
- if (genUnusedEntryPointBox())
- return;
- // type is a CHARACTER, determine the LEN value
- auto charLen = x.charLen();
- if (replace) {
- Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
- mlir::Value boxAddr = symBox.getAddr();
- mlir::Value len;
- mlir::Type addrTy = boxAddr.getType();
- if (addrTy.isa<fir::BoxCharType>() || addrTy.isa<fir::BoxType>())
- std::tie(boxAddr, len) = charHelp.createUnboxChar(symBox.getAddr());
- // Override LEN with an expression
- if (charLen)
- len = genExplicitCharLen(charLen);
- symMap.addCharSymbol(sym, boxAddr, len, true);
- return;
- }
- // local CHARACTER variable
- mlir::Value len = genExplicitCharLen(charLen);
- if (preAlloc) {
- symMap.addCharSymbol(sym, preAlloc, len);
- return;
- }
- llvm::SmallVector<mlir::Value> lengths = {len};
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
- symMap.addCharSymbol(sym, local, len);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::StaticArray &x) {
- // object shape is constant, not a character
- mlir::Type castTy = builder.getRefType(converter.genType(var));
- mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
- if (addr)
- addr = builder.createConvert(loc, castTy, addr);
- if (x.lboundAllOnes()) {
- // if lower bounds are all ones, build simple shaped object
- llvm::SmallVector<mlir::Value> shape;
- for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
- shape.push_back(genExtentValue(builder, loc, idxTy, i));
- mlir::Value local =
- isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
- symMap.addSymbolWithShape(sym, local, shape, isDummy);
- return;
- }
- // If object is an array process the lower bound and extent values by
- // constructing constants and populating the lbounds and extents.
- llvm::SmallVector<mlir::Value> extents;
- llvm::SmallVector<mlir::Value> lbounds;
- for (auto [fst, snd] :
- llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
- lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
- extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
- }
- mlir::Value local =
- isDummy ? addr
- : createNewLocal(converter, loc, var, preAlloc, extents);
- // Must be a dummy argument, have an explicit shape, or be a PARAMETER.
- assert(isDummy || Fortran::lower::isExplicitShape(sym) ||
- Fortran::semantics::IsNamedConstant(sym));
- symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::DynamicArray &x) {
- if (genUnusedEntryPointBox())
- return;
- // cast to the known constant parts from the declaration
- mlir::Type varType = converter.genType(var);
- mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
- mlir::Value argBox;
- mlir::Type castTy = builder.getRefType(varType);
- if (addr) {
- if (auto boxTy = addr.getType().dyn_cast<fir::BaseBoxType>()) {
- argBox = addr;
- mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
- addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
- }
- addr = builder.createConvert(loc, castTy, addr);
- }
- if (x.lboundAllOnes()) {
- // if lower bounds are all ones, build simple shaped object
- llvm::SmallVector<mlir::Value> shapes;
- populateShape(shapes, x.bounds, argBox);
- if (isDummy) {
- symMap.addSymbolWithShape(sym, addr, shapes, true);
- return;
- }
- // local array with computed bounds
- assert(Fortran::lower::isExplicitShape(sym) ||
- Fortran::semantics::IsAllocatableOrPointer(sym));
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, shapes);
- symMap.addSymbolWithShape(sym, local, shapes);
- return;
- }
- // if object is an array process the lower bound and extent values
- llvm::SmallVector<mlir::Value> extents;
- llvm::SmallVector<mlir::Value> lbounds;
- populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
- if (isDummy) {
- symMap.addSymbolWithBounds(sym, addr, extents, lbounds, true);
- return;
- }
- // local array with computed bounds
- assert(Fortran::lower::isExplicitShape(sym));
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, extents);
- symMap.addSymbolWithBounds(sym, local, extents, lbounds);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::StaticArrayStaticChar &x) {
- // if element type is a CHARACTER, determine the LEN value
- auto charLen = x.charLen();
- mlir::Value addr;
- mlir::Value len;
- if (isDummy) {
- Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
- std::pair<mlir::Value, mlir::Value> unboxchar =
- charHelp.createUnboxChar(symBox.getAddr());
- addr = unboxchar.first;
- // Set/override LEN with a constant
- len = builder.createIntegerConstant(loc, idxTy, charLen);
- } else {
- // local CHARACTER variable
- len = builder.createIntegerConstant(loc, idxTy, charLen);
- }
-
- // object shape is constant
- mlir::Type castTy = builder.getRefType(converter.genType(var));
- if (addr)
- addr = builder.createConvert(loc, castTy, addr);
-
- if (x.lboundAllOnes()) {
- // if lower bounds are all ones, build simple shaped object
- llvm::SmallVector<mlir::Value> shape;
- for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
- shape.push_back(genExtentValue(builder, loc, idxTy, i));
- mlir::Value local =
- isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
- symMap.addCharSymbolWithShape(sym, local, len, shape, isDummy);
- return;
- }
+ //===--------------------------------------------------------------===//
+ // Non Pointer non allocatable scalar, explicit shape, and assumed
+ // size arrays.
+ // Lower the specification expressions.
+ //===--------------------------------------------------------------===//
+
+ mlir::Value len;
+ llvm::SmallVector<mlir::Value> extents;
+ llvm::SmallVector<mlir::Value> lbounds;
+ auto arg = symMap.lookupSymbol(sym).getAddr();
+ mlir::Value addr = preAlloc;
+
+ if (arg)
+ if (auto boxTy = arg.getType().dyn_cast<fir::BaseBoxType>()) {
+ // Contiguous assumed shape that can be tracked without a fir.box.
+ mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
+ addr = builder.create<fir::BoxAddrOp>(loc, refTy, arg);
+ }
- // if object is an array process the lower bound and extent values
- llvm::SmallVector<mlir::Value> extents;
- llvm::SmallVector<mlir::Value> lbounds;
- // construct constants and populate `bounds`
- for (auto [fst, snd] :
- llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
- lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
- extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
- }
+ // Compute/Extract character length.
+ if (ba.isChar()) {
+ if (arg) {
+ assert(!preAlloc && "dummy cannot be pre-allocated");
+ if (arg.getType().isa<fir::BoxCharType>())
+ std::tie(addr, len) = charHelp.createUnboxChar(arg);
+ }
+ if (llvm::Optional<int64_t> cstLen = ba.getCharLenConst()) {
+ // Static length
+ len = builder.createIntegerConstant(loc, idxTy, *cstLen);
+ } else {
+ // Dynamic length
+ if (genUnusedEntryPointBox())
+ return;
+ if (llvm::Optional<Fortran::lower::SomeExpr> charLenExpr =
+ ba.getCharLenExpr()) {
+ // Explicit length
+ mlir::Value rawLen = genValue(*charLenExpr);
+ // If the length expression is negative, the length is zero. See
+ // F2018 7.4.4.2 point 5.
+ len = fir::factory::genMaxWithZero(builder, loc, rawLen);
+ } else if (!len) {
+ // Assumed length fir.box (possible for contiguous assumed shapes).
+ // Read length from box.
+ assert(arg && arg.getType().isa<fir::BoxType>() &&
+ "must be character dummy fir.box");
+ len = charHelp.readLengthFromBox(arg);
+ }
+ }
+ }
- if (isDummy) {
- symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
- true);
- return;
- }
- // local CHARACTER array with computed bounds
- assert(Fortran::lower::isExplicitShape(sym));
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, extents);
- symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::StaticArrayDynamicChar &x) {
- if (genUnusedEntryPointBox())
- return;
- mlir::Value addr;
- mlir::Value len;
- [[maybe_unused]] bool mustBeDummy = false;
- auto charLen = x.charLen();
- // if element type is a CHARACTER, determine the LEN value
- if (isDummy) {
- Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
- std::pair<mlir::Value, mlir::Value> unboxchar =
- charHelp.createUnboxChar(symBox.getAddr());
- addr = unboxchar.first;
- if (charLen) {
- // Set/override LEN with an expression
- len = genExplicitCharLen(charLen);
- } else {
- // LEN is from the boxchar
- len = unboxchar.second;
- mustBeDummy = true;
- }
- } else {
- // local CHARACTER variable
- len = genExplicitCharLen(charLen);
- }
- llvm::SmallVector<mlir::Value> lengths = {len};
-
- // cast to the known constant parts from the declaration
- mlir::Type castTy = builder.getRefType(converter.genType(var));
- if (addr)
- addr = builder.createConvert(loc, castTy, addr);
-
- if (x.lboundAllOnes()) {
- // if lower bounds are all ones, build simple shaped object
- llvm::SmallVector<mlir::Value> shape;
- for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
- shape.push_back(genExtentValue(builder, loc, idxTy, i));
- if (isDummy) {
- symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
- return;
- }
- // local CHARACTER array with constant size
- mlir::Value local = createNewLocal(converter, loc, var, preAlloc,
- llvm::None, lengths);
- symMap.addCharSymbolWithShape(sym, local, len, shape);
- return;
+ // Compute array extents and lower bounds.
+ if (ba.isArray()) {
+ if (addr && addr.getDefiningOp<fir::UnboxCharOp>()) {
+ // Ensure proper type is given to array that transited via fir.boxchar
+ // arg.
+ mlir::Type castTy = builder.getRefType(converter.genType(var));
+ addr = builder.createConvert(loc, castTy, addr);
+ }
+ if (ba.isStaticArray()) {
+ if (ba.lboundIsAllOnes()) {
+ for (std::int64_t extent :
+ recoverShapeVector(ba.staticShape(), preAlloc))
+ extents.push_back(genExtentValue(builder, loc, idxTy, extent));
+ } else {
+ for (auto [lb, extent] :
+ llvm::zip(ba.staticLBound(),
+ recoverShapeVector(ba.staticShape(), preAlloc))) {
+ lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
+ extents.emplace_back(genExtentValue(builder, loc, idxTy, extent));
}
+ }
+ } else {
+ // Non compile time constant shape.
+ if (genUnusedEntryPointBox())
+ return;
+ if (ba.lboundIsAllOnes())
+ populateShape(extents, ba.dynamicBound(), arg);
+ else
+ populateLBoundsExtents(lbounds, extents, ba.dynamicBound(), arg);
+ }
+ }
- // if object is an array process the lower bound and extent values
- llvm::SmallVector<mlir::Value> extents;
- llvm::SmallVector<mlir::Value> lbounds;
-
- // construct constants and populate `bounds`
- for (auto [fst, snd] :
- llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
- lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
- extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
- }
- if (isDummy) {
- symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
- true);
- return;
- }
- // local CHARACTER array with computed bounds
- assert((!mustBeDummy) && (Fortran::lower::isExplicitShape(sym)));
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
- symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
- if (genUnusedEntryPointBox())
- return;
- mlir::Value addr;
- mlir::Value len;
- mlir::Value argBox;
- auto charLen = x.charLen();
- // if element type is a CHARACTER, determine the LEN value
- if (isDummy) {
- mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
- if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
- argBox = actualArg;
- mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
- addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
- } else {
- addr = charHelp.createUnboxChar(actualArg).first;
- }
- // Set/override LEN with a constant
- len = builder.createIntegerConstant(loc, idxTy, charLen);
- } else {
- // local CHARACTER variable
- len = builder.createIntegerConstant(loc, idxTy, charLen);
- }
+ // 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;
+ } 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");
+ addr = arg;
+ }
+ } else {
+ // Local variables
+ llvm::SmallVector<mlir::Value> typeParams;
+ if (len)
+ typeParams.emplace_back(len);
+ addr = createNewLocal(converter, loc, var, preAlloc, extents, typeParams);
+ }
+ }
- // cast to the known constant parts from the declaration
- mlir::Type castTy = builder.getRefType(converter.genType(var));
- if (addr)
- addr = builder.createConvert(loc, castTy, addr);
- if (x.lboundAllOnes()) {
- // if lower bounds are all ones, build simple shaped object
- llvm::SmallVector<mlir::Value> shape;
- populateShape(shape, x.bounds, argBox);
- if (isDummy) {
- symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
- return;
- }
- // local CHARACTER array
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, shape);
- symMap.addCharSymbolWithShape(sym, local, len, shape);
- return;
- }
- // if object is an array process the lower bound and extent values
- llvm::SmallVector<mlir::Value> extents;
- llvm::SmallVector<mlir::Value> lbounds;
- populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
- if (isDummy) {
- symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
- true);
- return;
- }
- // local CHARACTER array with computed bounds
- assert(Fortran::lower::isExplicitShape(sym));
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, extents);
- symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
- if (genUnusedEntryPointBox())
- return;
- mlir::Value addr;
- mlir::Value len;
- mlir::Value argBox;
- auto charLen = x.charLen();
- // if element type is a CHARACTER, determine the LEN value
- if (isDummy) {
- mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
- if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
- argBox = actualArg;
- mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
- addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
- if (charLen)
- // Set/override LEN with an expression.
- len = genExplicitCharLen(charLen);
- else
- // Get the length from the actual arguments.
- len = charHelp.readLengthFromBox(argBox);
- } else {
- std::pair<mlir::Value, mlir::Value> unboxchar =
- charHelp.createUnboxChar(actualArg);
- addr = unboxchar.first;
- if (charLen) {
- // Set/override LEN with an expression
- len = genExplicitCharLen(charLen);
- } else {
- // Get the length from the actual arguments.
- len = unboxchar.second;
- }
- }
- } else {
- // local CHARACTER variable
- len = genExplicitCharLen(charLen);
- }
- llvm::SmallVector<mlir::Value> lengths = {len};
-
- // cast to the known constant parts from the declaration
- mlir::Type castTy = builder.getRefType(converter.genType(var));
- if (addr)
- addr = builder.createConvert(loc, castTy, addr);
- if (x.lboundAllOnes()) {
- // if lower bounds are all ones, build simple shaped object
- llvm::SmallVector<mlir::Value> shape;
- populateShape(shape, x.bounds, argBox);
- if (isDummy) {
- symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
- return;
- }
- // local CHARACTER array
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, shape, lengths);
- symMap.addCharSymbolWithShape(sym, local, len, shape);
- return;
- }
- // Process the lower bound and extent values.
- llvm::SmallVector<mlir::Value> extents;
- llvm::SmallVector<mlir::Value> lbounds;
- populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
- if (isDummy) {
- symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
- true);
- return;
- }
- // local CHARACTER array with computed bounds
- assert(Fortran::lower::isExplicitShape(sym));
- mlir::Value local =
- createNewLocal(converter, loc, var, preAlloc, extents, lengths);
- symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
- },
-
- //===--------------------------------------------------------------===//
-
- [&](const Fortran::lower::BoxAnalyzer::None &) {
- mlir::emitError(loc, "symbol analysis failed on ")
- << toStringRef(sym.name());
- });
+ genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds,
+ replace);
+ return;
}
void Fortran::lower::defineModuleVariable(
@@ -1997,6 +1728,14 @@ void Fortran::lower::instantiateVariable(AbstractConverter &converter,
const pft::Variable &var,
Fortran::lower::SymMap &symMap,
AggregateStoreMap &storeMap) {
+ if (var.hasSymbol()) {
+ // Do not try to instantiate symbols twice, except for dummies and results,
+ // that may have been mapped to the MLIR entry block arguments, and for
+ // which the explicit specifications, if any, has not yet been lowered.
+ const auto &sym = var.getSymbol();
+ if (!IsDummy(sym) && !IsFunctionResult(sym) && symMap.lookupSymbol(sym))
+ return;
+ }
if (var.isAggregateStore()) {
instantiateAggregateStore(converter, var, storeMap);
} else if (const Fortran::semantics::Symbol *common =
diff --git a/flang/test/Lower/HLFIR/expr-addr.f90 b/flang/test/Lower/HLFIR/expr-addr.f90
index 1af59e6cb0548..0ae9df50d9d8f 100644
--- a/flang/test/Lower/HLFIR/expr-addr.f90
+++ b/flang/test/Lower/HLFIR/expr-addr.f90
@@ -3,6 +3,6 @@
subroutine foo(x)
integer :: x
- ! CHECK: not yet implemented: lower expr to HLFIR address
+ ! CHECK: not yet implemented: generate fir.declare when lowering symbol
read (*,*) x
end subroutine
diff --git a/flang/test/Lower/HLFIR/expr-box.f90 b/flang/test/Lower/HLFIR/expr-box.f90
index d011d79e4def2..c15519974ea20 100644
--- a/flang/test/Lower/HLFIR/expr-box.f90
+++ b/flang/test/Lower/HLFIR/expr-box.f90
@@ -3,6 +3,6 @@
subroutine foo(x)
integer :: x(:)
- ! CHECK: not yet implemented: lower expr to HLFIR box
+ ! CHECK: not yet implemented: generate fir.declare for box
print *, x
end subroutine
More information about the flang-commits
mailing list