[flang-commits] [flang] c3a7627 - [flang] Lower more array character cases
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Mar 9 10:51:04 PST 2022
Author: Valentin Clement
Date: 2022-03-09T19:50:57+01:00
New Revision: c3a7627cacc6cbe2301a253daeb3e6953e5e0d1d
URL: https://github.com/llvm/llvm-project/commit/c3a7627cacc6cbe2301a253daeb3e6953e5e0d1d
DIFF: https://github.com/llvm/llvm-project/commit/c3a7627cacc6cbe2301a253daeb3e6953e5e0d1d.diff
LOG: [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 at nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz at nvidia.com>
Added:
flang/test/Lower/array-character.f90
Modified:
flang/include/flang/Lower/ConvertExpr.h
flang/include/flang/Lower/Mangler.h
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/Mangler.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h
index 7787a97a7b726..c1791723fed43 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 d82fdb0ed99ab..1c59eda991768 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 ffd3b97cecef7..bd74b47192f1f 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 @@ class ScalarExprLowering {
}
}
+ /// 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 @@ class ScalarExprLowering {
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());
}
@@ -1964,6 +2158,37 @@ class ScalarExprLowering {
expr.u);
}
+ 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
@@ -1973,7 +2198,9 @@ class ScalarExprLowering {
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 @@ class ScalarExprLowering {
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 @@ class ArrayExprLowering {
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 @@ class ArrayExprLowering {
};
}
+ /// 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 @@ class ArrayExprLowering {
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 @@ class ArrayExprLowering {
.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 @@ class ArrayExprLowering {
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 @@ class ArrayExprLowering {
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 @@ class ArrayExprLowering {
};
}
- /// 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 beb3a7b609f07..0f9b55ac749d9 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,
@@ -169,6 +170,53 @@ std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
return result.second.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 0000000000000..d62c804ff1836
--- /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
More information about the flang-commits
mailing list