diff options
author | Valentin Clement <clementval@gmail.com> | 2022-03-09 21:50:17 +0300 |
---|---|---|
committer | Valentin Clement <clementval@gmail.com> | 2022-03-09 21:50:57 +0300 |
commit | c3a7627cacc6cbe2301a253daeb3e6953e5e0d1d (patch) | |
tree | 9b1ab56859c6722664c6ff66b8d4673867db56bd /flang | |
parent | f52b5a852a4b4d48b9c049e68569cfdb184f11ab (diff) |
[flang] Lower more array character cases
This patch adds more lowering and tests for character array assignment/copy.
This patch is part of the upstreaming effort from fir-dev branch.
Depends on D121300
Reviewed By: PeteSteinfeld, schweitz
Differential Revision: https://reviews.llvm.org/D121301
Co-authored-by: Jean Perier <jperier@nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
Diffstat (limited to 'flang')
-rw-r--r-- | flang/include/flang/Lower/ConvertExpr.h | 10 | ||||
-rw-r--r-- | flang/include/flang/Lower/Mangler.h | 33 | ||||
-rw-r--r-- | flang/lib/Lower/ConvertExpr.cpp | 486 | ||||
-rw-r--r-- | flang/lib/Lower/Mangler.cpp | 48 | ||||
-rw-r--r-- | flang/test/Lower/array-character.f90 | 173 |
5 files changed, 702 insertions, 48 deletions
diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h index 7787a97a7b72..c1791723fed4 100644 --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -108,6 +108,16 @@ fir::MutableBoxValue createMutableBox(mlir::Location loc, AbstractConverter &converter, const SomeExpr &expr, SymMap &symMap); +/// Create a fir::BoxValue describing the value of \p expr. +/// If \p expr is a variable without vector subscripts, the fir::BoxValue +/// described the variable storage. Otherwise, the created fir::BoxValue +/// describes a temporary storage containing \p expr evaluation, and clean-up +/// for the temporary is added to the provided StatementContext \p stmtCtx. +fir::ExtendedValue createBoxValue(mlir::Location loc, + AbstractConverter &converter, + const SomeExpr &expr, SymMap &symMap, + StatementContext &stmtCtx); + /// Lower an array assignment expression. /// /// 1. Evaluate the lhs to determine the rank and how to form the ArrayLoad diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h index d82fdb0ed99a..1c59eda99176 100644 --- a/flang/include/flang/Lower/Mangler.h +++ b/flang/include/flang/Lower/Mangler.h @@ -13,6 +13,7 @@ #ifndef FORTRAN_LOWER_MANGLER_H #define FORTRAN_LOWER_MANGLER_H +#include "flang/Evaluate/expression.h" #include "mlir/IR/BuiltinTypes.h" #include "llvm/ADT/StringRef.h" #include <string> @@ -58,6 +59,38 @@ std::string mangleName(const semantics::DerivedTypeSpec &); /// Recover the bare name of the original symbol from an internal name. std::string demangleName(llvm::StringRef name); +std::string +mangleArrayLiteral(const uint8_t *addr, size_t size, + const Fortran::evaluate::ConstantSubscripts &shape, + Fortran::common::TypeCategory cat, int kind = 0, + Fortran::common::ConstantSubscript charLen = -1); + +template <Fortran::common::TypeCategory TC, int KIND> +std::string mangleArrayLiteral( + const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>> &x) { + return mangleArrayLiteral( + reinterpret_cast<const uint8_t *>(x.values().data()), + x.values().size() * sizeof(x.values()[0]), x.shape(), TC, KIND); +} + +template <int KIND> +std::string +mangleArrayLiteral(const Fortran::evaluate::Constant<Fortran::evaluate::Type< + Fortran::common::TypeCategory::Character, KIND>> &x) { + return mangleArrayLiteral( + reinterpret_cast<const uint8_t *>(x.values().data()), + x.values().size() * sizeof(x.values()[0]), x.shape(), + Fortran::common::TypeCategory::Character, KIND, x.LEN()); +} + +inline std::string mangleArrayLiteral( + const Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived> &x) { + return mangleArrayLiteral( + reinterpret_cast<const uint8_t *>(x.values().data()), + x.values().size() * sizeof(x.values()[0]), x.shape(), + Fortran::common::TypeCategory::Derived); +} + } // namespace lower::mangle } // namespace Fortran diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index ffd3b97cecef..bd74b47192f1 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -21,6 +21,7 @@ #include "flang/Lower/CustomIntrinsicCall.h" #include "flang/Lower/DumpEvaluateExpr.h" #include "flang/Lower/IntrinsicCall.h" +#include "flang/Lower/Mangler.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" @@ -848,14 +849,209 @@ public: } } + /// Generate a raw literal value and store it in the rawVals vector. + template <Fortran::common::TypeCategory TC, int KIND> + void + genRawLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> + &value) { + mlir::Attribute val; + assert(inInitializer != nullptr); + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + inInitializer->rawType = converter.genType(TC, KIND); + val = builder.getIntegerAttr(inInitializer->rawType, value.ToInt64()); + } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { + inInitializer->rawType = + converter.genType(Fortran::common::TypeCategory::Integer, KIND); + val = builder.getIntegerAttr(inInitializer->rawType, value.IsTrue()); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + std::string str = value.DumpHexadecimal(); + inInitializer->rawType = converter.genType(TC, KIND); + llvm::APFloat floatVal{builder.getKindMap().getFloatSemantics(KIND), str}; + val = builder.getFloatAttr(inInitializer->rawType, floatVal); + } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { + std::string strReal = value.REAL().DumpHexadecimal(); + std::string strImg = value.AIMAG().DumpHexadecimal(); + inInitializer->rawType = converter.genType(TC, KIND); + llvm::APFloat realVal{builder.getKindMap().getFloatSemantics(KIND), + strReal}; + val = builder.getFloatAttr(inInitializer->rawType, realVal); + inInitializer->rawVals.push_back(val); + llvm::APFloat imgVal{builder.getKindMap().getFloatSemantics(KIND), + strImg}; + val = builder.getFloatAttr(inInitializer->rawType, imgVal); + } + inInitializer->rawVals.push_back(val); + } + /// Convert a ascii scalar literal CHARACTER to IR. (specialization) ExtValue genAsciiScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type< Fortran::common::TypeCategory::Character, 1>> &value, int64_t len) { - assert(value.size() == static_cast<std::uint64_t>(len) && - "value.size() doesn't match with len"); - return fir::factory::createStringLiteral(builder, getLoc(), value); + assert(value.size() == static_cast<std::uint64_t>(len)); + // Outline character constant in ro data if it is not in an initializer. + if (!inInitializer) + return fir::factory::createStringLiteral(builder, getLoc(), value); + // When in an initializer context, construct the literal op itself and do + // not construct another constant object in rodata. + fir::StringLitOp stringLit = builder.createStringLitOp(getLoc(), value); + mlir::Value lenp = builder.createIntegerConstant( + getLoc(), builder.getCharacterLengthType(), len); + return fir::CharBoxValue{stringLit.getResult(), lenp}; + } + /// Convert a non ascii scalar literal CHARACTER to IR. (specialization) + template <int KIND> + ExtValue + genScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type< + Fortran::common::TypeCategory::Character, KIND>> &value, + int64_t len) { + using ET = typename std::decay_t<decltype(value)>::value_type; + if constexpr (KIND == 1) { + return genAsciiScalarLit(value, len); + } + fir::CharacterType type = + fir::CharacterType::get(builder.getContext(), KIND, len); + auto consLit = [&]() -> fir::StringLitOp { + mlir::MLIRContext *context = builder.getContext(); + std::int64_t size = static_cast<std::int64_t>(value.size()); + mlir::ShapedType shape = mlir::VectorType::get( + llvm::ArrayRef<std::int64_t>{size}, + mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8)); + auto strAttr = mlir::DenseElementsAttr::get( + shape, llvm::ArrayRef<ET>{value.data(), value.size()}); + auto valTag = mlir::StringAttr::get(context, fir::StringLitOp::value()); + mlir::NamedAttribute dataAttr(valTag, strAttr); + auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size()); + mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len)); + llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr}; + return builder.create<fir::StringLitOp>( + getLoc(), llvm::ArrayRef<mlir::Type>{type}, llvm::None, attrs); + }; + + mlir::Value lenp = builder.createIntegerConstant( + getLoc(), builder.getCharacterLengthType(), len); + // When in an initializer context, construct the literal op itself and do + // not construct another constant object in rodata. + if (inInitializer) + return fir::CharBoxValue{consLit().getResult(), lenp}; + + // Otherwise, the string is in a plain old expression so "outline" the value + // by hashconsing it to a constant literal object. + + // FIXME: For wider char types, lowering ought to use an array of i16 or + // i32. But for now, lowering just fakes that the string value is a range of + // i8 to get it past the C++ compiler. + std::string globalName = + fir::factory::uniqueCGIdent("cl", (const char *)value.c_str()); + fir::GlobalOp global = builder.getNamedGlobal(globalName); + if (!global) + global = builder.createGlobalConstant( + getLoc(), type, globalName, + [&](fir::FirOpBuilder &builder) { + fir::StringLitOp str = consLit(); + builder.create<fir::HasValueOp>(getLoc(), str); + }, + builder.createLinkOnceLinkage()); + auto addr = builder.create<fir::AddrOfOp>(getLoc(), global.resultType(), + global.getSymbol()); + return fir::CharBoxValue{addr, lenp}; + } + + template <Fortran::common::TypeCategory TC, int KIND> + ExtValue genArrayLit( + const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>> + &con) { + mlir::Location loc = getLoc(); + mlir::IndexType idxTy = builder.getIndexType(); + Fortran::evaluate::ConstantSubscript size = + Fortran::evaluate::GetSize(con.shape()); + fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); + mlir::Type eleTy; + if constexpr (TC == Fortran::common::TypeCategory::Character) + eleTy = converter.genType(TC, KIND, {con.LEN()}); + else + eleTy = converter.genType(TC, KIND); + auto arrayTy = fir::SequenceType::get(shape, eleTy); + mlir::Value array; + llvm::SmallVector<mlir::Value> lbounds; + llvm::SmallVector<mlir::Value> extents; + if (!inInitializer || !inInitializer->genRawVals) { + array = builder.create<fir::UndefOp>(loc, arrayTy); + for (auto [lb, extent] : llvm::zip(con.lbounds(), shape)) { + lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb - 1)); + extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); + } + } + if (size == 0) { + if constexpr (TC == Fortran::common::TypeCategory::Character) { + mlir::Value len = builder.createIntegerConstant(loc, idxTy, con.LEN()); + return fir::CharArrayBoxValue{array, len, extents, lbounds}; + } else { + return fir::ArrayBoxValue{array, extents, lbounds}; + } + } + Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); + auto createIdx = [&]() { + llvm::SmallVector<mlir::Attribute> idx; + for (size_t i = 0; i < subscripts.size(); ++i) + idx.push_back( + builder.getIntegerAttr(idxTy, subscripts[i] - con.lbounds()[i])); + return idx; + }; + if constexpr (TC == Fortran::common::TypeCategory::Character) { + assert(array && "array must not be nullptr"); + do { + mlir::Value elementVal = + fir::getBase(genScalarLit<KIND>(con.At(subscripts), con.LEN())); + array = builder.create<fir::InsertValueOp>( + loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); + } while (con.IncrementSubscripts(subscripts)); + mlir::Value len = builder.createIntegerConstant(loc, idxTy, con.LEN()); + return fir::CharArrayBoxValue{array, len, extents, lbounds}; + } else { + llvm::SmallVector<mlir::Attribute> rangeStartIdx; + uint64_t rangeSize = 0; + do { + if (inInitializer && inInitializer->genRawVals) { + genRawLit<TC, KIND>(con.At(subscripts)); + continue; + } + auto getElementVal = [&]() { + return builder.createConvert( + loc, eleTy, + fir::getBase(genScalarLit<TC, KIND>(con.At(subscripts)))); + }; + Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts; + bool nextIsSame = con.IncrementSubscripts(nextSubscripts) && + con.At(subscripts) == con.At(nextSubscripts); + if (!rangeSize && !nextIsSame) { // single (non-range) value + array = builder.create<fir::InsertValueOp>( + loc, arrayTy, array, getElementVal(), + builder.getArrayAttr(createIdx())); + } else if (!rangeSize) { // start a range + rangeStartIdx = createIdx(); + rangeSize = 1; + } else if (nextIsSame) { // expand a range + ++rangeSize; + } else { // end a range + llvm::SmallVector<int64_t> rangeBounds; + llvm::SmallVector<mlir::Attribute> idx = createIdx(); + for (size_t i = 0; i < idx.size(); ++i) { + rangeBounds.push_back(rangeStartIdx[i] + .cast<mlir::IntegerAttr>() + .getValue() + .getSExtValue()); + rangeBounds.push_back( + idx[i].cast<mlir::IntegerAttr>().getValue().getSExtValue()); + } + array = builder.create<fir::InsertOnRangeOp>( + loc, arrayTy, array, getElementVal(), + builder.getIndexVectorAttr(rangeBounds)); + rangeSize = 0; + } + } while (con.IncrementSubscripts(subscripts)); + return fir::ArrayBoxValue{array, extents, lbounds}; + } } template <Fortran::common::TypeCategory TC, int KIND> @@ -863,14 +1059,12 @@ public: genval(const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>> &con) { if (con.Rank() > 0) - TODO(getLoc(), "genval array constant"); + return genArrayLit(con); std::optional<Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>>> opt = con.GetScalarValue(); assert(opt.has_value() && "constant has no value"); if constexpr (TC == Fortran::common::TypeCategory::Character) { - if constexpr (KIND == 1) - return genAsciiScalarLit(opt.value(), con.LEN()); - TODO(getLoc(), "genval for Character with KIND != 1"); + return genScalarLit<KIND>(opt.value(), con.LEN()); } else { return genScalarLit<TC, KIND>(opt.value()); } @@ -1965,6 +2159,37 @@ public: } template <typename A> + ExtValue asArray(const A &x) { + return Fortran::lower::createSomeArrayTempValue(converter, toEvExpr(x), + symMap, stmtCtx); + } + + /// Lower an array value as an argument. This argument can be passed as a box + /// value, so it may be possible to avoid making a temporary. + template <typename A> + ExtValue asArrayArg(const Fortran::evaluate::Expr<A> &x) { + return std::visit([&](const auto &e) { return asArrayArg(e, x); }, x.u); + } + template <typename A, typename B> + ExtValue asArrayArg(const Fortran::evaluate::Expr<A> &x, const B &y) { + return std::visit([&](const auto &e) { return asArrayArg(e, y); }, x.u); + } + template <typename A, typename B> + ExtValue asArrayArg(const Fortran::evaluate::Designator<A> &, const B &x) { + // Designator is being passed as an argument to a procedure. Lower the + // expression to a boxed value. + auto someExpr = toEvExpr(x); + return Fortran::lower::createBoxValue(getLoc(), converter, someExpr, symMap, + stmtCtx); + } + template <typename A, typename B> + ExtValue asArrayArg(const A &, const B &x) { + // If the expression to pass as an argument is not a designator, then create + // an array temp. + return asArray(x); + } + + template <typename A> ExtValue gen(const Fortran::evaluate::Expr<A> &x) { // Whole array symbols or components, and results of transformational // functions already have a storage and the scalar expression lowering path @@ -1973,7 +2198,9 @@ public: Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(x) || isTransformationalRef(x)) return std::visit([&](const auto &e) { return genref(e); }, x.u); - TODO(getLoc(), "gen Expr non-scalar"); + if (useBoxArg) + return asArrayArg(x); + return asArray(x); } template <typename A> @@ -1981,12 +2208,6 @@ public: return x.Rank() == 0; } - template <typename A> - ExtValue asArray(const A &x) { - return Fortran::lower::createSomeArrayTempValue(converter, toEvExpr(x), - symMap, stmtCtx); - } - template <int KIND> ExtValue genval(const Fortran::evaluate::Expr<Fortran::evaluate::Type< Fortran::common::TypeCategory::Logical, KIND>> &exp) { @@ -2867,37 +3088,91 @@ public: template <Fortran::common::TypeCategory TC, int KIND> CC genarr( const Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>> &x) { - TODO(getLoc(), "genarr "); + TODO(getLoc(), "genarr Power<Fortran::evaluate::Type<TC, KIND>>"); } template <Fortran::common::TypeCategory TC, int KIND> CC genarr( const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>> &x) { - TODO(getLoc(), "genarr "); + TODO(getLoc(), "genarr Extremum<Fortran::evaluate::Type<TC, KIND>>"); } template <Fortran::common::TypeCategory TC, int KIND> CC genarr( const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>> &x) { - TODO(getLoc(), "genarr "); + TODO(getLoc(), "genarr RealToIntPower<Fortran::evaluate::Type<TC, KIND>>"); } template <int KIND> CC genarr(const Fortran::evaluate::ComplexConstructor<KIND> &x) { - TODO(getLoc(), "genarr "); + TODO(getLoc(), "genarr ComplexConstructor<KIND>"); } template <int KIND> CC genarr(const Fortran::evaluate::Concat<KIND> &x) { - TODO(getLoc(), "genarr "); + TODO(getLoc(), "genarr Concat<KIND>"); } template <int KIND> CC genarr(const Fortran::evaluate::SetLength<KIND> &x) { - TODO(getLoc(), "genarr "); + TODO(getLoc(), "genarr SetLength<KIND>"); } template <typename A> CC genarr(const Fortran::evaluate::Constant<A> &x) { - TODO(getLoc(), "genarr "); + if (/*explicitSpaceIsActive() &&*/ x.Rank() == 0) + return genScalarAndForwardValue(x); + mlir::Location loc = getLoc(); + mlir::IndexType idxTy = builder.getIndexType(); + mlir::Type arrTy = converter.genType(toEvExpr(x)); + std::string globalName = Fortran::lower::mangle::mangleArrayLiteral(x); + fir::GlobalOp global = builder.getNamedGlobal(globalName); + if (!global) { + mlir::Type symTy = arrTy; + mlir::Type eleTy = symTy.cast<fir::SequenceType>().getEleTy(); + // If we have a rank-1 array of integer, real, or logical, then we can + // create a global array with the dense attribute. + // + // The mlir tensor type can only handle integer, real, or logical. It + // does not currently support nested structures which is required for + // complex. + // + // Also, we currently handle just rank-1 since tensor type assumes + // row major array ordering. We will need to reorder the dimensions + // in the tensor type to support Fortran's column major array ordering. + // How to create this tensor type is to be determined. + if (x.Rank() == 1 && + eleTy.isa<fir::LogicalType, mlir::IntegerType, mlir::FloatType>()) + global = Fortran::lower::createDenseGlobal( + loc, arrTy, globalName, builder.createInternalLinkage(), true, + toEvExpr(x), converter); + // Note: If call to createDenseGlobal() returns 0, then call + // createGlobalConstant() below. + if (!global) + global = builder.createGlobalConstant( + loc, arrTy, globalName, + [&](fir::FirOpBuilder &builder) { + Fortran::lower::StatementContext stmtCtx( + /*cleanupProhibited=*/true); + fir::ExtendedValue result = + Fortran::lower::createSomeInitializerExpression( + loc, converter, toEvExpr(x), symMap, stmtCtx); + mlir::Value castTo = + builder.createConvert(loc, arrTy, fir::getBase(result)); + builder.create<fir::HasValueOp>(loc, castTo); + }, + builder.createInternalLinkage()); + } + auto addr = builder.create<fir::AddrOfOp>(getLoc(), global.resultType(), + global.getSymbol()); + auto seqTy = global.getType().cast<fir::SequenceType>(); + llvm::SmallVector<mlir::Value> extents; + for (auto extent : seqTy.getShape()) + extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); + if (auto charTy = seqTy.getEleTy().dyn_cast<fir::CharacterType>()) { + mlir::Value len = builder.createIntegerConstant(loc, builder.getI64Type(), + charTy.getLen()); + return genarr(fir::CharArrayBoxValue{addr, len, extents}); + } + return genarr(fir::ArrayBoxValue{addr, extents}); } CC genarr(const Fortran::semantics::SymbolRef &sym, @@ -3612,6 +3887,25 @@ public: }; } + /// Reduce the rank of a array to be boxed based on the slice's operands. + static mlir::Type reduceRank(mlir::Type arrTy, mlir::Value slice) { + if (slice) { + auto slOp = mlir::dyn_cast<fir::SliceOp>(slice.getDefiningOp()); + assert(slOp && "expected slice op"); + auto seqTy = arrTy.dyn_cast<fir::SequenceType>(); + assert(seqTy && "expected array type"); + mlir::Operation::operand_range triples = slOp.getTriples(); + fir::SequenceType::Shape shape; + // reduce the rank for each invariant dimension + for (unsigned i = 1, end = triples.size(); i < end; i += 3) + if (!mlir::isa_and_nonnull<fir::UndefOp>(triples[i].getDefiningOp())) + shape.push_back(fir::SequenceType::getUnknownExtent()); + return fir::SequenceType::get(shape, seqTy.getEleTy()); + } + // not sliced, so no change in rank + return arrTy; + } + CC genarr(const Fortran::evaluate::ComplexPart &x, ComponentPath &components) { TODO(getLoc(), "genarr ComplexPart"); @@ -3636,7 +3930,67 @@ public: mlir::Value shape = builder.createShape(loc, extMemref); mlir::Value slice; if (components.isSlice()) { - TODO(loc, "genarr with Slices"); + if (isBoxValue() && components.substring) { + // Append the substring operator to emboxing Op as it will become an + // interior adjustment (add offset, adjust LEN) to the CHARACTER value + // being referenced in the descriptor. + llvm::SmallVector<mlir::Value> substringBounds; + populateBounds(substringBounds, components.substring); + // Convert to (offset, size) + mlir::Type iTy = substringBounds[0].getType(); + if (substringBounds.size() != 2) { + fir::CharacterType charTy = + fir::factory::CharacterExprHelper::getCharType(arrTy); + if (charTy.hasConstantLen()) { + mlir::IndexType idxTy = builder.getIndexType(); + fir::CharacterType::LenType charLen = charTy.getLen(); + mlir::Value lenValue = + builder.createIntegerConstant(loc, idxTy, charLen); + substringBounds.push_back(lenValue); + } else { + llvm::SmallVector<mlir::Value> typeparams = + fir::getTypeParams(extMemref); + substringBounds.push_back(typeparams.back()); + } + } + // Convert the lower bound to 0-based substring. + mlir::Value one = + builder.createIntegerConstant(loc, substringBounds[0].getType(), 1); + substringBounds[0] = + builder.create<mlir::arith::SubIOp>(loc, substringBounds[0], one); + // Convert the upper bound to a length. + mlir::Value cast = builder.createConvert(loc, iTy, substringBounds[1]); + mlir::Value zero = builder.createIntegerConstant(loc, iTy, 0); + auto size = + builder.create<mlir::arith::SubIOp>(loc, cast, substringBounds[0]); + auto cmp = builder.create<mlir::arith::CmpIOp>( + loc, mlir::arith::CmpIPredicate::sgt, size, zero); + // size = MAX(upper - (lower - 1), 0) + substringBounds[1] = + builder.create<mlir::arith::SelectOp>(loc, cmp, size, zero); + slice = builder.create<fir::SliceOp>(loc, components.trips, + components.suffixComponents, + substringBounds); + } else { + slice = builder.createSlice(loc, extMemref, components.trips, + components.suffixComponents); + } + if (components.hasComponents()) { + auto seqTy = arrTy.cast<fir::SequenceType>(); + mlir::Type eleTy = + fir::applyPathToType(seqTy.getEleTy(), components.suffixComponents); + if (!eleTy) + fir::emitFatalError(loc, "slicing path is ill-formed"); + if (auto realTy = eleTy.dyn_cast<fir::RealType>()) + eleTy = Fortran::lower::convertReal(realTy.getContext(), + realTy.getFKind()); + + // create the type of the projected array. + arrTy = fir::SequenceType::get(seqTy.getShape(), eleTy); + LLVM_DEBUG(llvm::dbgs() + << "type of array projection from component slicing: " + << eleTy << ", " << arrTy << '\n'); + } } arrayOperands.push_back(ArrayOperand{memref, shape, slice}); if (destShape.empty()) @@ -3668,8 +4022,37 @@ public: .getResult(); return [=](IterSpace) -> ExtValue { return fir::BoxValue(embox); }; } + auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy(); if (isReferentiallyOpaque()) { - TODO(loc, "genarr isReferentiallyOpaque"); + // Semantics are an opaque reference to an array. + // This case forwards a continuation that will generate the address + // arithmetic to the array element. This does not have copy-in/copy-out + // semantics. No attempt to copy the array value will be made during the + // interpretation of the Fortran statement. + mlir::Type refEleTy = builder.getRefType(eleTy); + return [=](IterSpace iters) -> ExtValue { + // ArrayCoorOp does not expect zero based indices. + llvm::SmallVector<mlir::Value> indices = fir::factory::originateIndices( + loc, builder, memref.getType(), shape, iters.iterVec()); + mlir::Value coor = builder.create<fir::ArrayCoorOp>( + loc, refEleTy, memref, shape, slice, indices, + fir::getTypeParams(extMemref)); + if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) { + llvm::SmallVector<mlir::Value> substringBounds; + populateBounds(substringBounds, components.substring); + if (!substringBounds.empty()) { + mlir::Value dstLen = fir::factory::genLenOfCharacter( + builder, loc, arrTy.cast<fir::SequenceType>(), memref, + fir::getTypeParams(extMemref), iters.iterVec(), + substringBounds); + fir::CharBoxValue dstChar(coor, dstLen); + return fir::factory::CharacterExprHelper{builder, loc} + .createSubstring(dstChar, substringBounds); + } + } + return fir::factory::arraySectionElementToExtendedValue( + builder, loc, extMemref, coor, slice); + }; } auto arrLoad = builder.create<fir::ArrayLoadOp>( loc, arrTy, memref, shape, slice, fir::getTypeParams(extMemref)); @@ -3688,7 +4071,21 @@ public: return [=](IterSpace iters) -> ExtValue { return lambda(iters); }; } if (isCustomCopyInCopyOut()) { - TODO(loc, "isCustomCopyInCopyOut"); + // Create an array_modify to get the LHS element address and indicate + // the assignment, the actual assignment must be implemented in + // ccStoreToDest. + destination = arrLoad; + return [=](IterSpace iters) -> ExtValue { + mlir::Value innerArg = iters.innerArgument(); + mlir::Type resTy = innerArg.getType(); + mlir::Type eleTy = fir::applyPathToType(resTy, iters.iterVec()); + mlir::Type refEleTy = + fir::isa_ref_type(eleTy) ? eleTy : builder.getRefType(eleTy); + auto arrModify = builder.create<fir::ArrayModifyOp>( + loc, mlir::TypeRange{refEleTy, resTy}, innerArg, iters.iterVec(), + destination.getTypeparams()); + return abstractArrayExtValue(arrModify.getResult(1)); + }; } if (isCopyInCopyOut()) { // Semantics are copy-in copy-out. @@ -3736,11 +4133,11 @@ public: llvm::SmallVector<mlir::Value> substringBounds; populateBounds(substringBounds, components.substring); if (!substringBounds.empty()) { - // mlir::Value dstLen = fir::factory::genLenOfCharacter( - // builder, loc, arrLoad, iters.iterVec(), substringBounds); - // fir::CharBoxValue dstChar(arrayOp, dstLen); - // return fir::factory::CharacterExprHelper{builder, loc} - // .createSubstring(dstChar, substringBounds); + mlir::Value dstLen = fir::factory::genLenOfCharacter( + builder, loc, arrLoad, iters.iterVec(), substringBounds); + fir::CharBoxValue dstChar(arrayOp, dstLen); + return fir::factory::CharacterExprHelper{builder, loc} + .createSubstring(dstChar, substringBounds); } } return fir::factory::arraySectionElementToExtendedValue( @@ -3753,25 +4150,6 @@ public: }; } - /// Reduce the rank of a array to be boxed based on the slice's operands. - static mlir::Type reduceRank(mlir::Type arrTy, mlir::Value slice) { - if (slice) { - auto slOp = mlir::dyn_cast<fir::SliceOp>(slice.getDefiningOp()); - assert(slOp && "expected slice op"); - auto seqTy = arrTy.dyn_cast<fir::SequenceType>(); - assert(seqTy && "expected array type"); - mlir::Operation::operand_range triples = slOp.getTriples(); - fir::SequenceType::Shape shape; - // reduce the rank for each invariant dimension - for (unsigned i = 1, end = triples.size(); i < end; i += 3) - if (!mlir::isa_and_nonnull<fir::UndefOp>(triples[i].getDefiningOp())) - shape.push_back(fir::SequenceType::getUnknownExtent()); - return fir::SequenceType::get(shape, seqTy.getEleTy()); - } - // not sliced, so no change in rank - return arrTy; - } - private: void determineShapeOfDest(const fir::ExtendedValue &lhs) { destShape = fir::factory::getExtents(builder, getLoc(), lhs); @@ -4125,6 +4503,18 @@ fir::MutableBoxValue Fortran::lower::createMutableBox( .genMutableBoxValue(expr); } +fir::ExtendedValue Fortran::lower::createBoxValue( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, + Fortran::lower::StatementContext &stmtCtx) { + if (expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) && + !Fortran::evaluate::HasVectorSubscript(expr)) + return Fortran::lower::createSomeArrayBox(converter, expr, symMap, stmtCtx); + fir::ExtendedValue addr = Fortran::lower::createSomeExtendedAddress( + loc, converter, expr, symMap, stmtCtx); + return fir::BoxValue(converter.getFirOpBuilder().createBox(loc, addr)); +} + mlir::Value Fortran::lower::createSubroutineCall( AbstractConverter &converter, const evaluate::ProcedureRef &call, SymMap &symMap, StatementContext &stmtCtx) { diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index beb3a7b609f0..0f9b55ac749d 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -18,6 +18,7 @@ #include "llvm/ADT/SmallVector.h" #include "llvm/ADT/StringRef.h" #include "llvm/ADT/Twine.h" +#include "llvm/Support/MD5.h" // recursively build the vector of module scopes static void moduleNames(const Fortran::semantics::Scope &scope, @@ -170,6 +171,53 @@ std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) { } //===----------------------------------------------------------------------===// +// Array Literals Mangling +//===----------------------------------------------------------------------===// + +static std::string typeToString(Fortran::common::TypeCategory cat, int kind) { + switch (cat) { + case Fortran::common::TypeCategory::Integer: + return "i" + std::to_string(kind); + case Fortran::common::TypeCategory::Real: + return "r" + std::to_string(kind); + case Fortran::common::TypeCategory::Complex: + return "z" + std::to_string(kind); + case Fortran::common::TypeCategory::Logical: + return "l" + std::to_string(kind); + case Fortran::common::TypeCategory::Character: + return "c" + std::to_string(kind); + case Fortran::common::TypeCategory::Derived: + // FIXME: Replace "DT" with the (fully qualified) type name. + return "dt.DT"; + } + llvm_unreachable("bad TypeCategory"); +} + +std::string Fortran::lower::mangle::mangleArrayLiteral( + const uint8_t *addr, size_t size, + const Fortran::evaluate::ConstantSubscripts &shape, + Fortran::common::TypeCategory cat, int kind, + Fortran::common::ConstantSubscript charLen) { + std::string typeId = ""; + for (Fortran::evaluate::ConstantSubscript extent : shape) + typeId.append(std::to_string(extent)).append("x"); + if (charLen >= 0) + typeId.append(std::to_string(charLen)).append("x"); + typeId.append(typeToString(cat, kind)); + std::string name = + fir::NameUniquer::doGenerated("ro."s.append(typeId).append(".")); + if (!size) + return name += "null"; + llvm::MD5 hashValue{}; + hashValue.update(llvm::ArrayRef<uint8_t>{addr, size}); + llvm::MD5::MD5Result hashResult; + hashValue.final(hashResult); + llvm::SmallString<32> hashString; + llvm::MD5::stringifyResult(hashResult, hashString); + return name += hashString.c_str(); +} + +//===----------------------------------------------------------------------===// // Intrinsic Procedure Mangling //===----------------------------------------------------------------------===// diff --git a/flang/test/Lower/array-character.f90 b/flang/test/Lower/array-character.f90 new file mode 100644 index 000000000000..d62c804ff183 --- /dev/null +++ b/flang/test/Lower/array-character.f90 @@ -0,0 +1,173 @@ +! RUN: bbc %s -o - | fir-opt --canonicalize --cse | FileCheck %s + +! CHECK-LABEL: func @_QPissue( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}, %[[VAL_1:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine issue(c1, c2) + ! CHECK-DAG: %[[VAL_2:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 32 : i8 + ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_6:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_7:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_8:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) + ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<3x!fir.char<1,4>>> + ! CHECK: %[[VAL_10:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) + ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<3x!fir.char<1,?>>> + ! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> + ! CHECK: cf.br ^bb1(%[[VAL_6]], %[[VAL_4]] : index, index) + ! CHECK: ^bb1(%[[VAL_13:.*]]: index, %[[VAL_14:.*]]: index): + ! CHECK: %[[VAL_15:.*]] = arith.cmpi sgt, %[[VAL_14]], %[[VAL_6]] : index + ! CHECK: cf.cond_br %[[VAL_15]], ^bb2, ^bb6 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_16:.*]] = arith.addi %[[VAL_13]], %[[VAL_7]] : index + ! CHECK: %[[VAL_17:.*]] = fir.array_coor %[[VAL_11]](%[[VAL_12]]) %[[VAL_16]] typeparams %[[VAL_10]]#1 : (!fir.ref<!fir.array<3x!fir.char<1,?>>>, !fir.shape<1>, index, index) -> !fir.ref<!fir.char<1,?>> + ! CHECK: %[[VAL_18:.*]] = fir.array_coor %[[VAL_9]](%[[VAL_12]]) %[[VAL_16]] : (!fir.ref<!fir.array<3x!fir.char<1,4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,4>> + ! CHECK: %[[VAL_19:.*]] = arith.cmpi slt, %[[VAL_5]], %[[VAL_10]]#1 : index + ! CHECK: %[[VAL_20:.*]] = arith.select %[[VAL_19]], %[[VAL_5]], %[[VAL_10]]#1 : index + ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (index) -> i64 + ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.char<1,4>>) -> !fir.ref<i8> + ! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_17]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8> + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_22]], %[[VAL_23]], %[[VAL_21]], %[[VAL_2]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () + ! CHECK: %[[VAL_24:.*]] = fir.undefined !fir.char<1> + ! CHECK: %[[VAL_25:.*]] = fir.insert_value %[[VAL_24]], %[[VAL_3]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: %[[VAL_26:.*]] = arith.subi %[[VAL_5]], %[[VAL_20]] : index + ! CHECK: cf.br ^bb3(%[[VAL_20]], %[[VAL_26]] : index, index) + ! CHECK: ^bb3(%[[VAL_27:.*]]: index, %[[VAL_28:.*]]: index): + ! CHECK: %[[VAL_29:.*]] = arith.cmpi sgt, %[[VAL_28]], %[[VAL_6]] : index + ! CHECK: cf.cond_br %[[VAL_29]], ^bb4, ^bb5 + ! CHECK: ^bb4: + ! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.char<1,4>>) -> !fir.ref<!fir.array<4x!fir.char<1>>> + ! CHECK: %[[VAL_31:.*]] = fir.coordinate_of %[[VAL_30]], %[[VAL_27]] : (!fir.ref<!fir.array<4x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>> + ! CHECK: fir.store %[[VAL_25]] to %[[VAL_31]] : !fir.ref<!fir.char<1>> + ! CHECK: %[[VAL_32:.*]] = arith.addi %[[VAL_27]], %[[VAL_7]] : index + ! CHECK: %[[VAL_33:.*]] = arith.subi %[[VAL_28]], %[[VAL_7]] : index + ! CHECK: cf.br ^bb3(%[[VAL_32]], %[[VAL_33]] : index, index) + ! CHECK: ^bb5: + + character(4) :: c1(3) + character(*) :: c2(3) + c1 = c2 + ! CHECK: return + ! CHECK: } + end subroutine + + ! CHECK-LABEL: func @_QQmain() { +program p + ! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_2:.*]] = arith.constant -1 : i32 + ! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QFEc1) : !fir.ref<!fir.array<3x!fir.char<1,4>>> + ! CHECK: %[[VAL_6:.*]] = fir.address_of(@_QFEc2) : !fir.ref<!fir.array<3x!fir.char<1,4>>> + ! CHECK: %[[VAL_7:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1, + ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8> + ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_2]], %[[VAL_8]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8> + ! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_6]](%[[VAL_10]]) : (!fir.ref<!fir.array<3x!fir.char<1,4>>>, !fir.shape<1>) -> !fir.box<!fir.array<3x!fir.char<1,4>>> + ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.array<3x!fir.char<1,4>>>) -> !fir.box<none> + ! CHECK: %[[VAL_13:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_9]], %[[VAL_12]]) : (!fir.ref<i8>, !fir.box<none>) -> i1 + ! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_9]]) : (!fir.ref<i8>) -> i32 + ! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_5]] : (!fir.ref<!fir.array<3x!fir.char<1,4>>>) -> !fir.ref<!fir.char<1,?>> + ! CHECK: %[[VAL_16:.*]] = fir.emboxchar %[[VAL_15]], %[[VAL_0]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1> + ! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.array<3x!fir.char<1,4>>>) -> !fir.ref<!fir.char<1,?>> + ! CHECK: %[[VAL_18:.*]] = fir.emboxchar %[[VAL_17]], %[[VAL_0]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPissue(%[[VAL_16]], %[[VAL_18]]) : (!fir.boxchar<1>, !fir.boxchar<1>) -> () + ! CHECK: %[[VAL_19:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_2]], %[[VAL_8]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8> + ! CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_5]](%[[VAL_10]]) : (!fir.ref<!fir.array<3x!fir.char<1,4>>>, !fir.shape<1>) -> !fir.box<!fir.array<3x!fir.char<1,4>>> + ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (!fir.box<!fir.array<3x!fir.char<1,4>>>) -> !fir.box<none> + ! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_19]], %[[VAL_21]]) : (!fir.ref<i8>, !fir.box<none>) -> i1 + ! CHECK: %[[VAL_23:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_19]]) : (!fir.ref<i8>) -> i32 + ! CHECK: fir.call @_QPcharlit() : () -> () + character(4) :: c1(3) + character(4) :: c2(3) = ["abcd", " ", " "] + print *, c2 + call issue(c1, c2) + print *, c1 + call charlit + ! CHECK: return + ! CHECK: } + end program p + + ! CHECK-LABEL: func @_QPcharlit() { +subroutine charlit + ! CHECK-DAG: %[[VAL_0:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_6:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_7:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_8:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1, + ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8> + ! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_0]], %[[VAL_9]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8> + ! CHECK: %[[VAL_11:.*]] = fir.address_of(@_QQro.4x3xc1.1636b396a657de68ffb870a885ac44b4) : !fir.ref<!fir.array<4x!fir.char<1,3>>> + ! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_13:.*]] = fir.allocmem !fir.array<4x!fir.char<1,3>> + ! CHECK: cf.br ^bb1(%[[VAL_6]], %[[VAL_5]] : index, index) + ! CHECK: ^bb1(%[[VAL_14:.*]]: index, %[[VAL_15:.*]]: index): + ! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_6]] : index + ! CHECK: cond_br %[[VAL_16]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_17:.*]] = arith.addi %[[VAL_14]], %[[VAL_7]] : index + ! CHECK: %[[VAL_18:.*]] = fir.array_coor %[[VAL_11]](%[[VAL_12]]) %[[VAL_17]] : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,3>> + ! CHECK: %[[VAL_19:.*]] = fir.array_coor %[[VAL_13]](%[[VAL_12]]) %[[VAL_17]] : (!fir.heap<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,3>> + ! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]] : (index) -> i64 + ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_19]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> + ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_21]], %[[VAL_22]], %[[VAL_20]], %[[VAL_4]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () + ! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_15]], %[[VAL_7]] : index + ! CHECK: cf.br ^bb1(%[[VAL_17]], %[[VAL_23]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_24:.*]] = fir.embox %[[VAL_13]](%[[VAL_12]]) : (!fir.heap<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>) -> !fir.box<!fir.array<4x!fir.char<1,3>>> + ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (!fir.box<!fir.array<4x!fir.char<1,3>>>) -> !fir.box<none> + ! CHECK: %[[VAL_26:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_10]], %[[VAL_25]]) : (!fir.ref<i8>, !fir.box<none>) -> i1 + ! CHECK: fir.freemem %[[VAL_13]] + ! CHECK: %[[VAL_27:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_10]]) : (!fir.ref<i8>) -> i32 + ! CHECK: %[[VAL_28:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_0]], %[[VAL_9]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8> + ! CHECK: %[[VAL_29:.*]] = fir.allocmem !fir.array<4x!fir.char<1,3>> + ! CHECK: br ^bb4(%[[VAL_6]], %[[VAL_5]] : index, index) + ! CHECK: ^bb4(%[[VAL_30:.*]]: index, %[[VAL_31:.*]]: index): + ! CHECK: %[[VAL_32:.*]] = arith.cmpi sgt, %[[VAL_31]], %[[VAL_6]] : index + ! CHECK: cond_br %[[VAL_32]], ^bb5, ^bb6 + ! CHECK: ^bb5: + ! CHECK: %[[VAL_33:.*]] = arith.addi %[[VAL_30]], %[[VAL_7]] : index + ! CHECK: %[[VAL_34:.*]] = fir.array_coor %[[VAL_11]](%[[VAL_12]]) %[[VAL_33]] : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,3>> + ! CHECK: %[[VAL_35:.*]] = fir.array_coor %[[VAL_29]](%[[VAL_12]]) %[[VAL_33]] : (!fir.heap<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,3>> + ! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_3]] : (index) -> i64 + ! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_35]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> + ! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_34]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_37]], %[[VAL_38]], %[[VAL_36]], %[[VAL_4]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () + ! CHECK: %[[VAL_39:.*]] = arith.subi %[[VAL_31]], %[[VAL_7]] : index + ! CHECK: br ^bb4(%[[VAL_33]], %[[VAL_39]] : index, index) + ! CHECK: ^bb6: + ! CHECK: %[[VAL_40:.*]] = fir.embox %[[VAL_29]](%[[VAL_12]]) : (!fir.heap<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>) -> !fir.box<!fir.array<4x!fir.char<1,3>>> + ! CHECK: %[[VAL_41:.*]] = fir.convert %[[VAL_40]] : (!fir.box<!fir.array<4x!fir.char<1,3>>>) -> !fir.box<none> + ! CHECK: %[[VAL_42:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_28]], %[[VAL_41]]) : (!fir.ref<i8>, !fir.box<none>) -> i1 + ! CHECK: fir.freemem %[[VAL_29]] + ! CHECK: %[[VAL_43:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_28]]) : (!fir.ref<i8>) -> i32 + ! CHECK: %[[VAL_44:.*]] = fir.call @_FortranAioBeginExternalListOutput(%[[VAL_0]], %[[VAL_9]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8> + ! CHECK: %[[VAL_45:.*]] = fir.allocmem !fir.array<4x!fir.char<1,3>> + ! CHECK: br ^bb7(%[[VAL_6]], %[[VAL_5]] : index, index) + ! CHECK: ^bb7(%[[VAL_46:.*]]: index, %[[VAL_47:.*]]: index): + ! CHECK: %[[VAL_48:.*]] = arith.cmpi sgt, %[[VAL_47]], %[[VAL_6]] : index + ! CHECK: cond_br %[[VAL_48]], ^bb8, ^bb9 + ! CHECK: ^bb8: + ! CHECK: %[[VAL_49:.*]] = arith.addi %[[VAL_46]], %[[VAL_7]] : index + ! CHECK: %[[VAL_50:.*]] = fir.array_coor %[[VAL_11]](%[[VAL_12]]) %[[VAL_49]] : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,3>> + ! CHECK: %[[VAL_51:.*]] = fir.array_coor %[[VAL_45]](%[[VAL_12]]) %[[VAL_49]] : (!fir.heap<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.char<1,3>> + ! CHECK: %[[VAL_52:.*]] = fir.convert %[[VAL_3]] : (index) -> i64 + ! CHECK: %[[VAL_53:.*]] = fir.convert %[[VAL_51]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> + ! CHECK: %[[VAL_54:.*]] = fir.convert %[[VAL_50]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8> + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_53]], %[[VAL_54]], %[[VAL_52]], %[[VAL_4]]) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () + ! CHECK: %[[VAL_55:.*]] = arith.subi %[[VAL_47]], %[[VAL_7]] : index + ! CHECK: br ^bb7(%[[VAL_49]], %[[VAL_55]] : index, index) + ! CHECK: ^bb9: + ! CHECK: %[[VAL_56:.*]] = fir.embox %[[VAL_45]](%[[VAL_12]]) : (!fir.heap<!fir.array<4x!fir.char<1,3>>>, !fir.shape<1>) -> !fir.box<!fir.array<4x!fir.char<1,3>>> + ! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_56]] : (!fir.box<!fir.array<4x!fir.char<1,3>>>) -> !fir.box<none> + ! CHECK: %[[VAL_58:.*]] = fir.call @_FortranAioOutputDescriptor(%[[VAL_44]], %[[VAL_57]]) : (!fir.ref<i8>, !fir.box<none>) -> i1 + ! CHECK: fir.freemem %[[VAL_45]] + ! CHECK: %[[VAL_59:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_44]]) : (!fir.ref<i8>) -> i32 + print*, ['AA ', 'MM ', 'MM ', 'ZZ '] + print*, ['AA ', 'MM ', 'MM ', 'ZZ '] + print*, ['AA ', 'MM ', 'MM ', 'ZZ '] + ! CHECK: return + ! CHECK: } + end |