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
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");
}
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;
}
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;
}
}
"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;
}
};
- // 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(
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 =