diff --git a/flang/include/flang/Lower/ConvertConstant.h b/flang/include/flang/Lower/ConvertConstant.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/ConvertConstant.h @@ -0,0 +1,66 @@ +//===-- ConvertConstant.h -- lowering of constants --------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +/// +/// Implements the conversion from evaluate::Constant to FIR. +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CONVERTCONSTANT_H +#define FORTRAN_LOWER_CONVERTCONSTANT_H + +#include "flang/Evaluate/constant.h" +#include "flang/Lower/Support/Utils.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" + +namespace Fortran::lower { +template +class ConstantBuilder {}; + +/// Class to lower intrinsic evaluate::Constant to fir::ExtendedValue. +template +class ConstantBuilder> { +public: + /// Lower \p constant into a fir::ExtendedValue. + /// If \p outlineBigConstantsInReadOnlyMemory is set, character and array + /// constants will be lowered into read only memory fir.global, and the + /// resulting fir::ExtendedValue will contain the address of the fir.global. + /// This option should not be set if the constant is being lowered while the + /// builder is already in a fir.global body because fir.global initialization + /// body cannot contain code manipulating memory (e.g. fir.load/fir.store...). + static fir::ExtendedValue + gen(fir::FirOpBuilder &builder, mlir::Location loc, + const evaluate::Constant> &constant, + bool outlineBigConstantsInReadOnlyMemory); +}; + +template +using IntrinsicConstantBuilder = ConstantBuilder>; + +using namespace evaluate; +FOR_EACH_INTRINSIC_KIND(extern template class ConstantBuilder, ) + +/// Create a fir.global array with a dense attribute containing the value of +/// \p initExpr. +/// Using a dense attribute allows faster MLIR compilation times compared to +/// creating an initialization body for the initial value. However, a dense +/// attribute can only be created if initExpr is a non-empty rank 1 numerical or +/// logical Constant. Otherwise, the value returned will be null. +fir::GlobalOp tryCreatingDenseGlobal(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type symTy, + llvm::StringRef globalName, + mlir::StringAttr linkage, bool isConst, + const Fortran::lower::SomeExpr &initExpr); + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_CONVERTCONSTANT_H diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -47,13 +47,6 @@ SymMap &symMap, StatementContext &stmtCtx); -/// Create a global array symbol with the Dense attribute -fir::GlobalOp createDenseGlobal(mlir::Location loc, mlir::Type symTy, - llvm::StringRef globalName, - mlir::StringAttr linkage, bool isConst, - const SomeExpr &expr, - Fortran::lower::AbstractConverter &converter); - /// Create the IR for the expression \p expr in an initialization context. /// Expressions that appear in initializers may not allocate temporaries, do not /// have a stack, etc. diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -5,6 +5,7 @@ Bridge.cpp CallInterface.cpp Coarray.cpp + ConvertConstant.cpp ConvertExpr.cpp ConvertExprToHLFIR.cpp ConvertType.cpp diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/ConvertConstant.cpp @@ -0,0 +1,489 @@ +//===-- ConvertConstant.cpp -----------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/ConvertConstant.h" +#include "flang/Evaluate/expression.h" +#include "flang/Lower/ConvertType.h" +#include "flang/Lower/Mangler.h" +#include "flang/Optimizer/Builder/Complex.h" +#include "flang/Optimizer/Builder/Todo.h" + +/// Convert string, \p s, to an APFloat value. Recognize and handle Inf and +/// NaN strings as well. \p s is assumed to not contain any spaces. +static llvm::APFloat consAPFloat(const llvm::fltSemantics &fsem, + llvm::StringRef s) { + assert(!s.contains(' ')); + if (s.compare_insensitive("-inf") == 0) + return llvm::APFloat::getInf(fsem, /*negative=*/true); + if (s.compare_insensitive("inf") == 0 || s.compare_insensitive("+inf") == 0) + return llvm::APFloat::getInf(fsem); + // TODO: Add support for quiet and signaling NaNs. + if (s.compare_insensitive("-nan") == 0) + return llvm::APFloat::getNaN(fsem, /*negative=*/true); + if (s.compare_insensitive("nan") == 0 || s.compare_insensitive("+nan") == 0) + return llvm::APFloat::getNaN(fsem); + return {fsem, s}; +} + +//===----------------------------------------------------------------------===// +// Fortran::lower::tryCreatingDenseGlobal implementation +//===----------------------------------------------------------------------===// + +/// Generate an mlir attribute from a literal value +template +static mlir::Attribute convertToAttribute( + fir::FirOpBuilder &builder, + const Fortran::evaluate::Scalar> &value, + mlir::Type type) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return builder.getIntegerAttr(type, value.ToInt64()); + } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { + return builder.getIntegerAttr(type, value.IsTrue()); + } else { + static_assert(TC == Fortran::common::TypeCategory::Real, + "type values cannot be converted to attributes"); + std::string str = value.DumpHexadecimal(); + auto floatVal = + consAPFloat(builder.getKindMap().getFloatSemantics(KIND), str); + return builder.getFloatAttr(type, floatVal); + } + return {}; +} + +namespace { +/// Helper class to lower an array constant to a global with an MLIR dense +/// attribute. +/// +/// 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. +class DenseGlobalBuilder { +public: + static fir::GlobalOp tryCreating(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type symTy, + llvm::StringRef globalName, + mlir::StringAttr linkage, bool isConst, + const Fortran::lower::SomeExpr &initExpr) { + DenseGlobalBuilder globalBuilder; + std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::Expr & + x) { globalBuilder.tryConvertingToAttributes(builder, x); }, + [&](const Fortran::evaluate::Expr & + x) { globalBuilder.tryConvertingToAttributes(builder, x); }, + [&](const Fortran::evaluate::Expr &x) { + globalBuilder.tryConvertingToAttributes(builder, x); + }, + [](const auto &) {}, + }, + initExpr.u); + return globalBuilder.tryCreatingGlobal(builder, loc, symTy, globalName, + linkage, isConst); + } + + template + static fir::GlobalOp tryCreating( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy, + llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst, + const Fortran::evaluate::Constant> + &constant) { + DenseGlobalBuilder globalBuilder; + globalBuilder.tryConvertingToAttributes(builder, constant); + return globalBuilder.tryCreatingGlobal(builder, loc, symTy, globalName, + linkage, isConst); + } + +private: + DenseGlobalBuilder() = default; + + /// Try converting an evaluate::Constant to a list of MLIR attributes. + template + void tryConvertingToAttributes( + fir::FirOpBuilder &builder, + const Fortran::evaluate::Constant> + &constant) { + static_assert(TC != Fortran::common::TypeCategory::Character, + "must be numerical or logical"); + if (constant.Rank() != 1) + return; + auto attrTc = TC == Fortran::common::TypeCategory::Logical + ? Fortran::common::TypeCategory::Integer + : TC; + attributeElementType = Fortran::lower::getFIRType(builder.getContext(), + attrTc, KIND, llvm::None); + for (auto element : constant.values()) + attributes.push_back( + convertToAttribute(builder, element, attributeElementType)); + } + + /// Try converting an evaluate::Expr to a list of MLIR attributes. + template + void tryConvertingToAttributes(fir::FirOpBuilder &builder, + const Fortran::evaluate::Expr &expr) { + std::visit( + [&](const auto &x) { + using TR = Fortran::evaluate::ResultType; + if (const auto *constant = + std::get_if>(&x.u)) + tryConvertingToAttributes(builder, + *constant); + }, + expr.u); + } + + /// Create a fir::Global if MLIR attributes have been successfully created by + /// tryConvertingToAttributes. + fir::GlobalOp tryCreatingGlobal(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type symTy, + llvm::StringRef globalName, + mlir::StringAttr linkage, + bool isConst) const { + // Not a rank 1 "trivial" intrinsic constant array, or empty array. + if (!attributeElementType || attributes.empty()) + return {}; + + auto tensorTy = + mlir::RankedTensorType::get(attributes.size(), attributeElementType); + auto init = mlir::DenseElementsAttr::get(tensorTy, attributes); + return builder.createGlobal(loc, symTy, globalName, linkage, init, isConst); + } + + llvm::SmallVector attributes; + mlir::Type attributeElementType; +}; +} // namespace + +fir::GlobalOp Fortran::lower::tryCreatingDenseGlobal( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy, + llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst, + const Fortran::lower::SomeExpr &initExpr) { + return DenseGlobalBuilder::tryCreating(builder, loc, symTy, globalName, + linkage, isConst, initExpr); +} + +//===----------------------------------------------------------------------===// +// Fortran::lower::IntrinsicConstantBuilder::gen +// Lower an array constant to a fir::ExtendedValue. +//===----------------------------------------------------------------------===// + +/// Generate a real constant with a value `value`. +template +static mlir::Value genRealConstant(fir::FirOpBuilder &builder, + mlir::Location loc, + const llvm::APFloat &value) { + mlir::Type fltTy = Fortran::lower::convertReal(builder.getContext(), KIND); + return builder.createRealConstant(loc, fltTy, value); +} + +/// Convert a scalar literal constant to IR. +template +static mlir::Value genScalarLit( + fir::FirOpBuilder &builder, mlir::Location loc, + const Fortran::evaluate::Scalar> &value) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + mlir::Type ty = + Fortran::lower::getFIRType(builder.getContext(), TC, KIND, llvm::None); + if (KIND == 16) { + auto bigInt = + llvm::APInt(ty.getIntOrFloatBitWidth(), value.SignedDecimal(), 10); + return builder.create( + loc, ty, mlir::IntegerAttr::get(ty, bigInt)); + } + return builder.createIntegerConstant(loc, ty, value.ToInt64()); + } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { + return builder.createBool(loc, value.IsTrue()); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + std::string str = value.DumpHexadecimal(); + if constexpr (KIND == 2) { + auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str); + return genRealConstant(builder, loc, floatVal); + } else if constexpr (KIND == 3) { + auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str); + return genRealConstant(builder, loc, floatVal); + } else if constexpr (KIND == 4) { + auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str); + return genRealConstant(builder, loc, floatVal); + } else if constexpr (KIND == 10) { + auto floatVal = consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str); + return genRealConstant(builder, loc, floatVal); + } else if constexpr (KIND == 16) { + auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str); + return genRealConstant(builder, loc, floatVal); + } else { + // convert everything else to double + auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str); + return genRealConstant(builder, loc, floatVal); + } + } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { + mlir::Value realPart = + genScalarLit(builder, loc, + value.REAL()); + mlir::Value imagPart = + genScalarLit(builder, loc, + value.AIMAG()); + return fir::factory::Complex{builder, loc}.createComplex(KIND, realPart, + imagPart); + } else /*constexpr*/ { + llvm_unreachable("unhandled constant"); + } +} + +/// Create fir::string_lit from a scalar character constant. +template +static fir::StringLitOp +createStringLitOp(fir::FirOpBuilder &builder, mlir::Location loc, + const Fortran::evaluate::Scalar> &value, + [[maybe_unused]] int64_t len) { + if constexpr (KIND == 1) { + assert(value.size() == static_cast(len)); + return builder.createStringLitOp(loc, value); + } else { + using ET = typename std::decay_t::value_type; + fir::CharacterType type = + fir::CharacterType::get(builder.getContext(), KIND, len); + mlir::MLIRContext *context = builder.getContext(); + std::int64_t size = static_cast(value.size()); + mlir::ShapedType shape = mlir::RankedTensorType::get( + llvm::ArrayRef{size}, + mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8)); + auto denseAttr = mlir::DenseElementsAttr::get( + shape, llvm::ArrayRef{value.data(), value.size()}); + auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist()); + mlir::NamedAttribute dataAttr(denseTag, denseAttr); + auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size()); + mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len)); + llvm::SmallVector attrs = {dataAttr, sizeAttr}; + return builder.create( + loc, llvm::ArrayRef{type}, llvm::None, attrs); + } +} + +/// Convert a scalar literal CHARACTER to IR. +template +static mlir::Value +genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc, + const Fortran::evaluate::Scalar> &value, + int64_t len, bool outlineInReadOnlyMemory) { + // When in an initializer context, construct the literal op itself and do + // not construct another constant object in rodata. + if (!outlineInReadOnlyMemory) + return createStringLitOp(builder, loc, value, len); + + // Otherwise, the string is in a plain old expression so "outline" the value + // in read only data by hash consing it to a constant literal object. + + // ASCII global constants are created using an mlir string attribute. + if constexpr (KIND == 1) { + return fir::getBase(fir::factory::createStringLiteral(builder, loc, value)); + } + + auto size = builder.getKindMap().getCharacterBitsize(KIND) / 8 * value.size(); + llvm::StringRef strVal(reinterpret_cast(value.c_str()), size); + std::string globalName = fir::factory::uniqueCGIdent("cl", strVal); + fir::GlobalOp global = builder.getNamedGlobal(globalName); + fir::CharacterType type = + fir::CharacterType::get(builder.getContext(), KIND, len); + if (!global) + global = builder.createGlobalConstant( + loc, type, globalName, + [&](fir::FirOpBuilder &builder) { + fir::StringLitOp str = + createStringLitOp(builder, loc, value, len); + builder.create(loc, str); + }, + builder.createLinkOnceLinkage()); + return builder.create(loc, global.resultType(), + global.getSymbol()); +} + +/// Create an evaluate::Constant array to a fir.array<> value +/// built with a chain of fir.insert or fir.insert_on_range operations. +/// This is intended to be called when building the body of a fir.global. +template +static mlir::Value genInlinedArrayLit( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type arrayTy, + const Fortran::evaluate::Constant> &con) { + mlir::IndexType idxTy = builder.getIndexType(); + Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds(); + auto createIdx = [&]() { + llvm::SmallVector idx; + for (size_t i = 0; i < subscripts.size(); ++i) + idx.push_back( + builder.getIntegerAttr(idxTy, subscripts[i] - con.lbounds()[i])); + return idx; + }; + mlir::Value array = builder.create(loc, arrayTy); + if (Fortran::evaluate::GetSize(con.shape()) == 0) + return array; + if constexpr (TC == Fortran::common::TypeCategory::Character) { + do { + mlir::Value elementVal = + genScalarLit(builder, loc, con.At(subscripts), con.LEN(), + /*outlineInReadOnlyMemory=*/false); + array = builder.create( + loc, arrayTy, array, elementVal, builder.getArrayAttr(createIdx())); + } while (con.IncrementSubscripts(subscripts)); + } else { + llvm::SmallVector rangeStartIdx; + uint64_t rangeSize = 0; + mlir::Type eleTy = arrayTy.cast().getEleTy(); + do { + auto getElementVal = [&]() { + return builder.createConvert( + loc, eleTy, + genScalarLit(builder, loc, 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( + 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 rangeBounds; + llvm::SmallVector idx = createIdx(); + for (size_t i = 0; i < idx.size(); ++i) { + rangeBounds.push_back(rangeStartIdx[i] + .cast() + .getValue() + .getSExtValue()); + rangeBounds.push_back( + idx[i].cast().getValue().getSExtValue()); + } + array = builder.create( + loc, arrayTy, array, getElementVal(), + builder.getIndexVectorAttr(rangeBounds)); + rangeSize = 0; + } + } while (con.IncrementSubscripts(subscripts)); + } + return array; +} + +/// Convert an evaluate::Constant array into a fir.ref> value +/// that points to the storage of a fir.global in read only memory and is +/// initialized with the value of the constant. +/// This should not be called while generating the body of a fir.global. +template +static mlir::Value genOutlineArrayLit( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type arrayTy, + const Fortran::evaluate::Constant> + &constant) { + std::string globalName = Fortran::lower::mangle::mangleArrayLiteral(constant); + fir::GlobalOp global = builder.getNamedGlobal(globalName); + if (!global) { + // Using a dense attribute for the initial value instead of creating an + // intialization body speeds up MLIR/LLVM compilation, but this is not + // always possible. + if constexpr (TC == Fortran::common::TypeCategory::Logical || + TC == Fortran::common::TypeCategory::Integer || + TC == Fortran::common::TypeCategory::Real) { + global = DenseGlobalBuilder::tryCreating( + builder, loc, arrayTy, globalName, builder.createInternalLinkage(), + true, constant); + } + if (!global) + global = builder.createGlobalConstant( + loc, arrayTy, globalName, + [&](fir::FirOpBuilder &builder) { + mlir::Value result = + genInlinedArrayLit(builder, loc, arrayTy, constant); + builder.create(loc, result); + }, + builder.createInternalLinkage()); + } + return builder.create(loc, global.resultType(), + global.getSymbol()); +} + +/// Convert an evaluate::Constant array into an fir::ExtendedValue. +template +static fir::ExtendedValue genArrayLit( + fir::FirOpBuilder &builder, mlir::Location loc, + const Fortran::evaluate::Constant> &con, + bool outlineInReadOnlyMemory) { + Fortran::evaluate::ConstantSubscript size = + Fortran::evaluate::GetSize(con.shape()); + if (size > std::numeric_limits::max()) + // llvm::SmallVector has limited size + TODO(loc, "Creation of very large array constants"); + fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end()); + llvm::SmallVector typeParams; + if constexpr (TC == Fortran::common::TypeCategory::Character) + typeParams.push_back(con.LEN()); + mlir::Type eleTy = + Fortran::lower::getFIRType(builder.getContext(), TC, KIND, typeParams); + auto arrayTy = fir::SequenceType::get(shape, eleTy); + mlir::Value array = outlineInReadOnlyMemory + ? genOutlineArrayLit(builder, loc, arrayTy, con) + : genInlinedArrayLit(builder, loc, arrayTy, con); + + mlir::IndexType idxTy = builder.getIndexType(); + llvm::SmallVector extents; + for (auto extent : shape) + extents.push_back(builder.createIntegerConstant(loc, idxTy, extent)); + // Convert lower bounds if they are not all ones. + llvm::SmallVector lbounds; + if (llvm::any_of(con.lbounds(), [](auto lb) { return lb != 1; })) + for (auto lb : con.lbounds()) + lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb)); + + 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}; + } +} + +template +fir::ExtendedValue +Fortran::lower::ConstantBuilder>::gen( + fir::FirOpBuilder &builder, mlir::Location loc, + const Fortran::evaluate::Constant> + &constant, + bool outlineBigConstantsInReadOnlyMemory) { + if (constant.Rank() > 0) + return genArrayLit(builder, loc, constant, + outlineBigConstantsInReadOnlyMemory); + std::optional>> + opt = constant.GetScalarValue(); + assert(opt.has_value() && "constant has no value"); + if constexpr (TC == Fortran::common::TypeCategory::Character) { + auto value = genScalarLit(builder, loc, opt.value(), constant.LEN(), + outlineBigConstantsInReadOnlyMemory); + mlir::Value len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), constant.LEN()); + return fir::CharBoxValue{value, len}; + } else { + return genScalarLit(builder, loc, opt.value()); + } +} + +using namespace Fortran::evaluate; +FOR_EACH_INTRINSIC_KIND(template class Fortran::lower::ConstantBuilder, ) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -22,6 +22,7 @@ #include "flang/Lower/CallInterface.h" #include "flang/Lower/Coarray.h" #include "flang/Lower/ComponentPath.h" +#include "flang/Lower/ConvertConstant.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/CustomIntrinsicCall.h" @@ -516,16 +517,6 @@ return false; } -/// Some auxiliary data for processing initialization in ScalarExprLowering -/// below. This is currently used for generating dense attributed global -/// arrays. -struct InitializerData { - explicit InitializerData(bool getRawVals = false) : genRawVals{getRawVals} {} - llvm::SmallVector rawVals; // initialization raw values - mlir::Type rawType; // Type of elements processed for rawVals vector. - bool genRawVals; // generate the rawVals vector if set. -}; - /// If \p arg is the address of a function with a denoted host-association tuple /// argument, then return the host-associations tuple value of the current /// procedure. Otherwise, return nullptr. @@ -666,10 +657,10 @@ Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx, - InitializerData *initializer = nullptr) + bool inInitializer = false) : location{loc}, converter{converter}, builder{converter.getFirOpBuilder()}, stmtCtx{stmtCtx}, symMap{symMap}, - inInitializer{initializer} {} + inInitializer{inInitializer} {} ExtValue genExtAddr(const Fortran::lower::SomeExpr &expr) { return gen(expr); @@ -788,14 +779,6 @@ return builder.createBool(getLoc(), value); } - /// Generate a real constant with a value `value`. - template - mlir::Value genRealConstant(mlir::MLIRContext *context, - const llvm::APFloat &value) { - mlir::Type fltTy = Fortran::lower::convertReal(context, KIND); - return builder.createRealConstant(getLoc(), fltTy, value); - } - mlir::Type getSomeKindInteger() { return builder.getIndexType(); } mlir::func::FuncOp getFunction(llvm::StringRef name, @@ -1459,278 +1442,6 @@ llvm_unreachable("unhandled logical operation"); } - /// Convert a scalar literal constant to IR. - template - ExtValue genScalarLit( - const Fortran::evaluate::Scalar> - &value) { - if constexpr (TC == Fortran::common::TypeCategory::Integer) { - if (KIND == 16) { - mlir::Type ty = - converter.genType(Fortran::common::TypeCategory::Integer, KIND); - auto bigInt = - llvm::APInt(ty.getIntOrFloatBitWidth(), value.SignedDecimal(), 10); - return builder.create( - getLoc(), ty, mlir::IntegerAttr::get(ty, bigInt)); - } - return genIntegerConstant(builder.getContext(), value.ToInt64()); - } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { - return genBoolConstant(value.IsTrue()); - } else if constexpr (TC == Fortran::common::TypeCategory::Real) { - std::string str = value.DumpHexadecimal(); - if constexpr (KIND == 2) { - auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str); - return genRealConstant(builder.getContext(), floatVal); - } else if constexpr (KIND == 3) { - auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str); - return genRealConstant(builder.getContext(), floatVal); - } else if constexpr (KIND == 4) { - auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str); - return genRealConstant(builder.getContext(), floatVal); - } else if constexpr (KIND == 10) { - auto floatVal = - consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str); - return genRealConstant(builder.getContext(), floatVal); - } else if constexpr (KIND == 16) { - auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str); - return genRealConstant(builder.getContext(), floatVal); - } else { - // convert everything else to double - auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str); - return genRealConstant(builder.getContext(), floatVal); - } - } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { - using TR = - Fortran::evaluate::Type; - Fortran::evaluate::ComplexConstructor ctor( - Fortran::evaluate::Expr{ - Fortran::evaluate::Constant{value.REAL()}}, - Fortran::evaluate::Expr{ - Fortran::evaluate::Constant{value.AIMAG()}}); - return genunbox(ctor); - } else /*constexpr*/ { - llvm_unreachable("unhandled constant"); - } - } - - /// Convert string, \p s, to an APFloat value. Recognize and handle Inf and - /// NaN strings as well. \p s is assumed to not contain any spaces. - static llvm::APFloat consAPFloat(const llvm::fltSemantics &fsem, - llvm::StringRef s) { - assert(!s.contains(' ')); - if (s.compare_insensitive("-inf") == 0) - return llvm::APFloat::getInf(fsem, /*negative=*/true); - if (s.compare_insensitive("inf") == 0 || s.compare_insensitive("+inf") == 0) - return llvm::APFloat::getInf(fsem); - // TODO: Add support for quiet and signaling NaNs. - if (s.compare_insensitive("-nan") == 0) - return llvm::APFloat::getNaN(fsem, /*negative=*/true); - if (s.compare_insensitive("nan") == 0 || s.compare_insensitive("+nan") == 0) - return llvm::APFloat::getNaN(fsem); - return {fsem, s}; - } - - /// Generate a raw literal value and store it in the rawVals vector. - template - void - genRawLit(const Fortran::evaluate::Scalar> - &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); - auto floatVal = - consAPFloat(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); - auto realVal = - consAPFloat(builder.getKindMap().getFloatSemantics(KIND), strReal); - val = builder.getFloatAttr(inInitializer->rawType, realVal); - inInitializer->rawVals.push_back(val); - auto imgVal = - consAPFloat(builder.getKindMap().getFloatSemantics(KIND), strImg); - val = builder.getFloatAttr(inInitializer->rawType, imgVal); - } - inInitializer->rawVals.push_back(val); - } - - /// Convert a scalar literal CHARACTER to IR. - template - ExtValue - genScalarLit(const Fortran::evaluate::Scalar> &value, - int64_t len) { - using ET = typename std::decay_t::value_type; - if constexpr (KIND == 1) { - assert(value.size() == static_cast(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}; - } - 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(value.size()); - mlir::ShapedType shape = mlir::RankedTensorType::get( - llvm::ArrayRef{size}, - mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8)); - auto denseAttr = mlir::DenseElementsAttr::get( - shape, llvm::ArrayRef{value.data(), value.size()}); - auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist()); - mlir::NamedAttribute dataAttr(denseTag, denseAttr); - auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size()); - mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len)); - llvm::SmallVector attrs = {dataAttr, sizeAttr}; - return builder.create( - getLoc(), llvm::ArrayRef{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. - - auto size = - converter.getKindMap().getCharacterBitsize(KIND) / 8 * value.size(); - llvm::StringRef strVal(reinterpret_cast(value.c_str()), size); - std::string globalName = fir::factory::uniqueCGIdent("cl", strVal); - fir::GlobalOp global = builder.getNamedGlobal(globalName); - if (!global) - global = builder.createGlobalConstant( - getLoc(), type, globalName, - [&](fir::FirOpBuilder &builder) { - fir::StringLitOp str = consLit(); - builder.create(getLoc(), str); - }, - builder.createLinkOnceLinkage()); - auto addr = builder.create(getLoc(), global.resultType(), - global.getSymbol()); - return fir::CharBoxValue{addr, lenp}; - } - - template - ExtValue genArrayLit( - const Fortran::evaluate::Constant> - &con) { - mlir::Location loc = getLoc(); - mlir::IndexType idxTy = builder.getIndexType(); - Fortran::evaluate::ConstantSubscript size = - Fortran::evaluate::GetSize(con.shape()); - if (size > std::numeric_limits::max()) - // llvm::SmallVector has limited size - TODO(getLoc(), "Creation of very large array constants"); - 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 lbounds; - llvm::SmallVector extents; - if (!inInitializer || !inInitializer->genRawVals) { - array = builder.create(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 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(con.At(subscripts), con.LEN())); - array = builder.create( - 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 rangeStartIdx; - uint64_t rangeSize = 0; - do { - if (inInitializer && inInitializer->genRawVals) { - genRawLit(con.At(subscripts)); - continue; - } - auto getElementVal = [&]() { - return builder.createConvert( - loc, eleTy, - fir::getBase(genScalarLit(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( - 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 rangeBounds; - llvm::SmallVector idx = createIdx(); - for (size_t i = 0; i < idx.size(); ++i) { - rangeBounds.push_back(rangeStartIdx[i] - .cast() - .getValue() - .getSExtValue()); - rangeBounds.push_back( - idx[i].cast().getValue().getSExtValue()); - } - array = builder.create( - loc, arrayTy, array, getElementVal(), - builder.getIndexVectorAttr(rangeBounds)); - rangeSize = 0; - } - } while (con.IncrementSubscripts(subscripts)); - return fir::ArrayBoxValue{array, extents, lbounds}; - } - } - fir::ExtendedValue genArrayLit( const Fortran::evaluate::Constant &con) { mlir::Location loc = getLoc(); @@ -1765,17 +1476,11 @@ ExtValue genval(const Fortran::evaluate::Constant> &con) { - if (con.Rank() > 0) - return genArrayLit(con); - std::optional>> - opt = con.GetScalarValue(); - assert(opt.has_value() && "constant has no value"); - if constexpr (TC == Fortran::common::TypeCategory::Character) { - return genScalarLit(opt.value(), con.LEN()); - } else { - return genScalarLit(opt.value()); - } + return Fortran::lower::IntrinsicConstantBuilder::gen( + builder, getLoc(), con, + /*outlineBigConstantsInReadOnlyMemory=*/!inInitializer); } + fir::ExtendedValue genval( const Fortran::evaluate::Constant &con) { if (con.Rank() > 0) @@ -3598,7 +3303,7 @@ fir::FirOpBuilder &builder; Fortran::lower::StatementContext &stmtCtx; Fortran::lower::SymMap &symMap; - InitializerData *inInitializer = nullptr; + bool inInitializer = false; bool useBoxArg = false; // expression lowered as argument }; } // namespace @@ -5725,8 +5430,18 @@ }; } - template - CC genarr(const Fortran::evaluate::Constant &x) { + template + CC genarr( + const Fortran::evaluate::Constant> &x) { + if (x.Rank() == 0) + return genScalarAndForwardValue(x); + return genarr(Fortran::lower::IntrinsicConstantBuilder::gen( + builder, getLoc(), x, + /*outlineBigConstantsInReadOnlyMemory=*/true)); + } + + CC genarr( + const Fortran::evaluate::Constant &x) { if (x.Rank() == 0) return genScalarAndForwardValue(x); mlir::Location loc = getLoc(); @@ -5735,40 +5450,19 @@ 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().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()) - 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(loc, castTo); - }, - builder.createInternalLinkage()); + 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(loc, castTo); + }, + builder.createInternalLinkage()); } auto addr = builder.create(getLoc(), global.resultType(), global.getSymbol()); @@ -7701,40 +7395,13 @@ return ScalarExprLowering{loc, converter, symMap, stmtCtx}.genval(expr); } -fir::GlobalOp Fortran::lower::createDenseGlobal( - mlir::Location loc, mlir::Type symTy, llvm::StringRef globalName, - mlir::StringAttr linkage, bool isConst, - const Fortran::lower::SomeExpr &expr, - Fortran::lower::AbstractConverter &converter) { - - Fortran::lower::StatementContext stmtCtx(/*prohibited=*/true); - Fortran::lower::SymMap emptyMap; - InitializerData initData(/*genRawVals=*/true); - ScalarExprLowering sel(loc, converter, emptyMap, stmtCtx, - /*initializer=*/&initData); - sel.genval(expr); - - size_t sz = initData.rawVals.size(); - llvm::ArrayRef ar = {initData.rawVals.data(), sz}; - - mlir::RankedTensorType tensorTy; - auto &builder = converter.getFirOpBuilder(); - mlir::Type iTy = initData.rawType; - if (!iTy) - return 0; // array extent is probably 0 in this case, so just return 0. - tensorTy = mlir::RankedTensorType::get(sz, iTy); - auto init = mlir::DenseElementsAttr::get(tensorTy, ar); - return builder.createGlobal(loc, symTy, globalName, linkage, init, isConst); -} - fir::ExtendedValue Fortran::lower::createSomeInitializerExpression( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n'); - InitializerData initData; // needed for initializations return ScalarExprLowering{loc, converter, symMap, stmtCtx, - /*initializer=*/&initData} + /*inInitializer=*/true} .genval(expr); } @@ -7751,8 +7418,9 @@ const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "address: ") << '\n'); - InitializerData init; - return ScalarExprLowering(loc, converter, symMap, stmtCtx, &init).gen(expr); + return ScalarExprLowering(loc, converter, symMap, stmtCtx, + /*inInitializer=*/true) + .gen(expr); } void Fortran::lower::createSomeArrayAssignment( diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -15,6 +15,7 @@ #include "flang/Lower/Allocatable.h" #include "flang/Lower/BoxAnalyzer.h" #include "flang/Lower/CallInterface.h" +#include "flang/Lower/ConvertConstant.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/IntrinsicCall.h" #include "flang/Lower/Mangler.h" @@ -431,9 +432,9 @@ const auto *details = sym.detailsIf(); if (details->init()) { - global = Fortran::lower::createDenseGlobal( - loc, symTy, globalName, linkage, isConst, details->init().value(), - converter); + global = Fortran::lower::tryCreatingDenseGlobal( + builder, loc, symTy, globalName, linkage, isConst, + details->init().value()); if (global) { global.setVisibility(mlir::SymbolTable::Visibility::Public); return global; diff --git a/flang/test/Lower/array-substring.f90 b/flang/test/Lower/array-substring.f90 --- a/flang/test/Lower/array-substring.f90 +++ b/flang/test/Lower/array-substring.f90 @@ -6,7 +6,6 @@ ! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 0 : index ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 0 : i32 ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 8 : index -! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 8 : i64 ! CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#0 : (!fir.ref>) -> !fir.ref>> ! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.array<1x!fir.logical<4>> {bindc_name = "test", uniq_name = "_QFtestEtest"} @@ -27,7 +26,7 @@ ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_19]] : (!fir.ref>) -> !fir.ref ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_20]] : (!fir.ref>) -> !fir.ref ! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_4]] : (index) -> i64 -! CHECK: %[[VAL_24:.*]] = fir.call @_FortranACharacterCompareScalar1(%[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_5]]) : (!fir.ref, !fir.ref, i64, i64) -> i32 +! CHECK: %[[VAL_24:.*]] = fir.call @_FortranACharacterCompareScalar1(%[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_23]]) : (!fir.ref, !fir.ref, i64, i64) -> i32 ! CHECK: %[[VAL_25:.*]] = arith.cmpi eq, %[[VAL_24]], %[[VAL_3]] : i32 ! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i1) -> !fir.logical<4> ! CHECK: %[[VAL_27:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_9]]) %[[VAL_15]] : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref>