diff --git a/flang/include/flang/Optimizer/Builder/BoxValue.h b/flang/include/flang/Optimizer/Builder/BoxValue.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/BoxValue.h @@ -0,0 +1,472 @@ +//===-- BoxValue.h -- internal box values -----------------------*- 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/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_BOXVALUE_H +#define FORTRAN_OPTIMIZER_BUILDER_BOXVALUE_H + +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FatalError.h" +#include "flang/Optimizer/Support/Matcher.h" +#include "mlir/IR/OperationSupport.h" +#include "mlir/IR/Value.h" +#include "llvm/ADT/SmallVector.h" +#include "llvm/Support/Compiler.h" +#include "llvm/Support/raw_ostream.h" +#include + +namespace fir { +class CharBoxValue; +class ArrayBoxValue; +class CharArrayBoxValue; +class ProcBoxValue; +class MutableBoxValue; +class BoxValue; + +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharBoxValue &); +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArrayBoxValue &); +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharArrayBoxValue &); +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ProcBoxValue &); +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const MutableBoxValue &); +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &); + +//===----------------------------------------------------------------------===// +// +// Boxed values +// +// Define a set of containers used internally by the lowering bridge to keep +// track of extended values associated with a Fortran subexpression. These +// associations are maintained during the construction of FIR. +// +//===----------------------------------------------------------------------===// + +/// Most expressions of intrinsic type can be passed unboxed. Their properties +/// are known statically. +using UnboxedValue = mlir::Value; + +/// Abstract base class. +class AbstractBox { +public: + AbstractBox() = delete; + AbstractBox(mlir::Value addr) : addr{addr} {} + + /// FIXME: this comment is not true anymore since genLoad + /// is loading constant length characters. What is the impact /// ? + /// An abstract box always contains a memory reference to a value. + mlir::Value getAddr() const { return addr; } + +protected: + mlir::Value addr; +}; + +/// Expressions of CHARACTER type have an associated, possibly dynamic LEN +/// value. +class CharBoxValue : public AbstractBox { +public: + CharBoxValue(mlir::Value addr, mlir::Value len) + : AbstractBox{addr}, len{len} { + if (addr && addr.getType().template isa()) + fir::emitFatalError(addr.getLoc(), + "BoxChar should not be in CharBoxValue"); + } + + CharBoxValue clone(mlir::Value newBase) const { return {newBase, len}; } + + /// Convenience alias to get the memory reference to the buffer. + mlir::Value getBuffer() const { return getAddr(); } + + mlir::Value getLen() const { return len; } + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const CharBoxValue &); + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } + +protected: + mlir::Value len; +}; + +/// Abstract base class. +/// Expressions of type array have at minimum a shape. These expressions may +/// have lbound attributes (dynamic values) that affect the interpretation of +/// indexing expressions. +class AbstractArrayBox { +public: + AbstractArrayBox() = default; + AbstractArrayBox(llvm::ArrayRef extents, + llvm::ArrayRef lbounds) + : extents{extents.begin(), extents.end()}, lbounds{lbounds.begin(), + lbounds.end()} {} + + // Every array has extents that describe its shape. + const llvm::SmallVectorImpl &getExtents() const { + return extents; + } + + // An array expression may have user-defined lower bound values. + // If this vector is empty, the default in all dimensions in `1`. + const llvm::SmallVectorImpl &getLBounds() const { + return lbounds; + } + + bool lboundsAllOne() const { return lbounds.empty(); } + std::size_t rank() const { return extents.size(); } + +protected: + llvm::SmallVector extents; + llvm::SmallVector lbounds; +}; + +/// Expressions with rank > 0 have extents. They may also have lbounds that are +/// not 1. +class ArrayBoxValue : public AbstractBox, public AbstractArrayBox { +public: + ArrayBoxValue(mlir::Value addr, llvm::ArrayRef extents, + llvm::ArrayRef lbounds = {}) + : AbstractBox{addr}, AbstractArrayBox{extents, lbounds} {} + + ArrayBoxValue clone(mlir::Value newBase) const { + return {newBase, extents, lbounds}; + } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const ArrayBoxValue &); + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } +}; + +/// Expressions of type CHARACTER and with rank > 0. +class CharArrayBoxValue : public CharBoxValue, public AbstractArrayBox { +public: + CharArrayBoxValue(mlir::Value addr, mlir::Value len, + llvm::ArrayRef extents, + llvm::ArrayRef lbounds = {}) + : CharBoxValue{addr, len}, AbstractArrayBox{extents, lbounds} {} + + CharArrayBoxValue clone(mlir::Value newBase) const { + return {newBase, len, extents, lbounds}; + } + + CharBoxValue cloneElement(mlir::Value newBase) const { + return {newBase, len}; + } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const CharArrayBoxValue &); + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } +}; + +/// Expressions that are procedure POINTERs may need a set of references to +/// variables in the host scope. +class ProcBoxValue : public AbstractBox { +public: + ProcBoxValue(mlir::Value addr, mlir::Value context) + : AbstractBox{addr}, hostContext{context} {} + + ProcBoxValue clone(mlir::Value newBase) const { + return {newBase, hostContext}; + } + + mlir::Value getHostContext() const { return hostContext; } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const ProcBoxValue &); + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } + +protected: + mlir::Value hostContext; +}; + +/// Base class for values associated to a fir.box or fir.ref. +class AbstractIrBox : public AbstractBox, public AbstractArrayBox { +public: + AbstractIrBox(mlir::Value addr) : AbstractBox{addr} {} + AbstractIrBox(mlir::Value addr, llvm::ArrayRef lbounds, + llvm::ArrayRef extents) + : AbstractBox{addr}, AbstractArrayBox(extents, lbounds) {} + /// Get the fir.box part of the address type. + fir::BoxType getBoxTy() const { + auto type = getAddr().getType(); + if (auto pointedTy = fir::dyn_cast_ptrEleTy(type)) + type = pointedTy; + return type.cast(); + } + /// Return the part of the address type after memory and box types. That is + /// the element type, maybe wrapped in a fir.array type. + mlir::Type getBaseTy() const { + return fir::dyn_cast_ptrOrBoxEleTy(getBoxTy()); + } + + /// Return the memory type of the data address inside the box: + /// - for fir.box>, return fir.ptr + /// - for fir.box>, return fir.heap + /// - for fir.box, return fir.ref + mlir::Type getMemTy() const { + auto ty = getBoxTy().getEleTy(); + if (fir::isa_ref_type(ty)) + return ty; + return fir::ReferenceType::get(ty); + } + + /// Get the scalar type related to the described entity + mlir::Type getEleTy() const { + auto type = getBaseTy(); + if (auto seqTy = type.dyn_cast()) + return seqTy.getEleTy(); + return type; + } + + /// Is the entity an array or an assumed rank ? + bool hasRank() const { return getBaseTy().isa(); } + /// Is this an assumed rank ? + bool hasAssumedRank() const { + auto seqTy = getBaseTy().dyn_cast(); + return seqTy && seqTy.hasUnknownShape(); + } + /// Returns the rank of the entity. Beware that zero will be returned for + /// both scalars and assumed rank. + unsigned rank() const { + if (auto seqTy = getBaseTy().dyn_cast()) + return seqTy.getDimension(); + return 0; + } + /// Is this a character entity ? + bool isCharacter() const { return fir::isa_char(getEleTy()); }; + /// Is this a derived type entity ? + bool isDerived() const { return getEleTy().isa(); }; + + bool isDerivedWithLengthParameters() const { + auto record = getEleTy().dyn_cast(); + return record && record.getNumLenParams() != 0; + }; + /// Is this a CLASS(*)/TYPE(*) ? + bool isUnlimitedPolymorphic() const { + return getEleTy().isa(); + } +}; + +/// An entity described by a fir.box value that cannot be read into +/// another ExtendedValue category, either because the fir.box may be an +/// absent optional and we need to wait until the user is referencing it +/// to read it, or because it contains important information that cannot +/// be exposed in FIR (e.g. non contiguous byte stride). +/// It may also store explicit bounds or length parameters that were specified +/// for the entity. +class BoxValue : public AbstractIrBox { +public: + BoxValue(mlir::Value addr) : AbstractIrBox{addr} { assert(verify()); } + BoxValue(mlir::Value addr, llvm::ArrayRef lbounds, + llvm::ArrayRef explicitParams, + llvm::ArrayRef explicitExtents = {}) + : AbstractIrBox{addr, lbounds, explicitExtents}, + explicitParams{explicitParams.begin(), explicitParams.end()} { + assert(verify()); + } + // TODO: check contiguous attribute of addr + bool isContiguous() const { return false; } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &); + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } + + llvm::ArrayRef getLBounds() const { return lbounds; } + + // The extents member is not guaranteed to be field for arrays. It is only + // guaranteed to be field for explicit shape arrays. In general, + // explicit-shape will not come as descriptors, so this field will be empty in + // most cases. The exception are derived types with length parameters and + // polymorphic dummy argument arrays. It may be possible for the explicit + // extents to conflict with the shape information that is in the box according + // to 15.5.2.11 sequence association rules. + llvm::ArrayRef getExplicitExtents() const { return extents; } + + llvm::ArrayRef getExplicitParameters() const { + return explicitParams; + } + +protected: + // Verify constructor invariants. + bool verify() const; + + // Only field when the BoxValue has explicit length parameters. + // Otherwise, the length parameters are in the fir.box. + llvm::SmallVector explicitParams; +}; + +/// Set of variables (addresses) holding the allocatable properties. These may +/// be empty in case it is not deemed safe to duplicate the descriptor +/// information locally (For instance, a volatile allocatable will always be +/// lowered to a descriptor to preserve the integrity of the entity and its +/// associated properties. As such, all references to the entity and its +/// property will go through the descriptor explicitly.). +class MutableProperties { +public: + bool isEmpty() const { return !addr; } + mlir::Value addr; + llvm::SmallVector extents; + llvm::SmallVector lbounds; + /// Only keep track of the deferred length parameters through variables, since + /// they are the only ones that can change as per the deferred type parameters + /// definition in F2018 standard section 3.147.12.2. + /// Non-deferred values are returned by + /// MutableBoxValue.nonDeferredLenParams(). + llvm::SmallVector deferredParams; +}; + +/// MutableBoxValue is used for entities that are represented by the address of +/// a box. This is intended to be used for entities whose base address, shape +/// and type are not constant in the entity lifetime (e.g Allocatables and +/// Pointers). +class MutableBoxValue : public AbstractIrBox { +public: + /// Create MutableBoxValue given the address \p addr of the box and the non + /// deferred length parameters \p lenParameters. The non deferred length + /// parameters must always be provided, even if they are constant and already + /// reflected in the address type. + MutableBoxValue(mlir::Value addr, mlir::ValueRange lenParameters, + MutableProperties mutableProperties) + : AbstractIrBox(addr), lenParams{lenParameters.begin(), + lenParameters.end()}, + mutableProperties{mutableProperties} { + // Currently only accepts fir.(ref/ptr/heap)> mlir::Value for + // the address. This may change if we accept + // fir.(ref/ptr/heap)> for scalar without length parameters. + assert(verify() && + "MutableBoxValue requires mem ref to fir.box>"); + } + /// Is this a Fortran pointer ? + bool isPointer() const { + return getBoxTy().getEleTy().isa(); + } + /// Is this an allocatable ? + bool isAllocatable() const { + return getBoxTy().getEleTy().isa(); + } + /// Does this entity has any non deferred length parameters ? + bool hasNonDeferredLenParams() const { return !lenParams.empty(); } + /// Return the non deferred length parameters. + llvm::ArrayRef nonDeferredLenParams() const { return lenParams; } + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const MutableBoxValue &); + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; } + + /// Set of variable is used instead of a descriptor to hold the entity + /// properties instead of a fir.ref>. + bool isDescribedByVariables() const { return !mutableProperties.isEmpty(); } + + const MutableProperties &getMutableProperties() const { + return mutableProperties; + } + +protected: + /// Validate the address type form in the constructor. + bool verify() const; + /// Hold the non-deferred length parameter values (both for characters and + /// derived). Non-deferred length parameters cannot change dynamically, as + /// opposed to deferred type parameters (3.147.12.2). + llvm::SmallVector lenParams; + /// Set of variables holding the extents, lower bounds and + /// base address when it is deemed safe to work with these variables rather + /// than directly with a descriptor. + MutableProperties mutableProperties; +}; + +class ExtendedValue; + +/// Get the base value of an extended value. Every type of extended value has a +/// base value or is null. +mlir::Value getBase(const ExtendedValue &exv); + +/// Get the LEN property value of an extended value. CHARACTER values have a LEN +/// property. +mlir::Value getLen(const ExtendedValue &exv); + +/// Pretty-print an extended value. +llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExtendedValue &); + +/// Return a clone of the extended value `exv` with the base value `base` +/// substituted. +ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base); + +/// Is the extended value `exv` an array? +bool isArray(const ExtendedValue &exv); + +/// Get the type parameters for `exv`. +llvm::SmallVector getTypeParams(const ExtendedValue &exv); + +/// An extended value is a box of values pertaining to a discrete entity. It is +/// used in lowering to track all the runtime values related to an entity. For +/// example, an entity may have an address in memory that contains its value(s) +/// as well as various attribute values that describe the shape and starting +/// indices if it is an array entity. +class ExtendedValue : public details::matcher { +public: + using VT = + std::variant; + + ExtendedValue() : box{UnboxedValue{}} {} + template , ExtendedValue>>> + constexpr ExtendedValue(A &&a) : box{std::forward(a)} { + if (const auto *b = getUnboxed()) { + if (*b) { + auto type = b->getType(); + if (type.template isa()) + fir::emitFatalError(b->getLoc(), "BoxChar should be unboxed"); + if (auto refType = type.template dyn_cast()) + type = refType.getEleTy(); + if (auto seqType = type.template dyn_cast()) + type = seqType.getEleTy(); + if (fir::isa_char(type)) + fir::emitFatalError(b->getLoc(), + "character buffer should be in CharBoxValue"); + } + } + } + + template + constexpr const A *getBoxOf() const { + return std::get_if(&box); + } + + constexpr const CharBoxValue *getCharBox() const { + return getBoxOf(); + } + + constexpr const UnboxedValue *getUnboxed() const { + return getBoxOf(); + } + + unsigned rank() const { + return match([](const fir::UnboxedValue &box) -> unsigned { return 0; }, + [](const fir::CharBoxValue &box) -> unsigned { return 0; }, + [](const fir::ProcBoxValue &box) -> unsigned { return 0; }, + [](const auto &box) -> unsigned { return box.rank(); }); + } + + /// LLVM style debugging of extended values + LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; } + + friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, + const ExtendedValue &); + + const VT &matchee() const { return box; } + +private: + VT box; +}; + +/// Is the extended value `exv` unboxed and non-null? +inline bool isUnboxedValue(const ExtendedValue &exv) { + return exv.match( + [](const fir::UnboxedValue &box) { return box ? true : false; }, + [](const auto &) { return false; }); +} +} // namespace fir + +#endif // FORTRAN_OPTIMIZER_BUILDER_BOXVALUE_H \ No newline at end of file diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/Character.h @@ -0,0 +1,193 @@ +//===-- Character.h -- lowering of characters -------------------*- 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/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_CHARACTER_H +#define FORTRAN_OPTIMIZER_BUILDER_CHARACTER_H + +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" + +namespace fir::factory { + +/// Helper to facilitate lowering of CHARACTER in FIR. +class CharacterExprHelper { +public: + /// Constructor. + explicit CharacterExprHelper(FirOpBuilder &builder, mlir::Location loc) + : builder{builder}, loc{loc} {} + CharacterExprHelper(const CharacterExprHelper &) = delete; + + /// Copy the \p count first characters of \p src into \p dest. + /// \p count can have any integer type. + void createCopy(const fir::CharBoxValue &dest, const fir::CharBoxValue &src, + mlir::Value count); + + /// Set characters of \p str at position [\p lower, \p upper) to blanks. + /// \p lower and \upper bounds are zero based. + /// If \p upper <= \p lower, no padding is done. + /// \p upper and \p lower can have any integer type. + void createPadding(const fir::CharBoxValue &str, mlir::Value lower, + mlir::Value upper); + + /// Create str(lb:ub), lower bounds must always be specified, upper + /// bound is optional. + fir::CharBoxValue createSubstring(const fir::CharBoxValue &str, + llvm::ArrayRef bounds); + + /// Return blank character of given \p type !fir.char + mlir::Value createBlankConstant(fir::CharacterType type); + + /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters. + /// It handles cases where \p lhs and \p rhs may overlap. + void createAssign(const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); + + /// Create lhs // rhs in temp obtained with fir.alloca + fir::CharBoxValue createConcatenate(const fir::CharBoxValue &lhs, + const fir::CharBoxValue &rhs); + + /// LEN_TRIM intrinsic. + mlir::Value createLenTrim(const fir::CharBoxValue &str); + + /// Embox \p addr and \p len and return fir.boxchar. + /// Take care of type conversions before emboxing. + /// \p len is converted to the integer type for character lengths if needed. + mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len); + /// Create a fir.boxchar for \p str. If \p str is not in memory, a temp is + /// allocated to create the fir.boxchar. + mlir::Value createEmbox(const fir::CharBoxValue &str); + /// Embox a string array. Note that the size/shape of the array is not + /// retrievable from the resulting mlir::Value. + mlir::Value createEmbox(const fir::CharArrayBoxValue &str); + + /// Convert character array to a scalar by reducing the extents into the + /// length. Will fail if call on non reference like base. + fir::CharBoxValue toScalarCharacter(const fir::CharArrayBoxValue &); + + /// Unbox \p boxchar into (fir.ref>, character length type). + std::pair createUnboxChar(mlir::Value boxChar); + + /// Allocate a temp of fir::CharacterType type and length len. + /// Returns related fir.ref>>. + fir::CharBoxValue createCharacterTemp(mlir::Type type, mlir::Value len); + + /// Allocate a temp of compile time constant length. + /// Returns related fir.ref>>. + fir::CharBoxValue createCharacterTemp(mlir::Type type, int len); + + /// Create a temporary with the same kind, length, and value as source. + fir::CharBoxValue createTempFrom(const fir::ExtendedValue &source); + + /// Return true if \p type is a character literal type (is + /// `fir.array>`).; + static bool isCharacterLiteral(mlir::Type type); + + /// Return true if \p type is one of the following type + /// - fir.boxchar + /// - fir.ref> + /// - fir.char + static bool isCharacterScalar(mlir::Type type); + + /// Does this extended value base type is fir.char + /// where len is not the unknown extent ? + static bool hasConstantLengthInType(const fir::ExtendedValue &); + + /// Extract the kind of a character type + static fir::KindTy getCharacterKind(mlir::Type type); + + /// Extract the kind of a character or array of character type. + static fir::KindTy getCharacterOrSequenceKind(mlir::Type type); + + /// Determine the base character type + static fir::CharacterType getCharacterType(mlir::Type type); + static fir::CharacterType getCharacterType(const fir::CharBoxValue &box); + static fir::CharacterType getCharacterType(mlir::Value str); + + /// Create an extended value from a value of type: + /// - fir.boxchar + /// - fir.ref> + /// - fir.char + /// or the array versions: + /// - fir.ref>> + /// - fir.array> + /// + /// Does the heavy lifting of converting the value \p character (along with an + /// optional \p len value) to an extended value. If \p len is null, a length + /// value is extracted from \p character (or its type). This will produce an + /// error if it's not possible. The returned value is a CharBoxValue if \p + /// character is a scalar, otherwise it is a CharArrayBoxValue. + fir::ExtendedValue toExtendedValue(mlir::Value character, + mlir::Value len = {}); + + /// Is `type` a sequence (array) of CHARACTER type? Return true for any of the + /// following cases: + /// - !fir.array> + /// - !fir.ref where T is either of the first case + /// - !fir.box where T is either of the first case + /// + /// In certain contexts, Fortran allows an array of CHARACTERs to be treated + /// as if it were one longer CHARACTER scalar, each element append to the + /// previous. + static bool isArray(mlir::Type type); + + /// Temporary helper to help migrating towards properties of + /// ExtendedValue containing characters. + /// Mainly, this ensure that characters are always CharArrayBoxValue, + /// CharBoxValue, or BoxValue and that the base address is not a boxchar. + /// Return the argument if this is not a character. + /// TODO: Create and propagate ExtendedValue according to properties listed + /// above instead of fixing it when needed. + fir::ExtendedValue cleanUpCharacterExtendedValue(const fir::ExtendedValue &); + + /// Create fir.char singleton from \p code integer value. + mlir::Value createSingletonFromCode(mlir::Value code, int kind); + /// Returns integer value held in a character singleton. + mlir::Value extractCodeFromSingleton(mlir::Value singleton); + + /// Create a value for the length of a character based on its memory reference + /// that may be a boxchar, box or !fir.[ptr|ref|heap]>. If + /// the memref is a simple address and the length is not constant in type, the + /// returned length will be empty. + mlir::Value getLength(mlir::Value memref); + + /// Compute length given a fir.box describing a character entity. + /// It adjusts the length from the number of bytes per the descriptor + /// to the number of characters per the Fortran KIND. + mlir::Value readLengthFromBox(mlir::Value box); + +private: + /// FIXME: the implementation also needs a clean-up now that + /// CharBoxValue are better propagated. + fir::CharBoxValue materializeValue(mlir::Value str); + mlir::Value getCharBoxBuffer(const fir::CharBoxValue &box); + mlir::Value createElementAddr(mlir::Value buffer, mlir::Value index); + mlir::Value createLoadCharAt(mlir::Value buff, mlir::Value index); + void createStoreCharAt(mlir::Value str, mlir::Value index, mlir::Value c); + void createLengthOneAssign(const fir::CharBoxValue &lhs, + const fir::CharBoxValue &rhs); + void createAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs); + mlir::Value createBlankConstantCode(fir::CharacterType type); + +private: + FirOpBuilder &builder; + mlir::Location loc; +}; + +// FIXME: Move these to Optimizer +mlir::FuncOp getLlvmMemcpy(FirOpBuilder &builder); +mlir::FuncOp getLlvmMemmove(FirOpBuilder &builder); +mlir::FuncOp getLlvmMemset(FirOpBuilder &builder); +mlir::FuncOp getRealloc(FirOpBuilder &builder); + +} // namespace fir::factory + +#endif // FORTRAN_OPTIMIZER_BUILDER_CHARACTER_H diff --git a/flang/include/flang/Optimizer/Builder/DoLoopHelper.h b/flang/include/flang/Optimizer/Builder/DoLoopHelper.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/DoLoopHelper.h @@ -0,0 +1,49 @@ +//===-- DoLoopHelper.h -- gen fir.do_loop ops -------------------*- 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/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_DOLOOPHELPER_H +#define FORTRAN_OPTIMIZER_BUILDER_DOLOOPHELPER_H + +#include "flang/Optimizer/Builder/FIRBuilder.h" + +namespace fir::factory { + +/// Helper to build fir.do_loop Ops. +class DoLoopHelper { +public: + explicit DoLoopHelper(fir::FirOpBuilder &builder, mlir::Location loc) + : builder(builder), loc(loc) {} + DoLoopHelper(const DoLoopHelper &) = delete; + + /// Type of a callback to generate the loop body. + using BodyGenerator = std::function; + + /// Build loop [\p lb, \p ub] with step \p step. + /// If \p step is an empty value, 1 is used for the step. + void createLoop(mlir::Value lb, mlir::Value ub, mlir::Value step, + const BodyGenerator &bodyGenerator); + + /// Build loop [\p lb, \p ub] with step 1. + void createLoop(mlir::Value lb, mlir::Value ub, + const BodyGenerator &bodyGenerator); + + /// Build loop [0, \p count) with step 1. + void createLoop(mlir::Value count, const BodyGenerator &bodyGenerator); + +private: + fir::FirOpBuilder &builder; + mlir::Location loc; +}; + +} // namespace fir::factory + +#endif // FORTRAN_OPTIMIZER_BUILDER_DOLOOPHELPER_H diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -0,0 +1,472 @@ +//===-- FirBuilder.h -- FIR operation builder -------------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H +#define FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H + +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/KindMapping.h" +#include "mlir/IR/Builders.h" +#include "mlir/IR/BuiltinOps.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/Optional.h" + +namespace fir { +class AbstractArrayBox; +class ExtendedValue; +class BoxValue; + +//===----------------------------------------------------------------------===// +// FirOpBuilder +//===----------------------------------------------------------------------===// + +/// Extends the MLIR OpBuilder to provide methods for building common FIR +/// patterns. +class FirOpBuilder : public mlir::OpBuilder { +public: + explicit FirOpBuilder(mlir::Operation *op, const fir::KindMapping &kindMap) + : OpBuilder{op}, kindMap{kindMap} {} + explicit FirOpBuilder(mlir::OpBuilder &builder, + const fir::KindMapping &kindMap) + : OpBuilder{builder}, kindMap{kindMap} {} + + /// Get the current Region of the insertion point. + mlir::Region &getRegion() { return *getBlock()->getParent(); } + + /// Get the current Module + mlir::ModuleOp getModule() { + return getRegion().getParentOfType(); + } + + /// Get the current Function + mlir::FuncOp getFunction() { + return getRegion().getParentOfType(); + } + + /// Get a reference to the kind map. + const fir::KindMapping &getKindMap() { return kindMap; } + + /// The LHS and RHS are not always in agreement in terms of + /// type. In some cases, the disagreement is between COMPLEX and other scalar + /// types. In that case, the conversion must insert/extract out of a COMPLEX + /// value to have the proper semantics and be strongly typed. + mlir::Value convertWithSemantics(mlir::Location loc, mlir::Type toTy, + mlir::Value val); + + /// Get the entry block of the current Function + mlir::Block *getEntryBlock() { return &getFunction().front(); } + + /// Get the block for adding Allocas. If OpenMP is enabled then get the + /// the alloca block from an Operation which can be Outlined. Otherwise + /// use the entry block of the current Function + mlir::Block *getAllocaBlock(); + + /// Safely create a reference type to the type `eleTy`. + mlir::Type getRefType(mlir::Type eleTy); + + /// Create a sequence of `eleTy` with `rank` dimensions of unknown size. + mlir::Type getVarLenSeqTy(mlir::Type eleTy, unsigned rank = 1); + + /// Get character length type + mlir::Type getCharacterLengthType() { return getIndexType(); } + + /// Get the integer type whose bit width corresponds to the width of pointer + /// types, or is bigger. + mlir::Type getIntPtrType() { + // TODO: Delay the need of such type until codegen or find a way to use + // llvm::DataLayout::getPointerSizeInBits here. + return getI64Type(); + } + + /// Get the mlir real type that implements fortran REAL(kind). + mlir::Type getRealType(int kind); + + /// Create a null constant memory reference of type \p ptrType. + /// If \p ptrType is not provided, !fir.ref type will be used. + mlir::Value createNullConstant(mlir::Location loc, mlir::Type ptrType = {}); + + /// Create an integer constant of type \p type and value \p i. + mlir::Value createIntegerConstant(mlir::Location loc, mlir::Type integerType, + std::int64_t i); + + /// Create a real constant from an integer value. + mlir::Value createRealConstant(mlir::Location loc, mlir::Type realType, + llvm::APFloat::integerPart val); + + /// Create a real constant from an APFloat value. + mlir::Value createRealConstant(mlir::Location loc, mlir::Type realType, + const llvm::APFloat &val); + + /// Create a real constant of type \p realType with a value zero. + mlir::Value createRealZeroConstant(mlir::Location loc, mlir::Type realType) { + return createRealConstant(loc, realType, 0u); + } + + /// Create a slot for a local on the stack. Besides the variable's type and + /// shape, it may be given name, pinned, or target attributes. + mlir::Value allocateLocal(mlir::Location loc, mlir::Type ty, + llvm::StringRef uniqName, llvm::StringRef name, + bool pinned, llvm::ArrayRef shape, + llvm::ArrayRef lenParams, + bool asTarget = false); + mlir::Value allocateLocal(mlir::Location loc, mlir::Type ty, + llvm::StringRef uniqName, llvm::StringRef name, + llvm::ArrayRef shape, + llvm::ArrayRef lenParams, + bool asTarget = false); + + /// Create a temporary. A temp is allocated using `fir.alloca` and can be read + /// and written using `fir.load` and `fir.store`, resp. The temporary can be + /// given a name via a front-end `Symbol` or a `StringRef`. + mlir::Value createTemporary(mlir::Location loc, mlir::Type type, + llvm::StringRef name = {}, + mlir::ValueRange shape = {}, + mlir::ValueRange lenParams = {}, + llvm::ArrayRef attrs = {}); + + /// Create an unnamed and untracked temporary on the stack. + mlir::Value createTemporary(mlir::Location loc, mlir::Type type, + mlir::ValueRange shape) { + return createTemporary(loc, type, llvm::StringRef{}, shape); + } + + mlir::Value createTemporary(mlir::Location loc, mlir::Type type, + llvm::ArrayRef attrs) { + return createTemporary(loc, type, llvm::StringRef{}, {}, {}, attrs); + } + + mlir::Value createTemporary(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + llvm::ArrayRef attrs) { + return createTemporary(loc, type, name, {}, {}, attrs); + } + + /// Create a global value. + fir::GlobalOp createGlobal(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + mlir::StringAttr linkage = {}, + mlir::Attribute value = {}, bool isConst = false); + + fir::GlobalOp createGlobal(mlir::Location loc, mlir::Type type, + llvm::StringRef name, bool isConst, + std::function bodyBuilder, + mlir::StringAttr linkage = {}); + + /// Create a global constant (read-only) value. + fir::GlobalOp createGlobalConstant(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + mlir::StringAttr linkage = {}, + mlir::Attribute value = {}) { + return createGlobal(loc, type, name, linkage, value, /*isConst=*/true); + } + + fir::GlobalOp + createGlobalConstant(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + std::function bodyBuilder, + mlir::StringAttr linkage = {}) { + return createGlobal(loc, type, name, /*isConst=*/true, bodyBuilder, + linkage); + } + + /// Convert a StringRef string into a fir::StringLitOp. + fir::StringLitOp createStringLitOp(mlir::Location loc, + llvm::StringRef string); + + //===--------------------------------------------------------------------===// + // Linkage helpers (inline). The default linkage is external. + //===--------------------------------------------------------------------===// + + mlir::StringAttr createCommonLinkage() { return getStringAttr("common"); } + + mlir::StringAttr createInternalLinkage() { return getStringAttr("internal"); } + + mlir::StringAttr createLinkOnceLinkage() { return getStringAttr("linkonce"); } + + mlir::StringAttr createWeakLinkage() { return getStringAttr("weak"); } + + /// Get a function by name. If the function exists in the current module, it + /// is returned. Otherwise, a null FuncOp is returned. + mlir::FuncOp getNamedFunction(llvm::StringRef name) { + return getNamedFunction(getModule(), name); + } + + static mlir::FuncOp getNamedFunction(mlir::ModuleOp module, + llvm::StringRef name); + + fir::GlobalOp getNamedGlobal(llvm::StringRef name) { + return getNamedGlobal(getModule(), name); + } + + static fir::GlobalOp getNamedGlobal(mlir::ModuleOp module, + llvm::StringRef name); + + /// Lazy creation of fir.convert op. + mlir::Value createConvert(mlir::Location loc, mlir::Type toTy, + mlir::Value val); + + /// Create a new FuncOp. If the function may have already been created, use + /// `addNamedFunction` instead. + mlir::FuncOp createFunction(mlir::Location loc, llvm::StringRef name, + mlir::FunctionType ty) { + return createFunction(loc, getModule(), name, ty); + } + + static mlir::FuncOp createFunction(mlir::Location loc, mlir::ModuleOp module, + llvm::StringRef name, + mlir::FunctionType ty); + + /// Determine if the named function is already in the module. Return the + /// instance if found, otherwise add a new named function to the module. + mlir::FuncOp addNamedFunction(mlir::Location loc, llvm::StringRef name, + mlir::FunctionType ty) { + if (auto func = getNamedFunction(name)) + return func; + return createFunction(loc, name, ty); + } + + static mlir::FuncOp addNamedFunction(mlir::Location loc, + mlir::ModuleOp module, + llvm::StringRef name, + mlir::FunctionType ty) { + if (auto func = getNamedFunction(module, name)) + return func; + return createFunction(loc, module, name, ty); + } + + /// Cast the input value to IndexType. + mlir::Value convertToIndexType(mlir::Location loc, mlir::Value val) { + return createConvert(loc, getIndexType(), val); + } + + /// Construct one of the two forms of shape op from an array box. + mlir::Value genShape(mlir::Location loc, const fir::AbstractArrayBox &arr); + mlir::Value genShape(mlir::Location loc, llvm::ArrayRef shift, + llvm::ArrayRef exts); + mlir::Value genShape(mlir::Location loc, llvm::ArrayRef exts); + + /// Create one of the shape ops given an extended value. For a boxed value, + /// this may create a `fir.shift` op. + mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv); + + /// Create a slice op extended value. The value to be sliced, `exv`, must be + /// an array. + mlir::Value createSlice(mlir::Location loc, const fir::ExtendedValue &exv, + mlir::ValueRange triples, mlir::ValueRange path); + + /// Create a boxed value (Fortran descriptor) to be passed to the runtime. + /// \p exv is an extended value holding a memory reference to the object that + /// must be boxed. This function will crash if provided something that is not + /// a memory reference type. + /// Array entities are boxed with a shape and character with their length. + mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv); + + /// Create constant i1 with value 1. if \p b is true or 0. otherwise + mlir::Value createBool(mlir::Location loc, bool b) { + return createIntegerConstant(loc, getIntegerType(1), b ? 1 : 0); + } + + //===--------------------------------------------------------------------===// + // If-Then-Else generation helper + //===--------------------------------------------------------------------===// + + /// Helper class to create if-then-else in a structured way: + /// Usage: genIfOp().then([&](){...}).else([&](){...}).end(); + /// Alternatively, getResults() can be used instead of end() to end the ifOp + /// and get the ifOp results. + class IfBuilder { + public: + IfBuilder(fir::IfOp ifOp, FirOpBuilder &builder) + : ifOp{ifOp}, builder{builder} {} + template + IfBuilder &genThen(CC func) { + builder.setInsertionPointToStart(&ifOp.thenRegion().front()); + func(); + return *this; + } + template + IfBuilder &genElse(CC func) { + assert(!ifOp.elseRegion().empty() && "must have else region"); + builder.setInsertionPointToStart(&ifOp.elseRegion().front()); + func(); + return *this; + } + void end() { builder.setInsertionPointAfter(ifOp); } + + /// End the IfOp and return the results if any. + mlir::Operation::result_range getResults() { + end(); + return ifOp.getResults(); + } + + private: + fir::IfOp ifOp; + FirOpBuilder &builder; + }; + + /// Create an IfOp and returns an IfBuilder that can generate the else/then + /// bodies. + IfBuilder genIfOp(mlir::Location loc, mlir::TypeRange results, + mlir::Value cdt, bool withElseRegion) { + auto op = create(loc, results, cdt, withElseRegion); + return IfBuilder(op, *this); + } + + /// Create an IfOp with no "else" region, and no result values. + /// Usage: genIfThen(loc, cdt).genThen(lambda).end(); + IfBuilder genIfThen(mlir::Location loc, mlir::Value cdt) { + auto op = create(loc, llvm::None, cdt, false); + return IfBuilder(op, *this); + } + + /// Create an IfOp with an "else" region, and no result values. + /// Usage: genIfThenElse(loc, cdt).genThen(lambda).genElse(lambda).end(); + IfBuilder genIfThenElse(mlir::Location loc, mlir::Value cdt) { + auto op = create(loc, llvm::None, cdt, true); + return IfBuilder(op, *this); + } + + /// Generate code testing \p addr is not a null address. + mlir::Value genIsNotNull(mlir::Location loc, mlir::Value addr); + + /// Generate code testing \p addr is a null address. + mlir::Value genIsNull(mlir::Location loc, mlir::Value addr); + + /// Compute the extent of (lb:ub:step) as max((ub-lb+step)/step, 0). See + /// Fortran 2018 9.5.3.3.2 section for more details. + mlir::Value genExtentFromTriplet(mlir::Location loc, mlir::Value lb, + mlir::Value ub, mlir::Value step, + mlir::Type type); + +private: + const KindMapping &kindMap; +}; + +} // namespace fir + +namespace fir::factory { + +//===--------------------------------------------------------------------===// +// ExtendedValue inquiry helpers +//===--------------------------------------------------------------------===// + +/// Read or get character length from \p box that must contain a character +/// entity. If the length value is contained in the ExtendedValue, this will +/// not generate any code, otherwise this will generate a read of the fir.box +/// describing the entity. +mlir::Value readCharLen(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box); + +/// Read or get the extent in dimension \p dim of the array described by \p box. +mlir::Value readExtent(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box, unsigned dim); + +/// Read or get the lower bound in dimension \p dim of the array described by +/// \p box. If the lower bound is left default in the ExtendedValue, +/// \p defaultValue will be returned. +mlir::Value readLowerBound(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box, unsigned dim, + mlir::Value defaultValue); + +/// Read extents from \p box. +llvm::SmallVector readExtents(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::BoxValue &box); + +/// Get extents from \p box. For fir::BoxValue and +/// fir::MutableBoxValue, this will generate code to read the extents. +llvm::SmallVector getExtents(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &box); + +/// Read a fir::BoxValue into an fir::UnboxValue, a fir::ArrayBoxValue or a +/// fir::CharArrayBoxValue. This should only be called if the fir::BoxValue is +/// known to be contiguous given the context (or if the resulting address will +/// not be used). If the value is polymorphic, its dynamic type will be lost. +/// This must not be used on unlimited polymorphic and assumed rank entities. +fir::ExtendedValue readBoxValue(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::BoxValue &box); + +//===--------------------------------------------------------------------===// +// String literal helper helpers +//===--------------------------------------------------------------------===// + +/// Create a !fir.char<1> string literal global and returns a +/// fir::CharBoxValue with its address en length. +fir::ExtendedValue createStringLiteral(fir::FirOpBuilder &, mlir::Location, + llvm::StringRef string); + +/// Unique a compiler generated identifier. A short prefix should be provided +/// to hint at the origin of the identifier. +std::string uniqueCGIdent(llvm::StringRef prefix, llvm::StringRef name); + +/// Lowers the extents from the sequence type to Values. +/// Any unknown extents are lowered to undefined values. +llvm::SmallVector createExtents(fir::FirOpBuilder &builder, + mlir::Location loc, + fir::SequenceType seqTy); + +//===--------------------------------------------------------------------===// +// Location helpers +//===--------------------------------------------------------------------===// + +/// Generate a string literal containing the file name and return its address +mlir::Value locationToFilename(fir::FirOpBuilder &, mlir::Location); +/// Generate a constant of the given type with the location line number +mlir::Value locationToLineNo(fir::FirOpBuilder &, mlir::Location, mlir::Type); + +//===--------------------------------------------------------------------===// +// ExtendedValue helpers +//===--------------------------------------------------------------------===// + +/// Return the extended value for a component of a derived type instance given +/// the extended value \p obj of the derived type instance and the address of +/// the component. +fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value component); + +/// Given the address of an array element and the ExtendedValue describing the +/// array, returns the ExtendedValue describing the array element. The purpose +/// is to propagate the length parameters of the array to the element. +/// This can be used for elements of `array` or `array(i:j:k)`. If \p element +/// belongs to an array section `array%x` whose base is \p array, +/// arraySectionElementToExtendedValue must be used instead. +fir::ExtendedValue arrayElementToExtendedValue(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &array, + mlir::Value element); + +/// Build the ExtendedValue for \p element that is an element of an array or +/// array section with \p array base (`array` or `array(i:j:k)%x%y`). +/// If it is an array section, \p slice must be provided and be a fir::SliceOp +/// that describes the section. +fir::ExtendedValue arraySectionElementToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice); + +/// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived +/// types. The assignment follows Fortran intrinsic assignment semantic for +/// derived types (10.2.1.3 point 13). +void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); + +mlir::TupleType getRaggedArrayHeaderType(fir::FirOpBuilder &builder); + +} // namespace fir::factory + +#endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/MutableBox.h @@ -0,0 +1,138 @@ +//===-- MutableBox.h -- MutableBox utilities -----------------------------===// +// +// 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/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H +#define FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H + +#include "llvm/ADT/StringRef.h" + +namespace mlir { +class Value; +class ValueRange; +class Type; +class Location; +} // namespace mlir + +namespace fir { +class FirOpBuilder; +class MutableBoxValue; +class ExtendedValue; +} // namespace fir + +namespace fir::factory { + +/// Create a fir.box of type \p boxType that can be used to initialize an +/// allocatable variable. Initialization of such variable has to be done at the +/// beginning of the variable lifetime by storing the created box in the memory +/// for the variable box. +/// \p nonDeferredParams must provide the non deferred length parameters so that +/// they can already be placed in the unallocated box (inquiries about these +/// parameters are legal even in unallocated state). +mlir::Value createUnallocatedBox(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Type boxType, + mlir::ValueRange nonDeferredParams); + +/// Create a MutableBoxValue for a temporary allocatable. +/// The created MutableBoxValue wraps a fir.ref>> and is +/// initialized to unallocated/diassociated status. An optional name can be +/// given to the created !fir.ref. +fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type type, + llvm::StringRef name = {}); + +/// Update a MutableBoxValue to describe entity \p source (that must be in +/// memory). If \lbounds is not empty, it is used to defined the MutableBoxValue +/// lower bounds, otherwise, the lower bounds from \p source are used. +void associateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + const fir::ExtendedValue &source, + mlir::ValueRange lbounds); + +/// Update a MutableBoxValue to describe entity \p source (that must be in +/// memory) with a new array layout given by \p lbounds and \p ubounds. +/// \p source must be known to be contiguous at compile time, or it must have +/// rank 1 (constraint from Fortran 2018 standard 10.2.2.3 point 9). +void associateMutableBoxWithRemap(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + const fir::ExtendedValue &source, + mlir::ValueRange lbounds, + mlir::ValueRange ubounds); + +/// Set the association status of a MutableBoxValue to +/// disassociated/unallocated. Nothing is done with the entity that was +/// previously associated/allocated. The function generates code that sets the +/// address field of the MutableBoxValue to zero. +void disassociateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// Generate code to conditionally reallocate a MutableBoxValue with a new +/// shape, lower bounds, and length parameters if it is unallocated or if its +/// current shape or deferred length parameters do not match the provided ones. +/// Lower bounds are only used if the entity needs to be allocated, otherwise, +/// the MutableBoxValue will keep its current lower bounds. +/// If the MutableBoxValue is an array, the provided shape can be empty, in +/// which case the MutableBoxValue must already be allocated at runtime and its +/// shape and lower bounds will be kept. If \p shape is empty, only a length +/// parameter mismatch can trigger a reallocation. See Fortran 10.2.1.3 point 3 +/// that this function is implementing for more details. The polymorphic +/// requirements are not yet covered by this function. +void genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, mlir::ValueRange shape, + mlir::ValueRange lengthParams); + +/// Finalize a mutable box if it is allocated or associated. This includes both +/// calling the finalizer, if any, and deallocating the storage. +void genFinalization(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +void genInlinedAllocation(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, mlir::ValueRange extents, + mlir::ValueRange lenParams, + llvm::StringRef allocName); + +void genInlinedDeallocate(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// When the MutableBoxValue was passed as a fir.ref to a call that may +/// have modified it, update the MutableBoxValue according to the +/// fir.ref value. +void syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// Read all mutable properties into a normal symbol box. +/// It is OK to call this on unassociated/unallocated boxes but any use of the +/// resulting values will be undefined (only the base address will be guaranteed +/// to be null). +fir::ExtendedValue genMutableBoxRead(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + bool mayBePolymorphic = true); + +/// Returns the fir.ref> of a MutableBoxValue filled with the current +/// association / allocation properties. If the fir.ref already exists +/// and is-up to date, this is a no-op, otherwise, code will be generated to +/// fill the it. +mlir::Value getMutableIRBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// Generate allocation or association status test and returns the resulting +/// i1. This is testing this for a valid/non-null base address value. +mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box); + +} // namespace fir::factory + +#endif // FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h @@ -0,0 +1,32 @@ +//===-- Assign.h - generate assignment runtime API calls ----*- 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 +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H +#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H + +namespace mlir { +class Value; +class Location; +} // namespace mlir + +namespace fir { +class FirOpBuilder; +} // namespace fir + +namespace fir::runtime { + +/// Generate runtime call to assign \p sourceBox to \p destBox. +/// \p destBox must be a fir.ref> and \p sourceBox a fir.box. +/// \p destBox Fortran descriptor may be modified if destBox is an allocatable +/// according to Fortran allocatable assignment rules, otherwise it is not +/// modified. +void genAssign(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value destBox, mlir::Value sourceBox); + +} // namespace fir::runtime +#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h @@ -0,0 +1,407 @@ +//===-- RTBuilder.h ---------------------------------------------*- 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 +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// This file defines some C++17 template classes that are used to convert the +/// signatures of plain old C functions into a model that can be used to +/// generate MLIR calls to those functions. This can be used to autogenerate +/// tables at compiler compile-time to call runtime support code. +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_RTBUILDER_H +#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_RTBUILDER_H + +#include "flang/Common/Fortran.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "mlir/IR/BuiltinTypes.h" +#include "mlir/IR/MLIRContext.h" +#include "llvm/ADT/SmallVector.h" +#include + +// Incomplete type indicating C99 complex ABI in interfaces. Beware, _Complex +// and std::complex are layout compatible, but not compatible in all ABI call +// interface (e.g. X86 32 bits). _Complex is not standard C++, so do not use +// it here. +struct c_float_complex_t; +struct c_double_complex_t; + +namespace Fortran::runtime { +class Descriptor; +} // namespace Fortran::runtime + +namespace fir::runtime { + +using TypeBuilderFunc = mlir::Type (*)(mlir::MLIRContext *); +using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *); + +//===----------------------------------------------------------------------===// +// Type builder models +//===----------------------------------------------------------------------===// + +// TODO: all usages of sizeof in this file assume build == host == target. +// This will need to be re-visited for cross compilation. + +/// Return a function that returns the type signature model for the type `T` +/// when provided an MLIRContext*. This allows one to translate C(++) function +/// signatures from runtime header files to MLIR signatures into a static table +/// at compile-time. +/// +/// For example, when `T` is `int`, return a function that returns the MLIR +/// standard type `i32` when `sizeof(int)` is 4. +template +static constexpr TypeBuilderFunc getModel(); +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(short int)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(int)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ReferenceType::get(mlir::IntegerType::get(context, 8)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ReferenceType::get(mlir::IntegerType::get(context, 16)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ReferenceType::get(mlir::IntegerType::get(context, 32)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(signed char)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::LLVMPointerType::get(mlir::IntegerType::get(context, 8)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ReferenceType::get( + fir::LLVMPointerType::get(mlir::IntegerType::get(context, 8))); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(long)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(std::size_t)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(unsigned long)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(unsigned long long)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::FloatType::getF64(context); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::FloatType::getF32(context); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 1); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + TypeBuilderFunc f{getModel()}; + return fir::ReferenceType::get(f(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel &>() { + return [](mlir::MLIRContext *context) -> mlir::Type { + auto ty = mlir::ComplexType::get(mlir::FloatType::getF32(context)); + return fir::ReferenceType::get(ty); + }; +} +template <> +constexpr TypeBuilderFunc getModel &>() { + return [](mlir::MLIRContext *context) -> mlir::Type { + auto ty = mlir::ComplexType::get(mlir::FloatType::getF64(context)); + return fir::ReferenceType::get(ty); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ComplexType::get(context, sizeof(float)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ComplexType::get(context, sizeof(double)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::BoxType::get(mlir::NoneType::get(context)); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return fir::ReferenceType::get( + fir::BoxType::get(mlir::NoneType::get(context))); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return getModel(); +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, + sizeof(Fortran::common::TypeCategory) * 8); + }; +} +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::NoneType::get(context); + }; +} + +template +struct RuntimeTableKey; +template +struct RuntimeTableKey { + static constexpr FuncTypeBuilderFunc getTypeModel() { + return [](mlir::MLIRContext *ctxt) { + TypeBuilderFunc ret = getModel(); + std::array args = {getModel()...}; + mlir::Type retTy = ret(ctxt); + llvm::SmallVector argTys; + for (auto f : args) + argTys.push_back(f(ctxt)); + return mlir::FunctionType::get(ctxt, argTys, {retTy}); + }; + } +}; + +//===----------------------------------------------------------------------===// +// Runtime table building (constexpr folded) +//===----------------------------------------------------------------------===// + +template +using RuntimeIdentifier = std::integer_sequence; + +namespace details { +template +static constexpr std::integer_sequence +concat(std::integer_sequence, std::integer_sequence) { + return {}; +} +template +static constexpr auto concat(std::integer_sequence, + std::integer_sequence, Cs...) { + return concat(std::integer_sequence{}, Cs{}...); +} +template +static constexpr std::integer_sequence concat(std::integer_sequence) { + return {}; +} +template +static constexpr auto filterZero(std::integer_sequence) { + if constexpr (a != 0) { + return std::integer_sequence{}; + } else { + return std::integer_sequence{}; + } +} +template +static constexpr auto filter(std::integer_sequence) { + if constexpr (sizeof...(b) > 0) { + return details::concat(filterZero(std::integer_sequence{})...); + } else { + return std::integer_sequence{}; + } +} +} // namespace details + +template +struct RuntimeTableEntry; +template +struct RuntimeTableEntry, RuntimeIdentifier> { + static constexpr FuncTypeBuilderFunc getTypeModel() { + return RuntimeTableKey::getTypeModel(); + } + static constexpr const char name[sizeof...(Cs) + 1] = {Cs..., '\0'}; +}; + +#undef E +#define E(L, I) (I < sizeof(L) / sizeof(*L) ? L[I] : 0) +#define QuoteKey(X) #X +#define ExpandAndQuoteKey(X) QuoteKey(X) +#define MacroExpandKey(X) \ + E(X, 0), E(X, 1), E(X, 2), E(X, 3), E(X, 4), E(X, 5), E(X, 6), E(X, 7), \ + E(X, 8), E(X, 9), E(X, 10), E(X, 11), E(X, 12), E(X, 13), E(X, 14), \ + E(X, 15), E(X, 16), E(X, 17), E(X, 18), E(X, 19), E(X, 20), E(X, 21), \ + E(X, 22), E(X, 23), E(X, 24), E(X, 25), E(X, 26), E(X, 27), E(X, 28), \ + E(X, 29), E(X, 30), E(X, 31), E(X, 32), E(X, 33), E(X, 34), E(X, 35), \ + E(X, 36), E(X, 37), E(X, 38), E(X, 39), E(X, 40), E(X, 41), E(X, 42), \ + E(X, 43), E(X, 44), E(X, 45), E(X, 46), E(X, 47), E(X, 48), E(X, 49) +#define ExpandKey(X) MacroExpandKey(QuoteKey(X)) +#define FullSeq(X) std::integer_sequence +#define AsSequence(X) decltype(fir::runtime::details::filter(FullSeq(X){})) +#define mkKey(X) \ + fir::runtime::RuntimeTableEntry, \ + AsSequence(X)> +#define mkRTKey(X) mkKey(RTNAME(X)) + +/// Get (or generate) the MLIR FuncOp for a given runtime function. Its template +/// argument is intended to be of the form: +/// Clients should add "using namespace Fortran::runtime" +/// in order to use this function. +template +static mlir::FuncOp getRuntimeFunc(mlir::Location loc, + fir::FirOpBuilder &builder) { + auto name = RuntimeEntry::name; + auto func = builder.getNamedFunction(name); + if (func) + return func; + auto funTy = RuntimeEntry::getTypeModel()(builder.getContext()); + func = builder.createFunction(loc, name, funTy); + func->setAttr("fir.runtime", builder.getUnitAttr()); + return func; +} + +namespace helper { +template +void createArguments(llvm::SmallVectorImpl &result, + fir::FirOpBuilder &builder, mlir::Location loc, + mlir::FunctionType fTy, A arg) { + result.emplace_back(builder.createConvert(loc, fTy.getInput(N), arg)); +} + +template +void createArguments(llvm::SmallVectorImpl &result, + fir::FirOpBuilder &builder, mlir::Location loc, + mlir::FunctionType fTy, A arg, As... args) { + result.emplace_back(builder.createConvert(loc, fTy.getInput(N), arg)); + createArguments(result, builder, loc, fTy, args...); +} +} // namespace helper + +/// Create a SmallVector of arguments for a runtime call. +template +llvm::SmallVector +createArguments(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::FunctionType fTy, As... args) { + llvm::SmallVector result; + helper::createArguments<0>(result, builder, loc, fTy, args...); + return result; +} + +} // namespace fir::runtime + +#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_RTBUILDER_H diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h --- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h +++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h @@ -61,9 +61,13 @@ /// Attribute to mark Fortran entities with the CONTIGUOUS attribute. constexpr llvm::StringRef getContiguousAttrName() { return "fir.contiguous"; } + /// Attribute to mark Fortran entities with the OPTIONAL attribute. constexpr llvm::StringRef getOptionalAttrName() { return "fir.optional"; } +/// Attribute to mark Fortran entities with the TARGET attribute. +static constexpr llvm::StringRef getTargetAttrName() { return "fir.target"; } + /// Tell if \p value is: /// - a function argument that has attribute \p attributeName /// - or, the result of fir.alloca/fir.allocamem op that has attribute \p diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -138,6 +138,22 @@ /// of unknown rank or type. bool isa_unknown_size_box(mlir::Type t); +/// Returns true iff `t` is a fir.char type and has an unknown length. +inline bool characterWithDynamicLen(mlir::Type t) { + if (auto charTy = t.dyn_cast()) + return charTy.hasDynamicLen(); + return false; +} + +/// Returns true iff `seqTy` has either an unknown shape or a non-constant shape +/// (where rank > 0). +inline bool sequenceWithNonConstantShape(fir::SequenceType seqTy) { + return seqTy.hasUnknownShape() || !seqTy.hasConstantShape(); +} + +/// Returns true iff the type `t` does not have a constant size. +bool hasDynamicSize(mlir::Type t); + /// If `t` is a SequenceType return its element type, otherwise return `t`. inline mlir::Type unwrapSequenceType(mlir::Type t) { if (auto seqTy = t.dyn_cast()) @@ -145,6 +161,12 @@ return t; } +inline mlir::Type unwrapRefType(mlir::Type t) { + if (auto eleTy = dyn_cast_ptrEleTy(t)) + return eleTy; + return t; +} + #ifndef NDEBUG // !fir.ptr and !fir.heap where X is !fir.ptr, !fir.heap, or !fir.ref // is undefined and disallowed. diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td --- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td +++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td @@ -224,6 +224,28 @@ }]; } +def fir_LLVMPointerType : FIR_Type<"LLVMPointer", "llvm_ptr"> { + let summary = "Like LLVM pointer type"; + + let description = [{ + A pointer type that does not have any of the constraints and semantics + of other FIR pointer types and that translates to llvm pointer types. + It is meant to implement indirection that cannot be expressed directly + in Fortran, but are needed to implement some Fortran features (e.g, + double indirections). + }]; + + let parameters = (ins "mlir::Type":$eleTy); + + let skipDefaultBuilders = 1; + + let builders = [ + TypeBuilderWithInferredContext<(ins "mlir::Type":$elementType), [{ + return Base::get(elementType.getContext(), elementType); + }]>, + ]; +} + def fir_PointerType : FIR_Type<"Pointer", "ptr"> { let summary = "Reference to a POINTER attribute type"; @@ -401,6 +423,12 @@ "mlir::Type":$eleTy), [{ return get(eleTy.getContext(), shape, eleTy, {}); }]>, + TypeBuilderWithInferredContext<(ins + "mlir::Type":$eleTy, + "size_t":$dimensions), [{ + llvm::SmallVector shape(dimensions, getUnknownExtent()); + return get(eleTy.getContext(), shape, eleTy, {}); + }]> ]; let extraClassDeclaration = [{ diff --git a/flang/include/flang/Optimizer/Support/Matcher.h b/flang/include/flang/Optimizer/Support/Matcher.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Support/Matcher.h @@ -0,0 +1,35 @@ +//===-- Optimizer/Support/Matcher.h -----------------------------*- 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/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_SUPPORT_MATCHER_H +#define FORTRAN_OPTIMIZER_SUPPORT_MATCHER_H + +#include + +// Boilerplate CRTP class for a simplified type-casing syntactic sugar. This +// lets one write pattern matchers using a more compact syntax. +namespace fir::details { +// clang-format off +template struct matches : Ts... { using Ts::operator()...; }; +template matches(Ts...) -> matches; +template struct matcher { + template auto match(Ts... ts) { + return std::visit(matches{ts...}, static_cast(this)->matchee()); + } + template auto match(Ts... ts) const { + return std::visit(matches{ts...}, static_cast(this)->matchee()); + } +}; +// clang-format on +} // namespace fir::details + +#endif // FORTRAN_OPTIMIZER_SUPPORT_MATCHER_H diff --git a/flang/include/flang/Optimizer/Transforms/Factory.h b/flang/include/flang/Optimizer/Transforms/Factory.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Transforms/Factory.h @@ -0,0 +1,256 @@ +//===-- Optimizer/Transforms/Factory.h --------------------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Templates to generate more complex code patterns in transformation passes. +// In transformation passes, front-end information such as is available in +// lowering is not available. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_TRANSFORMS_FACTORY_H +#define FORTRAN_OPTIMIZER_TRANSFORMS_FACTORY_H + +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "llvm/ADT/iterator_range.h" + +namespace mlir { +class Location; +class Value; +} // namespace mlir + +namespace fir::factory { + +constexpr llvm::StringRef attrFortranArrayOffsets() { + return "Fortran.offsets"; +} + +/// Generate a character copy with optimized forms. +/// +/// If the lengths are constant and equal, use load/store rather than a loop. +/// Otherwise, if the lengths are constant and the input is longer than the +/// output, generate a loop to move a truncated portion of the source to the +/// destination. Finally, if the lengths are runtime values or the destination +/// is longer than the source, move the entire source character and pad the +/// destination with spaces as needed. +template +void genCharacterCopy(mlir::Value src, mlir::Value srcLen, mlir::Value dst, + mlir::Value dstLen, B &builder, mlir::Location loc) { + auto srcTy = + fir::dyn_cast_ptrEleTy(src.getType()).template cast(); + auto dstTy = + fir::dyn_cast_ptrEleTy(dst.getType()).template cast(); + if (!srcLen && !dstLen && srcTy.getFKind() == dstTy.getFKind() && + srcTy.getLen() == dstTy.getLen()) { + // same size, so just use load and store + auto load = builder.template create(loc, src); + builder.template create(loc, load, dst); + return; + } + auto zero = builder.template create(loc, 0); + auto one = builder.template create(loc, 1); + auto toArrayTy = [&](fir::CharacterType ty) { + return fir::ReferenceType::get(fir::SequenceType::get( + fir::SequenceType::ShapeRef{fir::SequenceType::getUnknownExtent()}, + fir::CharacterType::getSingleton(ty.getContext(), ty.getFKind()))); + }; + auto toEleTy = [&](fir::ReferenceType ty) { + auto seqTy = ty.getEleTy().cast(); + return seqTy.getEleTy().cast(); + }; + auto toCoorTy = [&](fir::ReferenceType ty) { + return fir::ReferenceType::get(toEleTy(ty)); + }; + if (!srcLen && !dstLen && srcTy.getLen() >= dstTy.getLen()) { + auto upper = + builder.template create(loc, dstTy.getLen() - 1); + auto loop = builder.template create(loc, zero, upper, one); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(loop.getBody()); + auto csrcTy = toArrayTy(srcTy); + auto csrc = builder.template create(loc, csrcTy, src); + auto in = builder.template create( + loc, toCoorTy(csrcTy), csrc, loop.getInductionVar()); + auto load = builder.template create(loc, in); + auto cdstTy = toArrayTy(dstTy); + auto cdst = builder.template create(loc, cdstTy, dst); + auto out = builder.template create( + loc, toCoorTy(cdstTy), cdst, loop.getInductionVar()); + mlir::Value cast = + srcTy.getFKind() == dstTy.getFKind() + ? load.getResult() + : builder + .template create(loc, toEleTy(cdstTy), load) + .getResult(); + builder.template create(loc, cast, out); + builder.restoreInsertionPoint(insPt); + return; + } + auto minusOne = [&](mlir::Value v) -> mlir::Value { + return builder.template create( + loc, builder.template create(loc, one.getType(), v), + one); + }; + mlir::Value len = + dstLen + ? minusOne(dstLen) + : builder + .template create(loc, dstTy.getLen() - 1) + .getResult(); + auto loop = builder.template create(loc, zero, len, one); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(loop.getBody()); + mlir::Value slen = + srcLen + ? builder.template create(loc, one.getType(), srcLen) + .getResult() + : builder.template create(loc, srcTy.getLen()) + .getResult(); + auto cond = builder.template create( + loc, mlir::CmpIPredicate::slt, loop.getInductionVar(), slen); + auto ifOp = builder.template create(loc, cond, /*withElse=*/true); + builder.setInsertionPointToStart(&ifOp.thenRegion().front()); + auto csrcTy = toArrayTy(srcTy); + auto csrc = builder.template create(loc, csrcTy, src); + auto in = builder.template create( + loc, toCoorTy(csrcTy), csrc, loop.getInductionVar()); + auto load = builder.template create(loc, in); + auto cdstTy = toArrayTy(dstTy); + auto cdst = builder.template create(loc, cdstTy, dst); + auto out = builder.template create( + loc, toCoorTy(cdstTy), cdst, loop.getInductionVar()); + mlir::Value cast = + srcTy.getFKind() == dstTy.getFKind() + ? load.getResult() + : builder.template create(loc, toEleTy(cdstTy), load) + .getResult(); + builder.template create(loc, cast, out); + builder.setInsertionPointToStart(&ifOp.elseRegion().front()); + auto space = builder.template create( + loc, toEleTy(cdstTy), llvm::ArrayRef{' '}); + auto cdst2 = builder.template create(loc, cdstTy, dst); + auto out2 = builder.template create( + loc, toCoorTy(cdstTy), cdst2, loop.getInductionVar()); + builder.template create(loc, space, out2); + builder.restoreInsertionPoint(insPt); +} + +/// Get extents from fir.shape/fir.shape_shift op. Empty result if +/// \p shapeVal is empty or is a fir.shift. +inline std::vector getExtents(mlir::Value shapeVal) { + if (shapeVal) + if (auto *shapeOp = shapeVal.getDefiningOp()) { + if (auto shOp = mlir::dyn_cast(shapeOp)) + return shOp.getExtents(); + if (auto shOp = mlir::dyn_cast(shapeOp)) + return shOp.getExtents(); + } + return {}; +} + +/// Get origins from fir.shape_shift/fir.shift op. Empty result if +/// \p shapeVal is empty or is a fir.shape. +inline std::vector getOrigins(mlir::Value shapeVal) { + if (shapeVal) + if (auto *shapeOp = shapeVal.getDefiningOp()) { + if (auto shOp = mlir::dyn_cast(shapeOp)) + return shOp.getOrigins(); + if (auto shOp = mlir::dyn_cast(shapeOp)) + return shOp.getOrigins(); + } + return {}; +} + +/// Convert the normalized indices on array_fetch and array_update to the +/// dynamic (and non-zero) origin required by array_coor. +/// Do not adjust any trailing components in the path as they specify a +/// particular path into the array value and must already correspond to the +/// structure of an element. +template +llvm::SmallVector +originateIndices(mlir::Location loc, B &builder, mlir::Type memTy, + mlir::Value shapeVal, mlir::ValueRange indices) { + llvm::SmallVector result; + auto origins = getOrigins(shapeVal); + if (origins.empty()) { + assert(!shapeVal || mlir::isa(shapeVal.getDefiningOp())); + auto ty = fir::dyn_cast_ptrOrBoxEleTy(memTy); + assert(ty && ty.isa()); + auto seqTy = ty.cast(); + auto one = builder.template create(loc, 1); + const auto dimension = seqTy.getDimension(); + if (shapeVal) { + assert(dimension == mlir::cast(shapeVal.getDefiningOp()) + .getType() + .getRank()); + } + for (auto i : llvm::enumerate(indices)) { + if (i.index() < dimension) { + assert(fir::isa_integer(i.value().getType())); + result.push_back( + builder.template create(loc, i.value(), one)); + } else { + result.push_back(i.value()); + } + } + return result; + } + const auto dimension = origins.size(); + unsigned origOff = 0; + for (auto i : llvm::enumerate(indices)) { + if (i.index() < dimension) + result.push_back(builder.template create( + loc, i.value(), origins[origOff++])); + else + result.push_back(i.value()); + } + return result; +} + +template +llvm::SmallVector createLoopNest( + mlir::Location loc, B &builder, llvm::iterator_range lows, + llvm::iterator_range highs, llvm::iterator_range steps, + llvm::ArrayRef threadedVals, bool unordered = false) { + llvm::SmallVector loops; + llvm::SmallVector inners(threadedVals.begin(), + threadedVals.end()); + for (auto iter0 = lows.begin(), iter1 = highs.begin(), iter2 = steps.begin(); + iter1 != highs.end(); ++iter0, ++iter1, ++iter2) { + auto lp = builder.template create( + loc, *iter0, *iter1, *iter2, unordered, + /*finalCount=*/false, inners); + loops.push_back(lp); + inners.assign(lp.getRegionIterArgs().begin(), lp.getRegionIterArgs().end()); + builder.setInsertionPointToStart(lp.getBody()); + } + auto numLoops = loops.size(); + for (decltype(numLoops) i = 0; i + 1 < numLoops; ++i) { + builder.setInsertionPointToEnd(loops[i].getBody()); + builder.template create(loc, loops[i + 1].getResults()); + } + builder.setInsertionPointAfter(loops[0]); + llvm::errs() << loops[0] << '\n'; + return loops; +} + +template +llvm::SmallVector createLoopNest( + mlir::Location loc, B &builder, llvm::ArrayRef lows, + llvm::ArrayRef highs, llvm::ArrayRef steps, + llvm::ArrayRef threadedVals, bool unordered = false) { + return createLoopNest( + loc, builder, llvm::make_range(lows.begin(), lows.end()), + llvm::make_range(highs.begin(), highs.end()), + llvm::make_range(steps.begin(), steps.end()), threadedVals, unordered); +} + +} // namespace fir::factory + +#endif // FORTRAN_OPTIMIZER_TRANSFORMS_FACTORY_H diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h --- a/flang/include/flang/Optimizer/Transforms/Passes.h +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -22,6 +22,7 @@ namespace fir { +std::unique_ptr createArrayValueCopyPass(); std::unique_ptr createExternalNameConversionPass(); /// Support for inlining on FIR. diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -16,6 +16,28 @@ include "mlir/Pass/PassBase.td" +def ArrayValueCopy : FunctionPass<"array-value-copy"> { + let summary = "Convert array value operations to memory operations."; + let description = [{ + Transform the set of array value primitives to a memory-based array + representation. + + The Ops `array_load`, `array_store`, `array_fetch`, and `array_update` are + used to manage abstract aggregate array values. A simple analysis is done + to determine if there are potential dependences between these operations. + If not, these array operations can be lowered to work directly on the memory + representation. If there is a potential conflict, a temporary is created + along with appropriate copy-in/copy-out operations. Here, a more refined + analysis might be deployed, such as using the affine framework. + + This pass is required before code gen to the LLVM IR dialect. + }]; + let constructor = "::fir::createArrayValueCopyPass()"; + let dependentDialects = [ + "fir::FIROpsDialect", "mlir::StandardOpsDialect" + ]; +} + def ExternalNameConversion : Pass<"external-name-interop", "mlir::ModuleOp"> { let summary = "Convert name for external interoperability"; let description = [{ diff --git a/flang/lib/Optimizer/Builder/BoxValue.cpp b/flang/lib/Optimizer/Builder/BoxValue.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/BoxValue.cpp @@ -0,0 +1,228 @@ +//===-- BoxValue.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 +// +//===----------------------------------------------------------------------===// +// +// Pretty printers for box values, etc. +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/BoxValue.h" +#include "mlir/IR/BuiltinTypes.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-box-value" + +mlir::Value fir::getBase(const fir::ExtendedValue &exv) { + return exv.match([](const fir::UnboxedValue &x) { return x; }, + [](const auto &x) { return x.getAddr(); }); +} + +mlir::Value fir::getLen(const fir::ExtendedValue &exv) { + return exv.match( + [](const fir::CharBoxValue &x) { return x.getLen(); }, + [](const fir::CharArrayBoxValue &x) { return x.getLen(); }, + [](const fir::BoxValue &) -> mlir::Value { + llvm::report_fatal_error("Need to read len from BoxValue Exv"); + }, + [](const fir::MutableBoxValue &) -> mlir::Value { + llvm::report_fatal_error("Need to read len from MutableBoxValue Exv"); + }, + [](const auto &) { return mlir::Value{}; }); +} + +fir::ExtendedValue fir::substBase(const fir::ExtendedValue &exv, + mlir::Value base) { + return exv.match( + [=](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); }, + [=](const fir::BoxValue &) -> fir::ExtendedValue { + llvm::report_fatal_error("TODO: substbase of BoxValue"); + }, + [=](const fir::MutableBoxValue &) -> fir::ExtendedValue { + llvm::report_fatal_error("TODO: substbase of MutableBoxValue"); + }, + [=](const auto &x) { return fir::ExtendedValue(x.clone(base)); }); +} + +llvm::SmallVector fir::getTypeParams(const ExtendedValue &exv) { + using RT = llvm::SmallVector; + auto baseTy = fir::getBase(exv).getType(); + if (auto t = fir::dyn_cast_ptrEleTy(baseTy)) + baseTy = t; + baseTy = fir::unwrapSequenceType(baseTy); + if (!fir::hasDynamicSize(baseTy)) + return {}; // type has constant size, no type parameters needed + [[maybe_unused]] auto loc = fir::getBase(exv).getLoc(); + return exv.match( + [](const fir::CharBoxValue &x) -> RT { return {x.getLen()}; }, + [](const fir::CharArrayBoxValue &x) -> RT { return {x.getLen()}; }, + [&](const fir::BoxValue &) -> RT { + LLVM_DEBUG(mlir::emitWarning( + loc, "TODO: box value is missing type parameters")); + return {}; + }, + [&](const fir::MutableBoxValue &) -> RT { + // In this case, the type params may be bound to the variable in an + // ALLOCATE statement as part of a type-spec. + LLVM_DEBUG(mlir::emitWarning( + loc, "TODO: mutable box value is missing type parameters")); + return {}; + }, + [](const auto &) -> RT { return {}; }); +} + +bool fir::isArray(const fir::ExtendedValue &exv) { + return exv.match( + [](const fir::ArrayBoxValue &) { return true; }, + [](const fir::CharArrayBoxValue &) { return true; }, + [](const fir::BoxValue &box) { return box.hasRank(); }, + [](const fir::MutableBoxValue &box) { return box.hasRank(); }, + [](auto) { return false; }); +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::CharBoxValue &box) { + return os << "boxchar { addr: " << box.getAddr() << ", len: " << box.getLen() + << " }"; +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::ArrayBoxValue &box) { + os << "boxarray { addr: " << box.getAddr(); + if (box.getLBounds().size()) { + os << ", lbounds: ["; + llvm::interleaveComma(box.getLBounds(), os); + os << "]"; + } else { + os << ", lbounds: all-ones"; + } + os << ", shape: ["; + llvm::interleaveComma(box.getExtents(), os); + return os << "]}"; +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::CharArrayBoxValue &box) { + os << "boxchararray { addr: " << box.getAddr() << ", len : " << box.getLen(); + if (box.getLBounds().size()) { + os << ", lbounds: ["; + llvm::interleaveComma(box.getLBounds(), os); + os << "]"; + } else { + os << " lbounds: all-ones"; + } + os << ", shape: ["; + llvm::interleaveComma(box.getExtents(), os); + return os << "]}"; +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::ProcBoxValue &box) { + return os << "boxproc: { procedure: " << box.getAddr() + << ", context: " << box.hostContext << "}"; +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::BoxValue &box) { + os << "box: { value: " << box.getAddr(); + if (box.lbounds.size()) { + os << ", lbounds: ["; + llvm::interleaveComma(box.lbounds, os); + os << "]"; + } + if (!box.explicitParams.empty()) { + os << ", explicit type params: ["; + llvm::interleaveComma(box.explicitParams, os); + os << "]"; + } + if (!box.extents.empty()) { + os << ", explicit extents: ["; + llvm::interleaveComma(box.extents, os); + os << "]"; + } + return os << "}"; +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::MutableBoxValue &box) { + os << "mutablebox: { addr: " << box.getAddr(); + if (!box.lenParams.empty()) { + os << ", non deferred type params: ["; + llvm::interleaveComma(box.lenParams, os); + os << "]"; + } + const auto &properties = box.mutableProperties; + if (!properties.isEmpty()) { + os << ", mutableProperties: { addr: " << properties.addr; + if (!properties.lbounds.empty()) { + os << ", lbounds: ["; + llvm::interleaveComma(properties.lbounds, os); + os << "]"; + } + if (!properties.extents.empty()) { + os << ", shape: ["; + llvm::interleaveComma(properties.extents, os); + os << "]"; + } + if (!properties.deferredParams.empty()) { + os << ", deferred type params: ["; + llvm::interleaveComma(properties.deferredParams, os); + os << "]"; + } + os << "}"; + } + return os << "}"; +} + +llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os, + const fir::ExtendedValue &exv) { + exv.match([&](const auto &value) { os << value; }); + return os; +} + +/// Debug verifier for MutableBox ctor. There is no guarantee that this will +/// always be called, so it should not have any functional side effects, +/// the const is here to enforce that. +bool fir::MutableBoxValue::verify() const { + auto type = fir::dyn_cast_ptrEleTy(getAddr().getType()); + if (!type) + return false; + auto box = type.dyn_cast(); + if (!box) + return false; + auto eleTy = box.getEleTy(); + if (!eleTy.isa() && !eleTy.isa()) + return false; + + auto nParams = lenParams.size(); + if (isCharacter()) { + if (nParams > 1) + return false; + } else if (!isDerived()) { + if (nParams != 0) + return false; + } + return true; +} + +/// Debug verifier for BoxValue ctor. There is no guarantee this will +/// always be called. +bool fir::BoxValue::verify() const { + if (!addr.getType().isa()) + return false; + if (!lbounds.empty() && lbounds.size() != rank()) + return false; + // Explicit extents are here to cover cases where an explicit-shape dummy + // argument comes as a fir.box. This can only happen with derived types and + // unlimited polymorphic. + if (!extents.empty() && !(isDerived() || isUnlimitedPolymorphic())) + return false; + if (!extents.empty() && extents.size() != rank()) + return false; + if (isCharacter() && explicitParams.size() > 1) + return false; + return true; +} diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -0,0 +1,19 @@ +get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS) +add_flang_library(FIRBuilder + BoxValue.cpp + Character.cpp + DoLoopHelper.cpp + FIRBuilder.cpp + MutableBox.cpp + Runtime/Assign.cpp + + DEPENDS + FIRDialect + FIRSupport + ${dialect_libs} + + LINK_LIBS + FIRDialect + FIRSupport + ${dialect_libs} +) diff --git a/flang/lib/Optimizer/Builder/Character.cpp b/flang/lib/Optimizer/Builder/Character.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/Character.cpp @@ -0,0 +1,723 @@ +//===-- Character.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/Optimizer/Builder/Character.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/DoLoopHelper.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-lower-character" + +//===----------------------------------------------------------------------===// +// CharacterExprHelper implementation +//===----------------------------------------------------------------------===// + +/// Unwrap base fir.char type. +static fir::CharacterType recoverCharacterType(mlir::Type type) { + if (auto boxType = type.dyn_cast()) + return boxType.getEleTy(); + while (true) { + type = fir::unwrapRefType(type); + if (auto boxTy = type.dyn_cast()) + type = boxTy.getEleTy(); + else + break; + } + return fir::unwrapSequenceType(type).cast(); +} + +/// Get fir.char type with the same kind as inside str. +fir::CharacterType +fir::factory::CharacterExprHelper::getCharacterType(mlir::Type type) { + assert(isCharacterScalar(type) && "expected scalar character"); + return recoverCharacterType(type); +} + +fir::CharacterType fir::factory::CharacterExprHelper::getCharacterType( + const fir::CharBoxValue &box) { + return getCharacterType(box.getBuffer().getType()); +} + +fir::CharacterType +fir::factory::CharacterExprHelper::getCharacterType(mlir::Value str) { + return getCharacterType(str.getType()); +} + +/// Determine the static size of the character. Returns the computed size, not +/// an IR Value. +static std::optional +getCompileTimeLength(const fir::CharBoxValue &box) { + auto len = recoverCharacterType(box.getBuffer().getType()).getLen(); + if (len == fir::CharacterType::unknownLen()) + return {}; + return len; +} + +/// Detect the precondition that the value `str` does not reside in memory. Such +/// values will have a type `!fir.array<...x!fir.char>` or `!fir.char`. +LLVM_ATTRIBUTE_UNUSED static bool needToMaterialize(mlir::Value str) { + return str.getType().isa() || fir::isa_char(str.getType()); +} + +/// Unwrap integer constant from mlir::Value. +static llvm::Optional getIntIfConstant(mlir::Value value) { + if (auto *definingOp = value.getDefiningOp()) + if (auto cst = mlir::dyn_cast(definingOp)) + if (auto intAttr = cst.getValue().dyn_cast()) + return intAttr.getInt(); + return {}; +} + +/// This is called only if `str` does not reside in memory. Such a bare string +/// value will be converted into a memory-based temporary and an extended +/// boxchar value returned. +fir::CharBoxValue +fir::factory::CharacterExprHelper::materializeValue(mlir::Value str) { + assert(needToMaterialize(str)); + auto ty = str.getType(); + assert(isCharacterScalar(ty) && "expected scalar character"); + auto charTy = ty.dyn_cast(); + if (!charTy || charTy.getLen() == fir::CharacterType::unknownLen()) { + LLVM_DEBUG(llvm::dbgs() << "cannot materialize: " << str << '\n'); + llvm_unreachable("must be a !fir.char type"); + } + auto len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), charTy.getLen()); + auto temp = builder.create(loc, charTy); + builder.create(loc, str, temp); + LLVM_DEBUG(llvm::dbgs() << "materialized as local: " << str << " -> (" << temp + << ", " << len << ")\n"); + return {temp, len}; +} + +fir::ExtendedValue +fir::factory::CharacterExprHelper::toExtendedValue(mlir::Value character, + mlir::Value len) { + auto lenType = builder.getCharacterLengthType(); + auto type = character.getType(); + auto base = fir::isa_passbyref_type(type) ? character : mlir::Value{}; + auto resultLen = len; + llvm::SmallVector extents; + + if (auto eleType = fir::dyn_cast_ptrEleTy(type)) + type = eleType; + + if (auto arrayType = type.dyn_cast()) { + type = arrayType.getEleTy(); + auto indexType = builder.getIndexType(); + for (auto extent : arrayType.getShape()) { + if (extent == fir::SequenceType::getUnknownExtent()) + break; + extents.emplace_back( + builder.createIntegerConstant(loc, indexType, extent)); + } + // Last extent might be missing in case of assumed-size. If more extents + // could not be deduced from type, that's an error (a fir.box should + // have been used in the interface). + if (extents.size() + 1 < arrayType.getShape().size()) + mlir::emitError(loc, "cannot retrieve array extents from type"); + } + + if (auto charTy = type.dyn_cast()) { + if (!resultLen && charTy.getLen() != fir::CharacterType::unknownLen()) + resultLen = builder.createIntegerConstant(loc, lenType, charTy.getLen()); + } else if (auto boxCharType = type.dyn_cast()) { + auto refType = builder.getRefType(boxCharType.getEleTy()); + // If the embox is accessible, use its operand to avoid filling + // the generated fir with embox/unbox. + mlir::Value boxCharLen; + if (auto *definingOp = character.getDefiningOp()) { + if (auto box = dyn_cast(definingOp)) { + base = box.memref(); + boxCharLen = box.len(); + } + } + if (!boxCharLen) { + auto unboxed = + builder.create(loc, refType, lenType, character); + base = builder.createConvert(loc, refType, unboxed.getResult(0)); + boxCharLen = unboxed.getResult(1); + } + if (!resultLen) { + resultLen = boxCharLen; + } + } else if (type.isa()) { + mlir::emitError(loc, "descriptor or derived type not yet handled"); + } else { + llvm_unreachable("Cannot translate mlir::Value to character ExtendedValue"); + } + + if (!base) { + if (auto load = + mlir::dyn_cast_or_null(character.getDefiningOp())) { + base = load.getOperand(); + } else { + return materializeValue(fir::getBase(character)); + } + } + if (!resultLen) + llvm::report_fatal_error("no dynamic length found for character"); + if (!extents.empty()) + return fir::CharArrayBoxValue{base, resultLen, extents}; + return fir::CharBoxValue{base, resultLen}; +} + +static mlir::Type getSingletonCharType(mlir::MLIRContext *ctxt, int kind) { + return fir::CharacterType::getSingleton(ctxt, kind); +} + +mlir::Value +fir::factory::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) { + // Base CharBoxValue of CharArrayBoxValue are ok here (do not require a scalar + // type) + auto charTy = recoverCharacterType(box.getBuffer().getType()); + auto boxCharType = + fir::BoxCharType::get(builder.getContext(), charTy.getFKind()); + auto refType = fir::ReferenceType::get(boxCharType.getEleTy()); + mlir::Value buff = box.getBuffer(); + // fir.boxchar requires a memory reference. Allocate temp if the character is + // not in memory. + if (!fir::isa_ref_type(buff.getType())) { + auto temp = builder.createTemporary(loc, buff.getType()); + builder.create(loc, buff, temp); + buff = temp; + } + buff = builder.createConvert(loc, refType, buff); + // Convert in case the provided length is not of the integer type that must + // be used in boxchar. + auto len = builder.createConvert(loc, builder.getCharacterLengthType(), + box.getLen()); + return builder.create(loc, boxCharType, buff, len); +} + +fir::CharBoxValue fir::factory::CharacterExprHelper::toScalarCharacter( + const fir::CharArrayBoxValue &box) { + if (box.getBuffer().getType().isa()) + TODO(loc, "concatenating non contiguous character array into a scalar"); + + // TODO: add a fast path multiplying new length at compile time if the info is + // in the array type. + auto lenType = builder.getCharacterLengthType(); + auto len = builder.createConvert(loc, lenType, box.getLen()); + for (auto extent : box.getExtents()) + len = builder.create( + loc, len, builder.createConvert(loc, lenType, extent)); + + // TODO: typeLen can be improved in compiled constant cases + // TODO: allow bare fir.array<> (no ref) conversion here ? + auto typeLen = fir::CharacterType::unknownLen(); + auto kind = recoverCharacterType(box.getBuffer().getType()).getFKind(); + auto charTy = fir::CharacterType::get(builder.getContext(), kind, typeLen); + auto type = fir::ReferenceType::get(charTy); + auto buffer = builder.createConvert(loc, type, box.getBuffer()); + return {buffer, len}; +} + +mlir::Value fir::factory::CharacterExprHelper::createEmbox( + const fir::CharArrayBoxValue &box) { + // Use same embox as for scalar. It's losing the actual data size information + // (We do not multiply the length by the array size), but that is what Fortran + // call interfaces using boxchar expect. + return createEmbox(static_cast(box)); +} + +/// Get the address of the element at position \p index of the scalar character +/// \p buffer. +/// \p buffer must be of type !fir.ref>. The length may be +/// unknown. \p index must have any integer type, and is zero based. The return +/// value is a singleton address (!fir.ref>) +mlir::Value +fir::factory::CharacterExprHelper::createElementAddr(mlir::Value buffer, + mlir::Value index) { + // The only way to address an element of a fir.ref> is to cast + // it to a fir.array> and use fir.coordinate_of. + auto bufferType = buffer.getType(); + assert(fir::isa_ref_type(bufferType)); + assert(isCharacterScalar(bufferType)); + auto charTy = recoverCharacterType(bufferType); + auto singleTy = getSingletonCharType(builder.getContext(), charTy.getFKind()); + auto singleRefTy = builder.getRefType(singleTy); + auto extent = fir::SequenceType::getUnknownExtent(); + if (charTy.getLen() != fir::CharacterType::unknownLen()) + extent = charTy.getLen(); + auto coorTy = builder.getRefType(fir::SequenceType::get({extent}, singleTy)); + + auto coor = builder.createConvert(loc, coorTy, buffer); + auto i = builder.createConvert(loc, builder.getIndexType(), index); + return builder.create(loc, singleRefTy, coor, i); +} + +/// Load a character out of `buff` from offset `index`. +/// `buff` must be a reference to memory. +mlir::Value +fir::factory::CharacterExprHelper::createLoadCharAt(mlir::Value buff, + mlir::Value index) { + LLVM_DEBUG(llvm::dbgs() << "load a char: " << buff << " type: " + << buff.getType() << " at: " << index << '\n'); + return builder.create(loc, createElementAddr(buff, index)); +} + +/// Store the singleton character `c` to `str` at offset `index`. +/// `str` must be a reference to memory. +void fir::factory::CharacterExprHelper::createStoreCharAt(mlir::Value str, + mlir::Value index, + mlir::Value c) { + LLVM_DEBUG(llvm::dbgs() << "store the char: " << c << " into: " << str + << " type: " << str.getType() << " at: " << index + << '\n'); + auto addr = createElementAddr(str, index); + builder.create(loc, c, addr); +} + +// FIXME: this temp is useless... either fir.coordinate_of needs to +// work on "loaded" characters (!fir.array>) or +// character should never be loaded. +// If this is a fir.array<>, allocate and store the value so that +// fir.cooridnate_of can be use on the value. +mlir::Value fir::factory::CharacterExprHelper::getCharBoxBuffer( + const fir::CharBoxValue &box) { + auto buff = box.getBuffer(); + if (fir::isa_char(buff.getType())) { + auto newBuff = builder.create(loc, buff.getType()); + builder.create(loc, buff, newBuff); + return newBuff; + } + return buff; +} + +/// Get the LLVM intrinsic for `memcpy`. Use the 64 bit version. +mlir::FuncOp fir::factory::getLlvmMemcpy(fir::FirOpBuilder &builder) { + auto ptrTy = builder.getRefType(builder.getIntegerType(8)); + llvm::SmallVector args = {ptrTy, ptrTy, builder.getI64Type(), + builder.getI1Type()}; + auto memcpyTy = + mlir::FunctionType::get(builder.getContext(), args, llvm::None); + return builder.addNamedFunction(builder.getUnknownLoc(), + "llvm.memcpy.p0i8.p0i8.i64", memcpyTy); +} + +/// Get the LLVM intrinsic for `memmove`. Use the 64 bit version. +mlir::FuncOp fir::factory::getLlvmMemmove(fir::FirOpBuilder &builder) { + auto ptrTy = builder.getRefType(builder.getIntegerType(8)); + llvm::SmallVector args = {ptrTy, ptrTy, builder.getI64Type(), + builder.getI1Type()}; + auto memmoveTy = + mlir::FunctionType::get(builder.getContext(), args, llvm::None); + return builder.addNamedFunction(builder.getUnknownLoc(), + "llvm.memmove.p0i8.p0i8.i64", memmoveTy); +} + +/// Get the LLVM intrinsic for `memset`. Use the 64 bit version. +mlir::FuncOp fir::factory::getLlvmMemset(fir::FirOpBuilder &builder) { + auto ptrTy = builder.getRefType(builder.getIntegerType(8)); + llvm::SmallVector args = {ptrTy, ptrTy, builder.getI64Type(), + builder.getI1Type()}; + auto memsetTy = + mlir::FunctionType::get(builder.getContext(), args, llvm::None); + return builder.addNamedFunction(builder.getUnknownLoc(), + "llvm.memset.p0i8.p0i8.i64", memsetTy); +} + +/// Get the standard `realloc` function. +mlir::FuncOp fir::factory::getRealloc(fir::FirOpBuilder &builder) { + auto ptrTy = builder.getRefType(builder.getIntegerType(8)); + llvm::SmallVector args = {ptrTy, builder.getI64Type()}; + auto reallocTy = mlir::FunctionType::get(builder.getContext(), args, {ptrTy}); + return builder.addNamedFunction(builder.getUnknownLoc(), "realloc", + reallocTy); +} + +/// Create a loop to copy `count` characters from `src` to `dest`. Note that the +/// KIND indicates the number of bits in a code point. (ASCII, UCS-2, or UCS-4.) +void fir::factory::CharacterExprHelper::createCopy( + const fir::CharBoxValue &dest, const fir::CharBoxValue &src, + mlir::Value count) { + auto fromBuff = getCharBoxBuffer(src); + auto toBuff = getCharBoxBuffer(dest); + LLVM_DEBUG(llvm::dbgs() << "create char copy from: "; src.dump(); + llvm::dbgs() << " to: "; dest.dump(); + llvm::dbgs() << " count: " << count << '\n'); + auto kind = getCharacterKind(src.getBuffer().getType()); + // If the src and dest are the same KIND, then use memmove to move the bits. + // We don't have to worry about overlapping ranges with memmove. + if (getCharacterKind(dest.getBuffer().getType()) == kind) { + auto bytes = builder.getKindMap().getCharacterBitsize(kind) / 8; + auto i64Ty = builder.getI64Type(); + auto kindBytes = builder.createIntegerConstant(loc, i64Ty, bytes); + auto castCount = builder.createConvert(loc, i64Ty, count); + auto totalBytes = builder.create(loc, kindBytes, castCount); + auto notVolatile = builder.createBool(loc, false); + auto memmv = getLlvmMemmove(builder); + auto argTys = memmv.getType().getInputs(); + auto toPtr = builder.createConvert(loc, argTys[0], toBuff); + auto fromPtr = builder.createConvert(loc, argTys[1], fromBuff); + builder.create( + loc, memmv, mlir::ValueRange{toPtr, fromPtr, totalBytes, notVolatile}); + return; + } + + // Convert a CHARACTER of one KIND into a CHARACTER of another KIND. + builder.create(loc, src.getBuffer(), count, + dest.getBuffer()); +} + +void fir::factory::CharacterExprHelper::createPadding( + const fir::CharBoxValue &str, mlir::Value lower, mlir::Value upper) { + auto blank = createBlankConstant(getCharacterType(str)); + // Always create the loop, if upper < lower, no iteration will be + // executed. + auto toBuff = getCharBoxBuffer(str); + fir::factory::DoLoopHelper{builder, loc}.createLoop( + lower, upper, [&](fir::FirOpBuilder &, mlir::Value index) { + createStoreCharAt(toBuff, index, blank); + }); +} + +fir::CharBoxValue +fir::factory::CharacterExprHelper::createCharacterTemp(mlir::Type type, + mlir::Value len) { + auto kind = recoverCharacterType(type).getFKind(); + auto typeLen = fir::CharacterType::unknownLen(); + // If len is a constant, reflect the length in the type. + if (auto cstLen = getIntIfConstant(len)) + typeLen = *cstLen; + auto *ctxt = builder.getContext(); + auto charTy = fir::CharacterType::get(ctxt, kind, typeLen); + llvm::SmallVector lenParams; + if (typeLen == fir::CharacterType::unknownLen()) + lenParams.push_back(len); + auto ref = builder.allocateLocal(loc, charTy, "", ".chrtmp", + /*shape=*/llvm::None, lenParams); + return {ref, len}; +} + +fir::CharBoxValue fir::factory::CharacterExprHelper::createTempFrom( + const fir::ExtendedValue &source) { + const auto *charBox = source.getCharBox(); + if (!charBox) + fir::emitFatalError(loc, "source must be a fir::CharBoxValue"); + auto len = charBox->getLen(); + auto sourceTy = charBox->getBuffer().getType(); + auto temp = createCharacterTemp(sourceTy, len); + if (fir::isa_ref_type(sourceTy)) { + createCopy(temp, *charBox, len); + } else { + auto ref = builder.createConvert(loc, builder.getRefType(sourceTy), + temp.getBuffer()); + builder.create(loc, charBox->getBuffer(), ref); + } + return temp; +} + +// Simple length one character assignment without loops. +void fir::factory::CharacterExprHelper::createLengthOneAssign( + const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) { + auto addr = lhs.getBuffer(); + mlir::Value val = builder.create(loc, rhs.getBuffer()); + auto addrTy = builder.getRefType(val.getType()); + addr = builder.createConvert(loc, addrTy, addr); + builder.create(loc, val, addr); +} + +/// Returns the minimum of integer mlir::Value \p a and \b. +mlir::Value genMin(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value a, mlir::Value b) { + auto cmp = builder.create(loc, mlir::CmpIPredicate::slt, a, b); + return builder.create(loc, cmp, a, b); +} + +void fir::factory::CharacterExprHelper::createAssign( + const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) { + auto rhsCstLen = getCompileTimeLength(rhs); + auto lhsCstLen = getCompileTimeLength(lhs); + bool compileTimeSameLength = + lhsCstLen && rhsCstLen && *lhsCstLen == *rhsCstLen; + + if (compileTimeSameLength && *lhsCstLen == 1) { + createLengthOneAssign(lhs, rhs); + return; + } + + // Copy the minimum of the lhs and rhs lengths and pad the lhs remainder + // if needed. + auto copyCount = lhs.getLen(); + auto idxTy = builder.getIndexType(); + if (!compileTimeSameLength) { + auto lhsLen = builder.createConvert(loc, idxTy, lhs.getLen()); + auto rhsLen = builder.createConvert(loc, idxTy, rhs.getLen()); + copyCount = genMin(builder, loc, lhsLen, rhsLen); + } + + // Actual copy + createCopy(lhs, rhs, copyCount); + + // Pad if needed. + if (!compileTimeSameLength) { + auto one = builder.createIntegerConstant(loc, lhs.getLen().getType(), 1); + auto maxPadding = builder.create(loc, lhs.getLen(), one); + createPadding(lhs, copyCount, maxPadding); + } +} + +fir::CharBoxValue fir::factory::CharacterExprHelper::createConcatenate( + const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) { + auto lhsLen = builder.createConvert(loc, builder.getCharacterLengthType(), + lhs.getLen()); + auto rhsLen = builder.createConvert(loc, builder.getCharacterLengthType(), + rhs.getLen()); + mlir::Value len = builder.create(loc, lhsLen, rhsLen); + auto temp = createCharacterTemp(getCharacterType(rhs), len); + createCopy(temp, lhs, lhsLen); + auto one = builder.createIntegerConstant(loc, len.getType(), 1); + auto upperBound = builder.create(loc, len, one); + auto lhsLenIdx = builder.createConvert(loc, builder.getIndexType(), lhsLen); + auto fromBuff = getCharBoxBuffer(rhs); + auto toBuff = getCharBoxBuffer(temp); + fir::factory::DoLoopHelper{builder, loc}.createLoop( + lhsLenIdx, upperBound, one, + [&](fir::FirOpBuilder &bldr, mlir::Value index) { + auto rhsIndex = bldr.create(loc, index, lhsLenIdx); + auto charVal = createLoadCharAt(fromBuff, rhsIndex); + createStoreCharAt(toBuff, index, charVal); + }); + return temp; +} + +fir::CharBoxValue fir::factory::CharacterExprHelper::createSubstring( + const fir::CharBoxValue &box, llvm::ArrayRef bounds) { + // Constant need to be materialize in memory to use fir.coordinate_of. + auto nbounds = bounds.size(); + if (nbounds < 1 || nbounds > 2) { + mlir::emitError(loc, "Incorrect number of bounds in substring"); + return {mlir::Value{}, mlir::Value{}}; + } + mlir::SmallVector castBounds; + // Convert bounds to length type to do safe arithmetic on it. + for (auto bound : bounds) + castBounds.push_back( + builder.createConvert(loc, builder.getCharacterLengthType(), bound)); + auto lowerBound = castBounds[0]; + // FIR CoordinateOp is zero based but Fortran substring are one based. + auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1); + auto offset = builder.create(loc, lowerBound, one).getResult(); + auto addr = createElementAddr(box.getBuffer(), offset); + auto kind = getCharacterKind(box.getBuffer().getType()); + auto charTy = fir::CharacterType::getUnknownLen(builder.getContext(), kind); + auto resultType = builder.getRefType(charTy); + auto substringRef = builder.createConvert(loc, resultType, addr); + + // Compute the length. + mlir::Value substringLen; + if (nbounds < 2) { + substringLen = + builder.create(loc, box.getLen(), castBounds[0]); + } else { + substringLen = + builder.create(loc, castBounds[1], castBounds[0]); + } + substringLen = builder.create(loc, substringLen, one); + + // Set length to zero if bounds were reversed (Fortran 2018 9.4.1) + auto zero = builder.createIntegerConstant(loc, substringLen.getType(), 0); + auto cdt = builder.create(loc, mlir::CmpIPredicate::slt, + substringLen, zero); + substringLen = builder.create(loc, cdt, zero, substringLen); + + return {substringRef, substringLen}; +} + +mlir::Value +fir::factory::CharacterExprHelper::createLenTrim(const fir::CharBoxValue &str) { + // Note: Runtime for LEN_TRIM should also be available at some + // point. For now use an inlined implementation. + auto indexType = builder.getIndexType(); + auto len = builder.createConvert(loc, indexType, str.getLen()); + auto one = builder.createIntegerConstant(loc, indexType, 1); + auto minusOne = builder.createIntegerConstant(loc, indexType, -1); + auto zero = builder.createIntegerConstant(loc, indexType, 0); + auto trueVal = builder.createIntegerConstant(loc, builder.getI1Type(), 1); + auto blank = createBlankConstantCode(getCharacterType(str)); + mlir::Value lastChar = builder.create(loc, len, one); + + auto iterWhile = + builder.create(loc, lastChar, zero, minusOne, trueVal, + /*returnFinalCount=*/false, lastChar); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(iterWhile.getBody()); + auto index = iterWhile.getInductionVar(); + // Look for first non-blank from the right of the character. + auto fromBuff = getCharBoxBuffer(str); + auto elemAddr = createElementAddr(fromBuff, index); + auto codeAddr = + builder.createConvert(loc, builder.getRefType(blank.getType()), elemAddr); + auto c = builder.create(loc, codeAddr); + auto isBlank = + builder.create(loc, mlir::CmpIPredicate::eq, blank, c); + llvm::SmallVector results = {isBlank, index}; + builder.create(loc, results); + builder.restoreInsertionPoint(insPt); + // Compute length after iteration (zero if all blanks) + mlir::Value newLen = + builder.create(loc, iterWhile.getResult(1), one); + auto result = + builder.create(loc, iterWhile.getResult(0), zero, newLen); + return builder.createConvert(loc, builder.getCharacterLengthType(), result); +} + +fir::CharBoxValue +fir::factory::CharacterExprHelper::createCharacterTemp(mlir::Type type, + int len) { + assert(len >= 0 && "expected positive length"); + auto kind = recoverCharacterType(type).getFKind(); + auto charType = fir::CharacterType::get(builder.getContext(), kind, len); + auto addr = builder.create(loc, charType); + auto mlirLen = + builder.createIntegerConstant(loc, builder.getCharacterLengthType(), len); + return {addr, mlirLen}; +} + +// Returns integer with code for blank. The integer has the same +// size as the character. Blank has ascii space code for all kinds. +mlir::Value fir::factory::CharacterExprHelper::createBlankConstantCode( + fir::CharacterType type) { + auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind()); + auto intType = builder.getIntegerType(bits); + return builder.createIntegerConstant(loc, intType, ' '); +} + +mlir::Value fir::factory::CharacterExprHelper::createBlankConstant( + fir::CharacterType type) { + return createSingletonFromCode(createBlankConstantCode(type), + type.getFKind()); +} + +void fir::factory::CharacterExprHelper::createAssign( + const fir::ExtendedValue &lhs, const fir::ExtendedValue &rhs) { + if (auto *str = rhs.getBoxOf()) { + if (auto *to = lhs.getBoxOf()) { + createAssign(*to, *str); + return; + } + } + TODO(loc, "character array assignment"); + // Note that it is not sure the array aspect should be handled + // by this utility. +} + +mlir::Value +fir::factory::CharacterExprHelper::createEmboxChar(mlir::Value addr, + mlir::Value len) { + return createEmbox(fir::CharBoxValue{addr, len}); +} + +std::pair +fir::factory::CharacterExprHelper::createUnboxChar(mlir::Value boxChar) { + using T = std::pair; + return toExtendedValue(boxChar).match( + [](const fir::CharBoxValue &b) -> T { + return {b.getBuffer(), b.getLen()}; + }, + [](const fir::CharArrayBoxValue &b) -> T { + return {b.getBuffer(), b.getLen()}; + }, + [](const auto &) -> T { llvm::report_fatal_error("not a character"); }); +} + +bool fir::factory::CharacterExprHelper::isCharacterLiteral(mlir::Type type) { + if (auto seqType = type.dyn_cast()) + return (seqType.getShape().size() == 1) && + fir::isa_char(seqType.getEleTy()); + return false; +} + +bool fir::factory::CharacterExprHelper::isCharacterScalar(mlir::Type type) { + if (type.isa()) + return true; + type = fir::unwrapRefType(type); + if (auto boxTy = type.dyn_cast()) + type = boxTy.getEleTy(); + type = fir::unwrapRefType(type); + return !type.isa() && fir::isa_char(type); +} + +fir::KindTy +fir::factory::CharacterExprHelper::getCharacterKind(mlir::Type type) { + assert(isCharacterScalar(type) && "expected scalar character"); + return recoverCharacterType(type).getFKind(); +} + +fir::KindTy +fir::factory::CharacterExprHelper::getCharacterOrSequenceKind(mlir::Type type) { + return recoverCharacterType(type).getFKind(); +} + +bool fir::factory::CharacterExprHelper::isArray(mlir::Type type) { + return !isCharacterScalar(type); +} + +bool fir::factory::CharacterExprHelper::hasConstantLengthInType( + const fir::ExtendedValue &exv) { + auto charTy = recoverCharacterType(fir::getBase(exv).getType()); + return charTy.hasConstantLen(); +} + +mlir::Value +fir::factory::CharacterExprHelper::createSingletonFromCode(mlir::Value code, + int kind) { + auto charType = fir::CharacterType::get(builder.getContext(), kind, 1); + auto bits = builder.getKindMap().getCharacterBitsize(kind); + auto intType = builder.getIntegerType(bits); + auto cast = builder.createConvert(loc, intType, code); + auto undef = builder.create(loc, charType); + auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + return builder.create(loc, charType, undef, cast, zero); +} + +mlir::Value fir::factory::CharacterExprHelper::extractCodeFromSingleton( + mlir::Value singleton) { + auto type = getCharacterType(singleton); + assert(type.getLen() == 1); + auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind()); + auto intType = builder.getIntegerType(bits); + auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + return builder.create(loc, intType, singleton, zero); +} + +mlir::Value +fir::factory::CharacterExprHelper::readLengthFromBox(mlir::Value box) { + auto lenTy = builder.getCharacterLengthType(); + auto size = builder.create(loc, lenTy, box); + auto charTy = recoverCharacterType(box.getType()); + auto bits = builder.getKindMap().getCharacterBitsize(charTy.getFKind()); + auto width = bits / 8; + if (width > 1) { + auto widthVal = builder.createIntegerConstant(loc, lenTy, width); + return builder.create(loc, size, widthVal); + } + return size; +} + +mlir::Value fir::factory::CharacterExprHelper::getLength(mlir::Value memref) { + auto memrefType = memref.getType(); + auto charType = recoverCharacterType(memrefType); + assert(charType && "must be a character type"); + if (charType.hasConstantLen()) + return builder.createIntegerConstant(loc, builder.getCharacterLengthType(), + charType.getLen()); + if (memrefType.isa()) + return readLengthFromBox(memref); + if (memrefType.isa()) + return createUnboxChar(memref).second; + + // Length cannot be deduced from memref. + return {}; +} diff --git a/flang/lib/Optimizer/Builder/DoLoopHelper.cpp b/flang/lib/Optimizer/Builder/DoLoopHelper.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/DoLoopHelper.cpp @@ -0,0 +1,44 @@ +//===-- DoLoopHelper.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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/DoLoopHelper.h" + +//===----------------------------------------------------------------------===// +// DoLoopHelper implementation +//===----------------------------------------------------------------------===// + +void fir::factory::DoLoopHelper::createLoop( + mlir::Value lb, mlir::Value ub, mlir::Value step, + const BodyGenerator &bodyGenerator) { + auto lbi = builder.convertToIndexType(loc, lb); + auto ubi = builder.convertToIndexType(loc, ub); + assert(step && "step must be an actual Value"); + auto inc = builder.convertToIndexType(loc, step); + auto loop = builder.create(loc, lbi, ubi, inc); + auto insertPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(loop.getBody()); + auto index = loop.getInductionVar(); + bodyGenerator(builder, index); + builder.restoreInsertionPoint(insertPt); +} + +void fir::factory::DoLoopHelper::createLoop( + mlir::Value lb, mlir::Value ub, const BodyGenerator &bodyGenerator) { + createLoop(lb, ub, + builder.createIntegerConstant(loc, builder.getIndexType(), 1), + bodyGenerator); +} + +void fir::factory::DoLoopHelper::createLoop( + mlir::Value count, const BodyGenerator &bodyGenerator) { + auto indexType = builder.getIndexType(); + auto zero = builder.createIntegerConstant(loc, indexType, 0); + auto one = builder.createIntegerConstant(loc, count.getType(), 1); + auto up = builder.create(loc, count, one); + createLoop(zero, up, one, bodyGenerator); +} diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -0,0 +1,882 @@ +//===-- FIRBuilder.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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/MutableBox.h" +#include "flang/Optimizer/Builder/Runtime/Assign.h" +#include "flang/Optimizer/Dialect/FIRAttr.h" +#include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Support/FatalError.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "mlir/Dialect/OpenMP/OpenMPDialect.h" +#include "llvm/ADT/ArrayRef.h" +#include "llvm/ADT/StringExtras.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/ErrorHandling.h" +#include "llvm/Support/MD5.h" + +static llvm::cl::opt + nameLengthHashSize("length-to-hash-string-literal", + llvm::cl::desc("string literals that exceed this length" + " will use a hash value as their symbol " + "name"), + llvm::cl::init(32)); + +mlir::FuncOp fir::FirOpBuilder::createFunction(mlir::Location loc, + mlir::ModuleOp module, + llvm::StringRef name, + mlir::FunctionType ty) { + return fir::createFuncOp(loc, module, name, ty); +} + +mlir::FuncOp fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp, + llvm::StringRef name) { + return modOp.lookupSymbol(name); +} + +fir::GlobalOp fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp, + llvm::StringRef name) { + return modOp.lookupSymbol(name); +} + +mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy) { + assert(!eleTy.isa() && "cannot be a reference type"); + return fir::ReferenceType::get(eleTy); +} + +mlir::Type fir::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy, unsigned rank) { + fir::SequenceType::Shape shape(rank, fir::SequenceType::getUnknownExtent()); + return fir::SequenceType::get(shape, eleTy); +} + +mlir::Type fir::FirOpBuilder::getRealType(int kind) { + switch (kindMap.getRealTypeID(kind)) { + case llvm::Type::TypeID::HalfTyID: + return mlir::FloatType::getF16(getContext()); + case llvm::Type::TypeID::FloatTyID: + return mlir::FloatType::getF32(getContext()); + case llvm::Type::TypeID::DoubleTyID: + return mlir::FloatType::getF64(getContext()); + case llvm::Type::TypeID::X86_FP80TyID: + return mlir::FloatType::getF80(getContext()); + case llvm::Type::TypeID::FP128TyID: + return mlir::FloatType::getF128(getContext()); + default: + fir::emitFatalError(UnknownLoc::get(getContext()), + "unsupported type !fir.real"); + } +} + +mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc, + mlir::Type ptrType) { + auto ty = ptrType ? ptrType : getRefType(getNoneType()); + return create(loc, ty); +} + +mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc, + mlir::Type ty, + std::int64_t cst) { + return create(loc, ty, getIntegerAttr(ty, cst)); +} + +mlir::Value +fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy, + llvm::APFloat::integerPart val) { + auto apf = [&]() -> llvm::APFloat { + if (auto ty = fltTy.dyn_cast()) + return llvm::APFloat(kindMap.getFloatSemantics(ty.getFKind()), val); + if (fltTy.isF16()) + return llvm::APFloat(llvm::APFloat::IEEEhalf(), val); + if (fltTy.isBF16()) + return llvm::APFloat(llvm::APFloat::BFloat(), val); + if (fltTy.isF32()) + return llvm::APFloat(llvm::APFloat::IEEEsingle(), val); + if (fltTy.isF64()) + return llvm::APFloat(llvm::APFloat::IEEEdouble(), val); + if (fltTy.isF80()) + return llvm::APFloat(llvm::APFloat::x87DoubleExtended(), val); + if (fltTy.isF128()) + return llvm::APFloat(llvm::APFloat::IEEEquad(), val); + llvm_unreachable("unhandled MLIR floating-point type"); + }; + return createRealConstant(loc, fltTy, apf()); +} + +mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc, + mlir::Type fltTy, + const llvm::APFloat &value) { + if (fltTy.isa()) { + auto attr = getFloatAttr(fltTy, value); + return create(loc, fltTy, attr); + } + llvm_unreachable("should use builtin floating-point type"); +} + +static llvm::SmallVector +elideExtentsAlreadyInType(mlir::Type type, mlir::ValueRange shape) { + auto arrTy = type.dyn_cast(); + if (shape.empty() || !arrTy) + return {}; + // elide the constant dimensions before construction + assert(shape.size() == arrTy.getDimension()); + llvm::SmallVector dynamicShape; + auto typeShape = arrTy.getShape(); + for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i) + if (typeShape[i] == fir::SequenceType::getUnknownExtent()) + dynamicShape.push_back(shape[i]); + return dynamicShape; +} + +static llvm::SmallVector +elideLengthsAlreadyInType(mlir::Type type, mlir::ValueRange lenParams) { + if (lenParams.empty()) + return {}; + if (auto arrTy = type.dyn_cast()) + type = arrTy.getEleTy(); + if (fir::hasDynamicSize(type)) + return lenParams; + return {}; +} + +/// Allocate a local variable. +/// A local variable ought to have a name in the source code. +mlir::Value fir::FirOpBuilder::allocateLocal( + mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName, + llvm::StringRef name, bool pinned, llvm::ArrayRef shape, + llvm::ArrayRef lenParams, bool asTarget) { + // Convert the shape extents to `index`, as needed. + llvm::SmallVector indices; + llvm::SmallVector elidedShape = + elideExtentsAlreadyInType(ty, shape); + llvm::SmallVector elidedLenParams = + elideLengthsAlreadyInType(ty, lenParams); + auto idxTy = getIndexType(); + llvm::for_each(elidedShape, [&](mlir::Value sh) { + indices.push_back(createConvert(loc, idxTy, sh)); + }); + // Add a target attribute, if needed. + llvm::SmallVector attrs; + if (asTarget) + attrs.emplace_back( + mlir::Identifier::get(fir::getTargetAttrName(), getContext()), + getUnitAttr()); + // Create the local variable. + if (name.empty()) { + if (uniqName.empty()) + return create(loc, ty, pinned, elidedLenParams, indices, + attrs); + return create(loc, ty, uniqName, pinned, elidedLenParams, + indices, attrs); + } + return create(loc, ty, uniqName, name, pinned, elidedLenParams, + indices, attrs); +} + +mlir::Value fir::FirOpBuilder::allocateLocal( + mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName, + llvm::StringRef name, llvm::ArrayRef shape, + llvm::ArrayRef lenParams, bool asTarget) { + return allocateLocal(loc, ty, uniqName, name, /*pinned=*/false, shape, + lenParams, asTarget); +} + +/// Get the block for adding Allocas. +mlir::Block *fir::FirOpBuilder::getAllocaBlock() { + // auto iface = + // getRegion().getParentOfType(); + // return iface ? iface.getAllocaBlock() : getEntryBlock(); + return getEntryBlock(); +} + +/// Create a temporary variable on the stack. Anonymous temporaries have no +/// `name` value. Temporaries do not require a uniqued name. +mlir::Value +fir::FirOpBuilder::createTemporary(mlir::Location loc, mlir::Type type, + llvm::StringRef name, mlir::ValueRange shape, + mlir::ValueRange lenParams, + llvm::ArrayRef attrs) { + llvm::SmallVector dynamicShape = + elideExtentsAlreadyInType(type, shape); + llvm::SmallVector dynamicLength = + elideLengthsAlreadyInType(type, lenParams); + InsertPoint insPt; + const bool hoistAlloc = dynamicShape.empty() && dynamicLength.empty(); + if (hoistAlloc) { + insPt = saveInsertionPoint(); + setInsertionPointToStart(getAllocaBlock()); + } + + // If the alloca is inside an OpenMP Op which will be outlined then pin the + // alloca here. + const bool pinned = + getRegion().getParentOfType(); + assert(!type.isa() && "cannot be a reference"); + auto ae = + create(loc, type, /*unique_name=*/llvm::StringRef{}, name, + pinned, dynamicLength, dynamicShape, attrs); + if (hoistAlloc) + restoreInsertionPoint(insPt); + return ae; +} + +/// Create a global variable in the (read-only) data section. A global variable +/// must have a unique name to identify and reference it. +fir::GlobalOp +fir::FirOpBuilder::createGlobal(mlir::Location loc, mlir::Type type, + llvm::StringRef name, mlir::StringAttr linkage, + mlir::Attribute value, bool isConst) { + auto module = getModule(); + auto insertPt = saveInsertionPoint(); + if (auto glob = module.lookupSymbol(name)) + return glob; + setInsertionPoint(module.getBody(), module.getBody()->end()); + auto glob = create(loc, name, isConst, type, value, linkage); + restoreInsertionPoint(insertPt); + return glob; +} + +fir::GlobalOp fir::FirOpBuilder::createGlobal( + mlir::Location loc, mlir::Type type, llvm::StringRef name, bool isConst, + std::function bodyBuilder, mlir::StringAttr linkage) { + auto module = getModule(); + auto insertPt = saveInsertionPoint(); + if (auto glob = module.lookupSymbol(name)) + return glob; + setInsertionPoint(module.getBody(), module.getBody()->end()); + auto glob = create(loc, name, isConst, type, mlir::Attribute{}, + linkage); + auto ®ion = glob.getRegion(); + region.push_back(new mlir::Block); + auto &block = glob.getRegion().back(); + setInsertionPointToStart(&block); + bodyBuilder(*this); + restoreInsertionPoint(insertPt); + return glob; +} + +mlir::Value fir::FirOpBuilder::convertWithSemantics(mlir::Location loc, + mlir::Type toTy, + mlir::Value val) { + assert(toTy && "store location must be typed"); + auto fromTy = val.getType(); + if (fromTy == toTy) + return val; + // fir::factory::ComplexExprHelper helper{*this, loc}; + // if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) && + // fir::isa_complex(toTy)) { + // // imaginary part is zero + // auto eleTy = helper.getComplexPartType(toTy); + // auto cast = createConvert(loc, eleTy, val); + // llvm::APFloat zero{ + // kindMap.getFloatSemantics(toTy.cast().getFKind()), + // 0}; + // auto imag = createRealConstant(loc, eleTy, zero); + // return helper.createComplex(toTy, cast, imag); + // } + // if (fir::isa_complex(fromTy) && + // (fir::isa_integer(toTy) || fir::isa_real(toTy))) { + // // drop the imaginary part + // auto rp = helper.extractComplexPart(val, /*isImagPart=*/false); + // return createConvert(loc, toTy, rp); + // } + return createConvert(loc, toTy, val); +} + +mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc, + mlir::Type toTy, mlir::Value val) { + if (val.getType() != toTy) { + assert(!fir::isa_derived(toTy)); + return create(loc, toTy, val); + } + return val; +} + +fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc, + llvm::StringRef data) { + auto type = fir::CharacterType::get(getContext(), 1, data.size()); + auto strAttr = mlir::StringAttr::get(getContext(), data); + auto valTag = mlir::Identifier::get(fir::StringLitOp::value(), getContext()); + mlir::NamedAttribute dataAttr(valTag, strAttr); + auto sizeTag = mlir::Identifier::get(fir::StringLitOp::size(), getContext()); + mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size())); + llvm::SmallVector attrs{dataAttr, sizeAttr}; + return create(loc, llvm::ArrayRef{type}, + llvm::None, attrs); +} + +mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc, + llvm::ArrayRef exts) { + auto shapeType = fir::ShapeType::get(getContext(), exts.size()); + return create(loc, shapeType, exts); +} + +mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc, + llvm::ArrayRef shift, + llvm::ArrayRef exts) { + auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size()); + llvm::SmallVector shapeArgs; + auto idxTy = getIndexType(); + for (auto [lbnd, ext] : llvm::zip(shift, exts)) { + auto lb = createConvert(loc, idxTy, lbnd); + shapeArgs.push_back(lb); + shapeArgs.push_back(ext); + } + return create(loc, shapeType, shapeArgs); +} + +mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc, + const fir::AbstractArrayBox &arr) { + if (arr.lboundsAllOne()) + return genShape(loc, arr.getExtents()); + return genShape(loc, arr.getLBounds(), arr.getExtents()); +} + +mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc, + const fir::ExtendedValue &exv) { + return exv.match( + [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); }, + [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); }, + [&](const fir::BoxValue &box) -> mlir::Value { + if (!box.getLBounds().empty()) { + auto shiftType = + fir::ShiftType::get(getContext(), box.getLBounds().size()); + return create(loc, shiftType, box.getLBounds()); + } + return {}; + }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with them + // outside of allocation/assignment contexts. + fir::emitFatalError(loc, "createShape on MutableBoxValue"); + }, + [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); }); +} + +mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc, + const fir::ExtendedValue &exv, + mlir::ValueRange triples, + mlir::ValueRange path) { + if (triples.empty()) { + // If there is no slicing by triple notation, then take the whole array. + auto fullShape = [&](const llvm::ArrayRef lbounds, + llvm::ArrayRef extents) -> mlir::Value { + llvm::SmallVector trips; + auto idxTy = getIndexType(); + auto one = createIntegerConstant(loc, idxTy, 1); + auto sliceTy = fir::SliceType::get(getContext(), extents.size()); + if (lbounds.empty()) { + for (auto v : extents) { + trips.push_back(one); + trips.push_back(v); + trips.push_back(one); + } + return create(loc, sliceTy, trips, path); + } + for (auto [lbnd, ext] : llvm::zip(lbounds, extents)) { + auto lb = createConvert(loc, idxTy, lbnd); + trips.push_back(lb); + trips.push_back(ext); + trips.push_back(one); + } + return create(loc, sliceTy, trips, path); + }; + return exv.match( + [&](const fir::ArrayBoxValue &box) { + return fullShape(box.getLBounds(), box.getExtents()); + }, + [&](const fir::CharArrayBoxValue &box) { + return fullShape(box.getLBounds(), box.getExtents()); + }, + [&](const fir::BoxValue &box) { + auto extents = fir::factory::readExtents(*this, loc, box); + return fullShape(box.getLBounds(), extents); + }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with + // them outside of allocation/assignment contexts. + fir::emitFatalError(loc, "createSlice on MutableBoxValue"); + }, + [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); }); + } + auto rank = exv.rank(); + auto sliceTy = fir::SliceType::get(getContext(), rank); + return create(loc, sliceTy, triples, path); +} + +mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc, + const fir::ExtendedValue &exv) { + auto itemAddr = fir::getBase(exv); + if (itemAddr.getType().isa()) + return itemAddr; + auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType()); + if (!elementType) + mlir::emitError(loc, "internal: expected a memory reference type ") + << itemAddr.getType(); + auto boxTy = fir::BoxType::get(elementType); + return exv.match( + [&](const fir::ArrayBoxValue &box) -> mlir::Value { + auto s = createShape(loc, exv); + return create(loc, boxTy, itemAddr, s); + }, + // [&](const fir::CharArrayBoxValue &box) -> mlir::Value { + // auto s = createShape(loc, exv); + // if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv)) + // return create(loc, boxTy, itemAddr, s); + + // mlir::Value emptySlice; + // llvm::SmallVector lenParams{box.getLen()}; + // return create(loc, boxTy, itemAddr, s, emptySlice, + // lenParams); + // }, + // [&](const fir::CharBoxValue &box) -> mlir::Value { + // if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv)) + // return create(loc, boxTy, itemAddr); + // mlir::Value emptyShape, emptySlice; + // llvm::SmallVector lenParams{box.getLen()}; + // return create(loc, boxTy, itemAddr, emptyShape, + // emptySlice, lenParams); + // }, + [&](const fir::MutableBoxValue &x) -> mlir::Value { + return create( + loc, fir::factory::getMutableIRBox(*this, loc, x)); + }, + [&](const auto &) -> mlir::Value { + return create(loc, boxTy, itemAddr); + }); +} + +static mlir::Value genNullPointerComparison(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value addr, + mlir::CmpIPredicate condition) { + auto intPtrTy = builder.getIntPtrType(); + auto ptrToInt = builder.createConvert(loc, intPtrTy, addr); + auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0); + return builder.create(loc, condition, ptrToInt, c0); +} + +mlir::Value fir::FirOpBuilder::genIsNotNull(mlir::Location loc, + mlir::Value addr) { + return genNullPointerComparison(*this, loc, addr, mlir::CmpIPredicate::ne); +} + +mlir::Value fir::FirOpBuilder::genIsNull(mlir::Location loc, mlir::Value addr) { + return genNullPointerComparison(*this, loc, addr, mlir::CmpIPredicate::eq); +} + +mlir::Value fir::FirOpBuilder::genExtentFromTriplet(mlir::Location loc, + mlir::Value lb, + mlir::Value ub, + mlir::Value step, + mlir::Type type) { + auto zero = createIntegerConstant(loc, type, 0); + lb = createConvert(loc, type, lb); + ub = createConvert(loc, type, ub); + step = createConvert(loc, type, step); + auto diff = create(loc, ub, lb); + auto add = create(loc, diff, step); + auto div = create(loc, add, step); + auto cmp = create(loc, mlir::CmpIPredicate::sgt, div, zero); + return create(loc, cmp, div, zero); +} + +//===--------------------------------------------------------------------===// +// ExtendedValue inquiry helper implementation +//===--------------------------------------------------------------------===// + +mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &box) { + return box.match( + [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); }, + [&](const fir::CharArrayBoxValue &x) -> mlir::Value { + return x.getLen(); + }, + // [&](const fir::BoxValue &x) -> mlir::Value { + // assert(x.isCharacter()); + // if (!x.getExplicitParameters().empty()) + // return x.getExplicitParameters()[0]; + // return fir::factory::CharacterExprHelper{builder, loc} + // .readLengthFromBox(x.getAddr()); + // }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with them + // outside of allocation/assignment contexts. + fir::emitFatalError(loc, "readCharLen on MutableBoxValue"); + }, + [&](const auto &) -> mlir::Value { + fir::emitFatalError( + loc, "Character length inquiry on a non-character entity"); + }); +} + +mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &box, + unsigned dim) { + assert(box.rank() > dim); + return box.match( + [&](const fir::ArrayBoxValue &x) -> mlir::Value { + return x.getExtents()[dim]; + }, + [&](const fir::CharArrayBoxValue &x) -> mlir::Value { + return x.getExtents()[dim]; + }, + [&](const fir::BoxValue &x) -> mlir::Value { + if (!x.getExplicitExtents().empty()) + return x.getExplicitExtents()[dim]; + auto idxTy = builder.getIndexType(); + auto dimVal = builder.createIntegerConstant(loc, idxTy, dim); + return builder + .create(loc, idxTy, idxTy, idxTy, x.getAddr(), + dimVal) + .getResult(1); + }, + [&](const fir::MutableBoxValue &x) -> mlir::Value { + // MutableBoxValue must be read into another category to work with them + // outside of allocation/assignment contexts. + fir::emitFatalError(loc, "readExtents on MutableBoxValue"); + }, + [&](const auto &) -> mlir::Value { + fir::emitFatalError(loc, "extent inquiry on scalar"); + }); +} + +mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &, + mlir::Location loc, + const fir::ExtendedValue &box, + unsigned dim, + mlir::Value defaultValue) { + assert(box.rank() > dim); + auto lb = box.match( + [&](const fir::ArrayBoxValue &x) -> mlir::Value { + return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim]; + }, + [&](const fir::CharArrayBoxValue &x) -> mlir::Value { + return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim]; + }, + [&](const fir::BoxValue &x) -> mlir::Value { + return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim]; + }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with them + // outside of allocation/assignment contexts. + fir::emitFatalError(loc, "readLowerBound on MutableBoxValue"); + }, + [&](const auto &) -> mlir::Value { + fir::emitFatalError(loc, "lower bound inquiry on scalar"); + }); + if (lb) + return lb; + return defaultValue; +} + +llvm::SmallVector +fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::BoxValue &box) { + llvm::SmallVector result; + auto explicitExtents = box.getExplicitExtents(); + if (!explicitExtents.empty()) { + result.append(explicitExtents.begin(), explicitExtents.end()); + return result; + } + auto rank = box.rank(); + auto idxTy = builder.getIndexType(); + for (decltype(rank) dim = 0; dim < rank; ++dim) { + auto dimVal = builder.createIntegerConstant(loc, idxTy, dim); + auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, + box.getAddr(), dimVal); + result.emplace_back(dimInfo.getResult(1)); + } + return result; +} + +llvm::SmallVector +fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box) { + return box.match( + [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector { + return {x.getExtents().begin(), x.getExtents().end()}; + }, + [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector { + return {x.getExtents().begin(), x.getExtents().end()}; + }, + [&](const fir::BoxValue &x) -> llvm::SmallVector { + return fir::factory::readExtents(builder, loc, x); + }, + [&](const fir::MutableBoxValue &x) -> llvm::SmallVector { + auto load = fir::factory::genMutableBoxRead(builder, loc, x); + return fir::factory::getExtents(builder, loc, load); + }, + [&](const auto &) -> llvm::SmallVector { return {}; }); +} + +fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::BoxValue &box) { + assert(!box.isUnlimitedPolymorphic() && !box.hasAssumedRank() && + "cannot read unlimited polymorphic or assumed rank fir.box"); + auto addr = + builder.create(loc, box.getMemTy(), box.getAddr()); + if (box.isCharacter()) { + auto len = fir::factory::readCharLen(builder, loc, box); + if (box.rank() == 0) + return fir::CharBoxValue(addr, len); + return fir::CharArrayBoxValue(addr, len, + fir::factory::readExtents(builder, loc, box), + box.getLBounds()); + } + if (box.isDerivedWithLengthParameters()) + TODO(loc, "read fir.box with length parameters"); + if (box.rank() == 0) + return addr; + return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box), + box.getLBounds()); +} + +std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix, + llvm::StringRef name) { + // For "long" identifiers use a hash value + if (name.size() > nameLengthHashSize) { + llvm::MD5 hash; + hash.update(name); + llvm::MD5::MD5Result result; + hash.final(result); + llvm::SmallString<32> str; + llvm::MD5::stringifyResult(result, str); + std::string hashName = prefix.str(); + hashName.append(".").append(str.c_str()); + return fir::NameUniquer::doGenerated(hashName); + } + // "Short" identifiers use a reversible hex string + std::string nm = prefix.str(); + return fir::NameUniquer::doGenerated( + nm.append(".").append(llvm::toHex(name))); +} + +mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder, + mlir::Location loc) { + if (auto flc = loc.dyn_cast()) { + // must be encoded as asciiz, C string + auto fn = flc.getFilename().str() + '\0'; + return fir::getBase(createStringLiteral(builder, loc, fn)); + } + return builder.createNullConstant(loc); +} + +mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Type type) { + if (auto flc = loc.dyn_cast()) + return builder.createIntegerConstant(loc, type, flc.getLine()); + return builder.createIntegerConstant(loc, type, 0); +} + +fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder, + mlir::Location loc, + llvm::StringRef str) { + std::string globalName = fir::factory::uniqueCGIdent("cl", str); + auto type = fir::CharacterType::get(builder.getContext(), 1, str.size()); + auto global = builder.getNamedGlobal(globalName); + if (!global) + global = builder.createGlobalConstant( + loc, type, globalName, + [&](fir::FirOpBuilder &builder) { + auto stringLitOp = builder.createStringLitOp(loc, str); + builder.create(loc, stringLitOp); + }, + builder.createLinkOnceLinkage()); + auto addr = builder.create(loc, global.resultType(), + global.getSymbol()); + auto len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), str.size()); + return fir::CharBoxValue{addr, len}; +} + +llvm::SmallVector +fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc, + fir::SequenceType seqTy) { + llvm::SmallVector extents; + auto idxTy = builder.getIndexType(); + for (auto ext : seqTy.getShape()) + extents.emplace_back( + ext == fir::SequenceType::getUnknownExtent() + ? builder.create(loc, idxTy).getResult() + : builder.createIntegerConstant(loc, idxTy, ext)); + return extents; +} + +// FIXME: This needs some work. To correctly determine the extended value of a +// component, one needs the base object, its type, and its type parameters. (An +// alternative would be to provide an already computed address of the final +// component rather than the base object's address, the point being the result +// will require the address of the final component to create the extended +// value.) One further needs the full path of components being applied. One +// needs to apply type-based expressions to type parameters along this said +// path. (See applyPathToType for a type-only derivation.) Finally, one needs to +// compose the extended value of the terminal component, including all of its +// parameters: array lower bounds expressions, extents, type parameters, etc. +// Any of these properties may be deferred until runtime in Fortran. This +// operation may therefore generate a sizeable block of IR, including calls to +// type-based helper functions, so caching the result of this operation in the +// client would be advised as well. +fir::ExtendedValue fir::factory::componentToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) { + auto fieldTy = component.getType(); + if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy)) + fieldTy = ty; + if (fieldTy.isa()) { + llvm::SmallVector nonDeferredTypeParams; + auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy)); + if (auto charTy = eleTy.dyn_cast()) { + auto lenTy = builder.getCharacterLengthType(); + if (charTy.hasConstantLen()) + nonDeferredTypeParams.emplace_back( + builder.createIntegerConstant(loc, lenTy, charTy.getLen())); + // TODO: Starting, F2003, the dynamic character length might be dependent + // on a PDT length parameter. There is no way to make a difference with + // deferred length here yet. + } + if (auto recTy = eleTy.dyn_cast()) + if (recTy.getNumLenParams() > 0) + TODO(loc, "allocatable and pointer components non deferred length " + "parameters"); + + return fir::MutableBoxValue(component, nonDeferredTypeParams, + /*mutableProperties=*/{}); + } + llvm::SmallVector extents; + if (auto seqTy = fieldTy.dyn_cast()) { + fieldTy = seqTy.getEleTy(); + auto idxTy = builder.getIndexType(); + for (auto extent : seqTy.getShape()) { + if (extent == fir::SequenceType::getUnknownExtent()) + TODO(loc, "array component shape depending on length parameters"); + extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent)); + } + } + if (auto charTy = fieldTy.dyn_cast()) { + auto cstLen = charTy.getLen(); + if (cstLen == fir::CharacterType::unknownLen()) + TODO(loc, "get character component length from length type parameters"); + auto len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), cstLen); + if (!extents.empty()) + return fir::CharArrayBoxValue{component, len, extents}; + return fir::CharBoxValue{component, len}; + } + if (auto recordTy = fieldTy.dyn_cast()) + if (recordTy.getNumLenParams() != 0) + TODO(loc, + "lower component ref that is a derived type with length parameter"); + if (!extents.empty()) + return fir::ArrayBoxValue{component, extents}; + return component; +} + +fir::ExtendedValue fir::factory::arrayElementToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &array, mlir::Value element) { + return array.match( + [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue { + return cb.clone(element); + }, + [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue { + return bv.cloneElement(element); + }, + [&](const fir::BoxValue &box) -> fir::ExtendedValue { + if (box.isCharacter()) { + auto len = fir::factory::readCharLen(builder, loc, box); + return fir::CharBoxValue{element, len}; + } + if (box.isDerivedWithLengthParameters()) + TODO(loc, "get length parameters from derived type BoxValue"); + return element; + }, + [&](const auto &) -> fir::ExtendedValue { return element; }); +} + +fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) { + if (!slice) + return arrayElementToExtendedValue(builder, loc, array, element); + auto sliceOp = mlir::dyn_cast_or_null(slice.getDefiningOp()); + assert(sliceOp && "slice must be a sliceOp"); + if (sliceOp.fields().empty()) + return arrayElementToExtendedValue(builder, loc, array, element); + // For F95, using componentToExtendedValue will work, but when PDTs are + // lowered. It will be required to go down the slice to propagate the length + // parameters. + return fir::factory::componentToExtendedValue(builder, loc, element); +} + +/// Can the assignment of this record type be implement with a simple memory +/// copy ? +static bool recordTypeCanBeMemCopied(fir::RecordType recordType) { + if (fir::hasDynamicSize(recordType)) + return false; + for (auto [_, fieldType] : recordType.getTypeList()) { + // Derived type component may have user assignment (so far, we cannot tell + // in FIR, so assume it is always the case, TODO: get the actual info). + if (fir::unwrapSequenceType(fieldType).isa()) + return false; + // Allocatable components need deep copy. + if (auto boxType = fieldType.dyn_cast()) + if (boxType.getEleTy().isa()) + return false; + } + // Constant size components without user defined assignment and pointers can + // be memcopied. + return true; +} + +void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs) { + assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment"); + auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType()); + assert(baseTy && "must be a memory type"); + // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3 + // if the assignment is performed on the dynamic of declared type. Use the + // runtime assuming it is performed on the dynamic type. + bool hasBoxOperands = fir::getBase(lhs).getType().isa() || + fir::getBase(rhs).getType().isa(); + auto recTy = baseTy.dyn_cast(); + assert(recTy && "must be a record type"); + if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) { + auto to = fir::getBase(builder.createBox(loc, lhs)); + auto from = fir::getBase(builder.createBox(loc, rhs)); + // The runtime entry point may modify the LHS descriptor if it is + // an allocatable. Allocatable assignment is handle elsewhere in lowering, + // so just create a fir.ref> from the fir.box to comply with the + // runtime interface, but assume the fir.box is unchanged. + // TODO: does this holds true with polymorphic entities ? + auto toMutableBox = builder.createTemporary(loc, to.getType()); + builder.create(loc, to, toMutableBox); + fir::runtime::genAssign(builder, loc, toMutableBox, from); + return; + } + // Otherwise, the derived type has compile time constant size and for which + // the component by component assignment can be replaced by a memory copy. + auto load = builder.create(loc, fir::getBase(rhs)); + builder.create(loc, load, fir::getBase(lhs)); +} + +mlir::TupleType +fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) { + auto i64Ty = builder.getIntegerType(64); + auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1); + auto buffTy = fir::HeapType::get(arrTy); + auto extTy = fir::SequenceType::get(i64Ty, 1); + auto shTy = fir::HeapType::get(extTy); + return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy}); +} diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -0,0 +1,745 @@ +//===-- MutableBox.cpp -- MutableBox utilities ----------------------------===// +// +// 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/Optimizer/Builder/MutableBox.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/Character.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Support/FatalError.h" + +//===----------------------------------------------------------------------===// +// MutableBoxValue writer and reader +//===----------------------------------------------------------------------===// + +namespace { +/// MutablePropertyWriter and MutablePropertyReader implementations are the only +/// places that depend on how the properties of MutableBoxValue (pointers and +/// allocatables) that can be modified in the lifetime of the entity (address, +/// extents, lower bounds, length parameters) are represented. +/// That is, the properties may be only stored in a fir.box in memory if we +/// need to enforce a single point of truth for the properties across calls. +/// Or, they can be tracked as independent local variables when it is safe to +/// do so. Using bare variables benefits from all optimization passes, even +/// when they are not aware of what a fir.box is and fir.box have not been +/// optimized out yet. + +/// MutablePropertyWriter allows reading the properties of a MutableBoxValue. +class MutablePropertyReader { +public: + MutablePropertyReader(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + bool forceIRBoxRead = false) + : builder{builder}, loc{loc}, box{box} { + if (forceIRBoxRead || !box.isDescribedByVariables()) + irBox = builder.create(loc, box.getAddr()); + } + /// Get base address of allocated/associated entity. + mlir::Value readBaseAddress() { + if (irBox) { + auto heapOrPtrTy = box.getBoxTy().getEleTy(); + return builder.create(loc, heapOrPtrTy, irBox); + } + auto addrVar = box.getMutableProperties().addr; + return builder.create(loc, addrVar); + } + /// Return {lbound, extent} values read from the MutableBoxValue given + /// the dimension. + std::pair readShape(unsigned dim) { + auto idxTy = builder.getIndexType(); + if (irBox) { + auto dimVal = builder.createIntegerConstant(loc, idxTy, dim); + auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, + irBox, dimVal); + return {dimInfo.getResult(0), dimInfo.getResult(1)}; + } + const auto &mutableProperties = box.getMutableProperties(); + auto lb = builder.create(loc, mutableProperties.lbounds[dim]); + auto ext = builder.create(loc, mutableProperties.extents[dim]); + return {lb, ext}; + } + + /// Return the character length. If the length was not deferred, the value + /// that was specified is returned (The mutable fields is not read). + mlir::Value readCharacterLength() { + if (box.hasNonDeferredLenParams()) + return box.nonDeferredLenParams()[0]; + if (irBox) + return fir::factory::CharacterExprHelper{builder, loc}.readLengthFromBox( + irBox); + const auto &deferred = box.getMutableProperties().deferredParams; + if (deferred.empty()) + fir::emitFatalError(loc, "allocatable entity has no length property"); + return builder.create(loc, deferred[0]); + } + + /// Read and return all extents. If \p lbounds vector is provided, lbounds are + /// also read into it. + llvm::SmallVector + readShape(llvm::SmallVectorImpl *lbounds = nullptr) { + llvm::SmallVector extents; + auto rank = box.rank(); + for (decltype(rank) dim = 0; dim < rank; ++dim) { + auto [lb, extent] = readShape(dim); + if (lbounds) + lbounds->push_back(lb); + extents.push_back(extent); + } + return extents; + } + + /// Read all mutable properties. Return the base address. + mlir::Value read(llvm::SmallVectorImpl &lbounds, + llvm::SmallVectorImpl &extents, + llvm::SmallVectorImpl &lengths) { + extents = readShape(&lbounds); + if (box.isCharacter()) + lengths.emplace_back(readCharacterLength()); + else if (box.isDerivedWithLengthParameters()) + TODO(loc, "read allocatable or pointer derived type LEN parameters"); + return readBaseAddress(); + } + + /// Return the loaded fir.box. + mlir::Value getIrBox() const { + assert(irBox); + return irBox; + } + + /// Read the lower bounds + void getLowerBounds(llvm::SmallVectorImpl &lbounds) { + auto rank = box.rank(); + for (decltype(rank) dim = 0; dim < rank; ++dim) + lbounds.push_back(std::get<0>(readShape(dim))); + } + +private: + fir::FirOpBuilder &builder; + mlir::Location loc; + fir::MutableBoxValue box; + mlir::Value irBox; +}; + +/// MutablePropertyWriter allows modifying the properties of a MutableBoxValue. +class MutablePropertyWriter { +public: + MutablePropertyWriter(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box) + : builder{builder}, loc{loc}, box{box} {} + /// Update MutableBoxValue with new address, shape and length parameters. + /// Extents and lbounds must all have index type. + /// lbounds can be empty in which case all ones is assumed. + /// Length parameters must be provided for the length parameters that are + /// deferred. + void updateMutableBox(mlir::Value addr, mlir::ValueRange lbounds, + mlir::ValueRange extents, mlir::ValueRange lengths) { + if (box.isDescribedByVariables()) + updateMutableProperties(addr, lbounds, extents, lengths); + else + updateIRBox(addr, lbounds, extents, lengths); + } + + /// Update MutableBoxValue with a new fir.box. This requires that the mutable + /// box is not described by a set of variables, since they could not describe + /// all that can be described in the new fir.box (e.g. non contiguous entity). + void updateWithIrBox(mlir::Value newBox) { + assert(!box.isDescribedByVariables()); + builder.create(loc, newBox, box.getAddr()); + } + /// Set unallocated/disassociated status for the entity described by + /// MutableBoxValue. Deallocation is not performed by this helper. + void setUnallocatedStatus() { + if (box.isDescribedByVariables()) { + auto addrVar = box.getMutableProperties().addr; + auto nullTy = fir::dyn_cast_ptrEleTy(addrVar.getType()); + builder.create(loc, builder.createNullConstant(loc, nullTy), + addrVar); + } else { + // Note that the dynamic type of polymorphic entities must be reset to the + // declaration type of the mutable box. See Fortran 2018 7.8.2 NOTE 1. + // For those, we cannot simply set the address to zero. The way we are + // currently unallocating fir.box guarantees that we are resetting the + // type to the declared type. Beware if changing this. + // Note: the standard is not clear in Deallocate and p => NULL semantics + // regarding the new dynamic type the entity must have. So far, assume + // this is just like NULLIFY and the dynamic type must be set to the + // declared type, not retain the previous dynamic type. + auto deallocatedBox = fir::factory::createUnallocatedBox( + builder, loc, box.getBoxTy(), box.nonDeferredLenParams()); + builder.create(loc, deallocatedBox, box.getAddr()); + } + } + + /// Copy Values from the fir.box into the property variables if any. + void syncMutablePropertiesFromIRBox() { + if (!box.isDescribedByVariables()) + return; + llvm::SmallVector lbounds; + llvm::SmallVector extents; + llvm::SmallVector lengths; + auto addr = + MutablePropertyReader{builder, loc, box, /*forceIRBoxRead=*/true}.read( + lbounds, extents, lengths); + updateMutableProperties(addr, lbounds, extents, lengths); + } + + /// Copy Values from property variables, if any, into the fir.box. + void syncIRBoxFromMutableProperties() { + if (!box.isDescribedByVariables()) + return; + llvm::SmallVector lbounds; + llvm::SmallVector extents; + llvm::SmallVector lengths; + auto addr = MutablePropertyReader{builder, loc, box}.read(lbounds, extents, + lengths); + updateIRBox(addr, lbounds, extents, lengths); + } + +private: + /// Update the IR box (fir.ref>) of the MutableBoxValue. + void updateIRBox(mlir::Value addr, mlir::ValueRange lbounds, + mlir::ValueRange extents, mlir::ValueRange lengths) { + mlir::Value shape; + if (!extents.empty()) { + if (lbounds.empty()) { + auto shapeType = + fir::ShapeType::get(builder.getContext(), extents.size()); + shape = builder.create(loc, shapeType, extents); + } else { + llvm::SmallVector shapeShiftBounds; + for (auto [lb, extent] : llvm::zip(lbounds, extents)) { + shapeShiftBounds.emplace_back(lb); + shapeShiftBounds.emplace_back(extent); + } + auto shapeShiftType = + fir::ShapeShiftType::get(builder.getContext(), extents.size()); + shape = builder.create(loc, shapeShiftType, + shapeShiftBounds); + } + } + mlir::Value emptySlice; + // Ignore lengths if already constant in the box type (this would trigger an + // error in the embox). + llvm::SmallVector cleanedLengths; + mlir::Value irBox; + if (addr.getType().isa()) { + // The entity is already boxed. + irBox = builder.createConvert(loc, box.getBoxTy(), addr); + } else { + auto cleanedAddr = addr; + if (auto charTy = box.getEleTy().dyn_cast()) { + // Cast address to box type so that both input and output type have + // unknown or constant lengths. + auto bt = box.getBaseTy(); + auto addrTy = addr.getType(); + auto type = addrTy.isa() ? fir::HeapType::get(bt) + : addrTy.isa() ? fir::PointerType::get(bt) + : builder.getRefType(bt); + cleanedAddr = builder.createConvert(loc, type, addr); + if (charTy.getLen() == fir::CharacterType::unknownLen()) + cleanedLengths.append(lengths.begin(), lengths.end()); + } else if (box.isDerivedWithLengthParameters()) { + TODO(loc, "updating mutablebox of derived type with length parameters"); + cleanedLengths = lengths; + } + irBox = builder.create(loc, box.getBoxTy(), cleanedAddr, + shape, emptySlice, cleanedLengths); + } + builder.create(loc, irBox, box.getAddr()); + } + + /// Update the set of property variables of the MutableBoxValue. + void updateMutableProperties(mlir::Value addr, mlir::ValueRange lbounds, + mlir::ValueRange extents, + mlir::ValueRange lengths) { + auto castAndStore = [&](mlir::Value val, mlir::Value addr) { + auto type = fir::dyn_cast_ptrEleTy(addr.getType()); + builder.create(loc, builder.createConvert(loc, type, val), + addr); + }; + const auto &mutableProperties = box.getMutableProperties(); + castAndStore(addr, mutableProperties.addr); + for (auto [extent, extentVar] : + llvm::zip(extents, mutableProperties.extents)) + castAndStore(extent, extentVar); + if (!mutableProperties.lbounds.empty()) { + if (lbounds.empty()) { + auto one = + builder.createIntegerConstant(loc, builder.getIndexType(), 1); + for (auto lboundVar : mutableProperties.lbounds) + castAndStore(one, lboundVar); + } else { + for (auto [lbound, lboundVar] : + llvm::zip(lbounds, mutableProperties.lbounds)) + castAndStore(lbound, lboundVar); + } + } + if (box.isCharacter()) + // llvm::zip account for the fact that the length only needs to be stored + // when it is specified in the allocation and deferred in the + // MutableBoxValue. + for (auto [len, lenVar] : + llvm::zip(lengths, mutableProperties.deferredParams)) + castAndStore(len, lenVar); + else if (box.isDerivedWithLengthParameters()) + TODO(loc, "update allocatable derived type length parameters"); + } + fir::FirOpBuilder &builder; + mlir::Location loc; + fir::MutableBoxValue box; +}; + +} // namespace + +mlir::Value +fir::factory::createUnallocatedBox(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type boxType, + mlir::ValueRange nonDeferredParams) { + auto heapType = boxType.dyn_cast().getEleTy(); + auto type = fir::dyn_cast_ptrEleTy(heapType); + auto eleTy = type; + if (auto seqType = eleTy.dyn_cast()) + eleTy = seqType.getEleTy(); + if (auto recTy = eleTy.dyn_cast()) + if (recTy.getNumLenParams() > 0) + TODO(loc, "creating unallocated fir.box of derived type with length " + "parameters"); + auto nullAddr = builder.createNullConstant(loc, heapType); + mlir::Value shape; + if (auto seqTy = type.dyn_cast()) { + auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + llvm::SmallVector extents(seqTy.getDimension(), zero); + shape = builder.createShape( + loc, fir::ArrayBoxValue{nullAddr, extents, /*lbounds=*/llvm::None}); + } + // Provide dummy length parameters if they are dynamic. If a length parameter + // is deferred. it is set to zero here and will be set on allocation. + llvm::SmallVector lenParams; + if (auto charTy = eleTy.dyn_cast()) { + if (charTy.getLen() == fir::CharacterType::unknownLen()) { + if (!nonDeferredParams.empty()) { + lenParams.push_back(nonDeferredParams[0]); + } else { + auto zero = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), 0); + lenParams.push_back(zero); + } + } + } + mlir::Value emptySlice; + return builder.create(loc, boxType, nullAddr, shape, emptySlice, + lenParams); +} + +fir::MutableBoxValue +fir::factory::createTempMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type type, + llvm::StringRef name) { + auto boxType = fir::BoxType::get(fir::HeapType::get(type)); + auto boxAddr = builder.createTemporary(loc, boxType, name); + auto box = + fir::MutableBoxValue(boxAddr, /*nonDeferredParams=*/mlir::ValueRange(), + /*mutableProperties=*/{}); + MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); + return box; +} + +/// Helper to decide if a MutableBoxValue must be read to an BoxValue or +/// can be read to a reified box value. +static bool readToBoxValue(const fir::MutableBoxValue &box, + bool mayBePolymorphic) { + // If this is described by a set of local variables, the value + // should not be tracked as a fir.box. + if (box.isDescribedByVariables()) + return false; + // Polymorphism might be a source of discontiguity, even on allocatables. + // Track value as fir.box + if ((box.isDerived() && mayBePolymorphic) || box.isUnlimitedPolymorphic()) + return true; + // Intrinsic alloctables are contiguous, no need to track the value by + // fir.box. + if (box.isAllocatable() || box.rank() == 0) + return false; + // Pointer are known to be contiguous at compile time iff they have the + // CONTIGUOUS attribute. + return !fir::valueHasFirAttribute(box.getAddr(), + fir::getContiguousAttrName()); +} + +fir::ExtendedValue +fir::factory::genMutableBoxRead(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + bool mayBePolymorphic) { + if (box.hasAssumedRank()) + TODO(loc, "Assumed rank allocatables or pointers"); + llvm::SmallVector lbounds; + llvm::SmallVector extents; + llvm::SmallVector lengths; + if (readToBoxValue(box, mayBePolymorphic)) { + auto reader = MutablePropertyReader(builder, loc, box); + reader.getLowerBounds(lbounds); + return fir::BoxValue{reader.getIrBox(), lbounds, + box.nonDeferredLenParams()}; + } + // Contiguous intrinsic type entity: all the data can be extracted from the + // fir.box. + auto addr = + MutablePropertyReader(builder, loc, box).read(lbounds, extents, lengths); + auto rank = box.rank(); + if (box.isCharacter()) { + auto len = lengths.empty() ? mlir::Value{} : lengths[0]; + if (rank) + return fir::CharArrayBoxValue{addr, len, extents, lbounds}; + return fir::CharBoxValue{addr, len}; + } + if (rank) + return fir::ArrayBoxValue{addr, extents, lbounds}; + return addr; +} + +mlir::Value +fir::factory::genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); + return builder.genIsNotNull(loc, addr); +} + +/// Generate finalizer call and inlined free. This does not check that the +/// address was allocated. +static void genFinalizeAndFree(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value addr) { + // TODO: call finalizer if any. + + // A heap (ALLOCATABLE) object may have been converted to a ptr (POINTER), + // so make sure the heap type is restored before deallocation. + auto cast = builder.createConvert( + loc, fir::HeapType::get(fir::dyn_cast_ptrEleTy(addr.getType())), addr); + builder.create(loc, cast); +} + +void fir::factory::genFinalization(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); + auto isAllocated = builder.genIsNotNull(loc, addr); + auto ifOp = builder.create(loc, isAllocated, + /*withElseRegion=*/false); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(&ifOp.thenRegion().front()); + genFinalizeAndFree(builder, loc, addr); + builder.restoreInsertionPoint(insPt); +} + +//===----------------------------------------------------------------------===// +// MutableBoxValue writing interface implementation +//===----------------------------------------------------------------------===// + +void fir::factory::associateMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + const fir::ExtendedValue &source, + mlir::ValueRange lbounds) { + MutablePropertyWriter writer(builder, loc, box); + source.match( + [&](const fir::UnboxedValue &addr) { + writer.updateMutableBox(addr, /*lbounds=*/llvm::None, + /*extents=*/llvm::None, /*lengths=*/llvm::None); + }, + [&](const fir::CharBoxValue &ch) { + writer.updateMutableBox(ch.getAddr(), /*lbounds=*/llvm::None, + /*extents=*/llvm::None, {ch.getLen()}); + }, + [&](const fir::ArrayBoxValue &arr) { + writer.updateMutableBox(arr.getAddr(), + lbounds.empty() ? arr.getLBounds() : lbounds, + arr.getExtents(), /*lengths=*/llvm::None); + }, + [&](const fir::CharArrayBoxValue &arr) { + writer.updateMutableBox(arr.getAddr(), + lbounds.empty() ? arr.getLBounds() : lbounds, + arr.getExtents(), {arr.getLen()}); + }, + [&](const fir::BoxValue &arr) { + // Rebox array fir.box to the pointer type and apply potential new lower + // bounds. + mlir::ValueRange newLbounds = lbounds.empty() + ? mlir::ValueRange{arr.getLBounds()} + : mlir::ValueRange{lbounds}; + if (box.isDescribedByVariables()) { + // LHS is a contiguous pointer described by local variables. Open RHS + // fir.box to update the LHS. + auto rawAddr = builder.create(loc, arr.getMemTy(), + arr.getAddr()); + auto extents = fir::factory::getExtents(builder, loc, source); + llvm::SmallVector lenParams; + if (arr.isCharacter()) { + lenParams.emplace_back( + fir::factory::readCharLen(builder, loc, source)); + } else if (arr.isDerivedWithLengthParameters()) { + TODO(loc, "pointer assignment to derived with length parameters"); + } + writer.updateMutableBox(rawAddr, newLbounds, extents, lenParams); + } else { + mlir::Value shift; + if (!newLbounds.empty()) { + auto shiftType = + fir::ShiftType::get(builder.getContext(), newLbounds.size()); + shift = builder.create(loc, shiftType, newLbounds); + } + auto reboxed = + builder.create(loc, box.getBoxTy(), arr.getAddr(), + shift, /*slice=*/mlir::Value()); + writer.updateWithIrBox(reboxed); + } + }, + [&](const fir::MutableBoxValue &) { + // No point implementing this, if right-hand side is a + // pointer/allocatable, the related MutableBoxValue has been read into + // another ExtendedValue category. + fir::emitFatalError(loc, + "Cannot write MutableBox to another MutableBox"); + }, + [&](const fir::ProcBoxValue &) { + TODO(loc, "Procedure pointer assignment"); + }); +} + +void fir::factory::associateMutableBoxWithRemap( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, const fir::ExtendedValue &source, + mlir::ValueRange lbounds, mlir::ValueRange ubounds) { + // Compute new extents + llvm::SmallVector extents; + auto idxTy = builder.getIndexType(); + if (!lbounds.empty()) { + auto one = builder.createIntegerConstant(loc, idxTy, 1); + for (auto [lb, ub] : llvm::zip(lbounds, ubounds)) { + auto lbi = builder.createConvert(loc, idxTy, lb); + auto ubi = builder.createConvert(loc, idxTy, ub); + auto diff = builder.create(loc, idxTy, ubi, lbi); + extents.emplace_back(builder.create(loc, idxTy, diff, one)); + } + } else { + // lbounds are default. Upper bounds and extents are the same. + for (auto ub : ubounds) { + auto cast = builder.createConvert(loc, idxTy, ub); + extents.emplace_back(cast); + } + } + const auto newRank = extents.size(); + auto cast = [&](mlir::Value addr) -> mlir::Value { + // Cast base addr to new sequence type. + auto ty = fir::dyn_cast_ptrEleTy(addr.getType()); + if (auto seqTy = ty.dyn_cast()) { + fir::SequenceType::Shape shape(newRank, + fir::SequenceType::getUnknownExtent()); + ty = fir::SequenceType::get(shape, seqTy.getEleTy()); + } + return builder.createConvert(loc, builder.getRefType(ty), addr); + }; + MutablePropertyWriter writer(builder, loc, box); + source.match( + [&](const fir::UnboxedValue &addr) { + writer.updateMutableBox(cast(addr), lbounds, extents, + /*lengths=*/llvm::None); + }, + [&](const fir::CharBoxValue &ch) { + writer.updateMutableBox(cast(ch.getAddr()), lbounds, extents, + {ch.getLen()}); + }, + [&](const fir::ArrayBoxValue &arr) { + writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents, + /*lengths=*/llvm::None); + }, + [&](const fir::CharArrayBoxValue &arr) { + writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents, + {arr.getLen()}); + }, + [&](const fir::BoxValue &arr) { + // Rebox right-hand side fir.box with a new shape and type. + if (box.isDescribedByVariables()) { + // LHS is a contiguous pointer described by local variables. Open RHS + // fir.box to update the LHS. + auto rawAddr = builder.create(loc, arr.getMemTy(), + arr.getAddr()); + llvm::SmallVector lenParams; + if (arr.isCharacter()) { + lenParams.emplace_back( + fir::factory::readCharLen(builder, loc, source)); + } else if (arr.isDerivedWithLengthParameters()) { + TODO(loc, "pointer assignment to derived with length parameters"); + } + writer.updateMutableBox(rawAddr, lbounds, extents, lenParams); + } else { + auto shapeType = + fir::ShapeShiftType::get(builder.getContext(), extents.size()); + llvm::SmallVector shapeArgs; + auto idxTy = builder.getIndexType(); + for (auto [lbnd, ext] : llvm::zip(lbounds, extents)) { + auto lb = builder.createConvert(loc, idxTy, lbnd); + shapeArgs.push_back(lb); + shapeArgs.push_back(ext); + } + auto shape = + builder.create(loc, shapeType, shapeArgs); + auto reboxed = + builder.create(loc, box.getBoxTy(), arr.getAddr(), + shape, /*slice=*/mlir::Value()); + writer.updateWithIrBox(reboxed); + } + }, + [&](const fir::MutableBoxValue &) { + // No point implementing this, if right-hand side is a pointer or + // allocatable, the related MutableBoxValue has already been read into + // another ExtendedValue category. + fir::emitFatalError(loc, + "Cannot write MutableBox to another MutableBox"); + }, + [&](const fir::ProcBoxValue &) { + TODO(loc, "Procedure pointer assignment"); + }); +} + +void fir::factory::disassociateMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); +} + +void fir::factory::genInlinedAllocation(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, + mlir::ValueRange extents, + mlir::ValueRange lenParams, + llvm::StringRef allocName) { + auto idxTy = builder.getIndexType(); + llvm::SmallVector lengths; + if (auto charTy = box.getEleTy().dyn_cast()) { + if (charTy.getLen() == fir::CharacterType::unknownLen()) { + if (box.hasNonDeferredLenParams()) + lengths.emplace_back( + builder.createConvert(loc, idxTy, box.nonDeferredLenParams()[0])); + else if (!lenParams.empty()) + lengths.emplace_back(builder.createConvert(loc, idxTy, lenParams[0])); + else + fir::emitFatalError( + loc, "could not deduce character lengths in character allocation"); + } + } + mlir::Value heap = builder.create( + loc, box.getBaseTy(), allocName, lengths, extents); + // TODO: run initializer if any. Currently, there is no way to know this is + // required here. + MutablePropertyWriter{builder, loc, box}.updateMutableBox(heap, lbounds, + extents, lengths); +} + +void fir::factory::genInlinedDeallocate(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); + genFinalizeAndFree(builder, loc, addr); + MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); +} + +void fir::factory::genReallocIfNeeded(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, + mlir::ValueRange shape, + mlir::ValueRange lengthParams) { + // Implement 10.2.1.3 point 3 logic when lhs is an array. + auto reader = MutablePropertyReader(builder, loc, box); + auto addr = reader.readBaseAddress(); + auto isAllocated = builder.genIsNotNull(loc, addr); + builder.genIfThenElse(loc, isAllocated) + .genThen([&]() { + // The box is allocated. Check if it must be reallocated and reallocate. + mlir::Value mustReallocate = builder.createBool(loc, false); + auto compareProperty = [&](mlir::Value previous, mlir::Value required) { + auto castPrevious = + builder.createConvert(loc, required.getType(), previous); + // reallocate = reallocate || previous != required + auto cmp = builder.create(loc, mlir::CmpIPredicate::ne, + castPrevious, required); + mustReallocate = + builder.create(loc, cmp, cmp, mustReallocate); + }; + llvm::SmallVector previousLbounds; + llvm::SmallVector previousExtents = + reader.readShape(&previousLbounds); + if (!shape.empty()) + for (auto [previousExtent, requested] : + llvm::zip(previousExtents, shape)) + compareProperty(previousExtent, requested); + + if (box.isCharacter() && !box.hasNonDeferredLenParams()) { + // When the allocatable length is not deferred, it must not be + // reallocated in case of length mismatch, instead, padding/trimming + // will ocur in later assignment to it. + assert(!lengthParams.empty() && + "must provide length parameters for character"); + compareProperty(reader.readCharacterLength(), lengthParams[0]); + } else if (box.isDerivedWithLengthParameters()) { + TODO(loc, + "automatic allocation of derived type allocatable with length " + "parameters"); + } + builder.genIfThen(loc, mustReallocate) + .genThen([&]() { + // If shape or length mismatch, deallocate and reallocate. + genFinalizeAndFree(builder, loc, addr); + // When rhs is a scalar, keep the previous shape + auto extents = + shape.empty() ? mlir::ValueRange(previousExtents) : shape; + auto lbs = + shape.empty() ? mlir::ValueRange(previousLbounds) : lbounds; + genInlinedAllocation(builder, loc, box, lbs, extents, + lengthParams, ".auto.alloc"); + }) + .end(); + }) + .genElse([&]() { + // The box is not yet allocated, simply allocate it. + if (shape.empty() && box.rank() != 0) { + // TODO: + // runtime error: right hand side must be allocated if right hand + // side is a scalar and the box is an array. + } else { + genInlinedAllocation(builder, loc, box, lbounds, shape, lengthParams, + ".auto.alloc"); + } + }) + .end(); +} + +//===----------------------------------------------------------------------===// +// MutableBoxValue syncing implementation +//===----------------------------------------------------------------------===// + +/// Depending on the implementation, allocatable/pointer descriptor and the +/// MutableBoxValue need to be synced before and after calls passing the +/// descriptor. These calls will generate the syncing if needed and be no-op +mlir::Value fir::factory::getMutableIRBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + MutablePropertyWriter{builder, loc, box}.syncIRBoxFromMutableProperties(); + return box.getAddr(); +} +void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + MutablePropertyWriter{builder, loc, box}.syncMutablePropertiesFromIRBox(); +} diff --git a/flang/lib/Optimizer/Builder/Runtime/Assign.cpp b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp @@ -0,0 +1,26 @@ +//===-- Assign.cpp -- generate assignment runtime API calls ---------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/Runtime/Assign.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/Runtime/RTBuilder.h" +#include "flang/Runtime/assign.h" + +using namespace Fortran::runtime; + +void fir::runtime::genAssign(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value destBox, mlir::Value sourceBox) { + auto func = fir::runtime::getRuntimeFunc(loc, builder); + auto fTy = func.getType(); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(3)); + auto args = fir::runtime::createArguments(builder, loc, fTy, destBox, + sourceBox, sourceFile, sourceLine); + builder.create(loc, func, args); +} diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -1,3 +1,4 @@ +add_subdirectory(Builder) add_subdirectory(CodeGen) add_subdirectory(Dialect) add_subdirectory(Support) diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -1134,6 +1134,10 @@ // GlobalOp //===----------------------------------------------------------------------===// +mlir::Type fir::GlobalOp::resultType() { + return wrapAllocaResultType(getType()); +} + static ParseResult parseGlobalOp(OpAsmParser &parser, OperationState &result) { // Parse the optional linkage llvm::StringRef linkage; diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp --- a/flang/lib/Optimizer/Dialect/FIRType.cpp +++ b/flang/lib/Optimizer/Dialect/FIRType.cpp @@ -200,15 +200,15 @@ mlir::Type dyn_cast_ptrEleTy(mlir::Type t) { return llvm::TypeSwitch(t) - .Case( - [](auto p) { return p.getEleTy(); }) + .Case([](auto p) { return p.getEleTy(); }) .Default([](mlir::Type) { return mlir::Type{}; }); } mlir::Type dyn_cast_ptrOrBoxEleTy(mlir::Type t) { return llvm::TypeSwitch(t) - .Case( - [](auto p) { return p.getEleTy(); }) + .Case([](auto p) { return p.getEleTy(); }) .Case([](auto p) { auto eleTy = p.getEleTy(); if (auto ty = fir::dyn_cast_ptrEleTy(eleTy)) @@ -218,6 +218,34 @@ .Default([](mlir::Type) { return mlir::Type{}; }); } +static bool hasDynamicSize(fir::RecordType recTy) { + for (auto field : recTy.getTypeList()) { + if (auto arr = field.second.dyn_cast()) { + if (sequenceWithNonConstantShape(arr)) + return true; + } else if (characterWithDynamicLen(field.second)) { + return true; + } else if (auto rec = field.second.dyn_cast()) { + if (hasDynamicSize(rec)) + return true; + } + } + return false; +} + +bool hasDynamicSize(mlir::Type t) { + if (auto arr = t.dyn_cast()) { + if (sequenceWithNonConstantShape(arr)) + return true; + t = arr.getEleTy(); + } + if (characterWithDynamicLen(t)) + return true; + if (auto rec = t.dyn_cast()) + return hasDynamicSize(rec); + return false; +} + } // namespace fir namespace { @@ -443,6 +471,19 @@ printer << getMnemonic() << "<" << getFKind() << '>'; } +//===----------------------------------------------------------------------===// +// LLVMPointerType +//===----------------------------------------------------------------------===// + +// `llvm_ptr` `<` type `>` +mlir::Type fir::LLVMPointerType::parse(mlir::DialectAsmParser &parser) { + return parseTypeSingleton(parser); +} + +void fir::LLVMPointerType::print(mlir::DialectAsmPrinter &printer) const { + printer << getMnemonic() << "<" << getEleTy() << '>'; +} + //===----------------------------------------------------------------------===// // PointerType //===----------------------------------------------------------------------===// @@ -837,7 +878,7 @@ void FIROpsDialect::registerTypes() { addTypes(); + LLVMPointerType, PointerType, RealType, RecordType, ReferenceType, + SequenceType, ShapeType, ShapeShiftType, ShiftType, SliceType, + TypeDescType, fir::VectorType>(); } diff --git a/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp @@ -0,0 +1,891 @@ +//===-- ArrayValueCopy.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 +// +//===----------------------------------------------------------------------===// + +#include "PassDetail.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Support/FIRContext.h" +#include "flang/Optimizer/Transforms/Factory.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/Dialect/SCF/SCF.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-array-value-copy" + +using namespace fir; + +using OperationUseMapT = llvm::DenseMap; + +namespace { + +/// Array copy analysis. +/// Perform an interference analysis between array values. +/// +/// Lowering will generate a sequence of the following form. +/// ```mlir +/// %a_1 = fir.array_load %array_1(%shape) : ... +/// ... +/// %a_j = fir.array_load %array_j(%shape) : ... +/// ... +/// %a_n = fir.array_load %array_n(%shape) : ... +/// ... +/// %v_i = fir.array_fetch %a_i, ... +/// %a_j1 = fir.array_update %a_j, ... +/// ... +/// fir.array_merge_store %a_j, %a_jn to %array_j : ... +/// ``` +/// +/// The analysis is to determine if there are any conflicts. A conflict is when +/// one the following cases occurs. +/// +/// 1. There is an `array_update` to an array value, a_j, such that a_j was +/// loaded from the same array memory reference (array_j) but with a different +/// shape as the other array values a_i, where i != j. [Possible overlapping +/// arrays.] +/// +/// 2. There is either an array_fetch or array_update of a_j with a different +/// set of index values. [Possible loop-carried dependence.] +/// +/// If none of the array values overlap in storage and the accesses are not +/// loop-carried, then the arrays are conflict-free and no copies are required. +class ArrayCopyAnalysis { +public: + using ConflictSetT = llvm::SmallPtrSet; + using UseSetT = llvm::SmallPtrSet; + using LoadMapSetsT = llvm::DenseMap; + + ArrayCopyAnalysis(mlir::Operation *op) : operation{op} { + construct(op->getRegions()); + } + + mlir::Operation *getOperation() const { return operation; } + + /// Return true iff the `array_merge_store` has potential conflicts. + bool hasPotentialConflict(mlir::Operation *op) const { + LLVM_DEBUG(llvm::dbgs() + << "looking for a conflict on " << *op + << " and the set has a total of " << conflicts.size() << '\n'); + return conflicts.contains(op); + } + + /// Return the use map. The use map maps array fetch and update operations + /// back to the array load that is the original source of the array value. + const OperationUseMapT &getUseMap() const { return useMap; } + + /// For ArrayLoad `load`, return the transitive set of all OpOperands. + UseSetT getLoadUseSet(mlir::Operation *load) const { + assert(loadMapSets.count(load) && "analysis missed an array load?"); + return loadMapSets.lookup(load); + } + + /// Get all the array value operations that use the original array value + /// as passed to `store`. + void arrayAccesses(llvm::SmallVectorImpl &accesses, + ArrayLoadOp load); + +private: + void construct(mlir::MutableArrayRef regions); + + mlir::Operation *operation; // operation that analysis ran upon + ConflictSetT conflicts; // set of conflicts (loads and merge stores) + OperationUseMapT useMap; + LoadMapSetsT loadMapSets; +}; +} // namespace + +namespace { +/// Helper class to collect all array operations that produced an array value. +class ReachCollector { +public: + ReachCollector(llvm::SmallVectorImpl &reach, + mlir::Region *loopRegion) + : reach{reach}, loopRegion{loopRegion} {} + + void collectArrayAccessFrom(mlir::Operation *op, mlir::ValueRange range) { + if (range.empty()) { + collectArrayAccessFrom(op, mlir::Value{}); + return; + } + for (auto v : range) + collectArrayAccessFrom(v); + } + + void collectArrayAccessFrom(mlir::Operation *op, mlir::Value val) { + // `val` is defined by an Op, process the defining Op. + // If `val` is defined by a region containing Op, we want to drill down + // and through that Op's region(s). + LLVM_DEBUG(llvm::dbgs() << "popset: " << *op << '\n'); + auto popFn = [&](auto rop) { + assert(val && "op must have a result value"); + auto resNum = val.cast().getResultNumber(); + llvm::SmallVector results; + rop.resultToSourceOps(results, resNum); + for (auto u : results) + collectArrayAccessFrom(u); + }; + if (auto rop = mlir::dyn_cast(op)) { + popFn(rop); + return; + } + if (auto rop = mlir::dyn_cast(op)) { + popFn(rop); + return; + } + if (auto rop = mlir::dyn_cast(op)) { + popFn(rop); + return; + } + if (auto box = mlir::dyn_cast(op)) { + for (auto *user : box.memref().getUsers()) + if (user != op) + collectArrayAccessFrom(user, user->getResults()); + return; + } + if (auto mergeStore = mlir::dyn_cast(op)) { + if (opIsInsideLoops(mergeStore)) + collectArrayAccessFrom(mergeStore.sequence()); + return; + } + + if (mlir::isa(op)) { + // Look for any stores inside the loops, and collect an array operation + // that produced the value being stored to it. + for (auto *user : op->getUsers()) + if (auto store = mlir::dyn_cast(user)) + if (opIsInsideLoops(store)) + collectArrayAccessFrom(store.value()); + return; + } + + // Otherwise, Op does not contain a region so just chase its operands. + if (mlir::isa( + op)) { + LLVM_DEBUG(llvm::dbgs() << "add " << *op << " to reachable set\n"); + reach.emplace_back(op); + } + // Array modify assignment is performed on the result. So the analysis + // must look at the what is done with the result. + if (mlir::isa(op)) + for (auto *user : op->getResult(0).getUsers()) + followUsers(user); + + for (auto u : op->getOperands()) + collectArrayAccessFrom(u); + } + + void collectArrayAccessFrom(mlir::BlockArgument ba) { + auto *parent = ba.getOwner()->getParentOp(); + // If inside an Op holding a region, the block argument corresponds to an + // argument passed to the containing Op. + auto popFn = [&](auto rop) { + collectArrayAccessFrom(rop.blockArgToSourceOp(ba.getArgNumber())); + }; + if (auto rop = mlir::dyn_cast(parent)) { + popFn(rop); + return; + } + if (auto rop = mlir::dyn_cast(parent)) { + popFn(rop); + return; + } + // Otherwise, a block argument is provided via the pred blocks. + for (auto *pred : ba.getOwner()->getPredecessors()) { + auto u = pred->getTerminator()->getOperand(ba.getArgNumber()); + collectArrayAccessFrom(u); + } + } + + // Recursively trace operands to find all array operations relating to the + // values merged. + void collectArrayAccessFrom(mlir::Value val) { + if (!val || visited.contains(val)) + return; + visited.insert(val); + + // Process a block argument. + if (auto ba = val.dyn_cast()) { + collectArrayAccessFrom(ba); + return; + } + + // Process an Op. + if (auto *op = val.getDefiningOp()) { + collectArrayAccessFrom(op, val); + return; + } + + fir::emitFatalError(val.getLoc(), "unhandled value"); + } + + /// Return all ops that produce the array value that is stored into the + /// `array_merge_store`. + static void reachingValues(llvm::SmallVectorImpl &reach, + mlir::Value seq) { + reach.clear(); + mlir::Region *loopRegion = nullptr; + if (auto doLoop = + mlir::dyn_cast_or_null(seq.getDefiningOp())) + loopRegion = &doLoop->getRegion(0); + ReachCollector collector(reach, loopRegion); + collector.collectArrayAccessFrom(seq); + } + +private: + /// Is \op inside the loop nest region ? + /// FIXME: replace this structural dependence with graph properties. + bool opIsInsideLoops(mlir::Operation *op) const { + auto *region = op->getParentRegion(); + while (region) { + if (region == loopRegion) + return true; + region = region->getParentRegion(); + } + return false; + } + + /// Recursively trace the use of an operation results, calling + /// collectArrayAccessFrom on the direct and indirect user operands. + void followUsers(mlir::Operation *op) { + for (auto userOperand : op->getOperands()) + collectArrayAccessFrom(userOperand); + // Go through potential converts/coordinate_op. + for (auto indirectUser : op->getUsers()) + followUsers(indirectUser); + } + + llvm::SmallVectorImpl &reach; + llvm::SmallPtrSet visited; + /// Region of the loops nest that produced the array value. + mlir::Region *loopRegion; +}; +} // namespace + +/// Find all the array operations that access the array value that is loaded by +/// the array load operation, `load`. +void ArrayCopyAnalysis::arrayAccesses( + llvm::SmallVectorImpl &accesses, ArrayLoadOp load) { + accesses.clear(); + auto lmIter = loadMapSets.find(load); + if (lmIter != loadMapSets.end()) { + for (auto *opnd : lmIter->second) { + auto *owner = opnd->getOwner(); + if (mlir::isa(owner)) + accesses.push_back(owner); + } + return; + } + + UseSetT visited; + llvm::SmallVector queue; // uses of ArrayLoad[orig] + + auto appendToQueue = [&](mlir::Value val) { + for (auto &use : val.getUses()) + if (!visited.count(&use)) { + visited.insert(&use); + queue.push_back(&use); + } + }; + + // Build the set of uses of `original`. + // let USES = { uses of original fir.load } + appendToQueue(load); + + // Process the worklist until done. + while (!queue.empty()) { + auto *operand = queue.pop_back_val(); + auto *owner = operand->getOwner(); + if (!owner) + continue; + auto structuredLoop = [&](auto ro) { + if (auto blockArg = ro.iterArgToBlockArg(operand->get())) { + auto arg = blockArg.getArgNumber(); + auto output = ro.getResult(ro.finalValue() ? arg : arg - 1); + appendToQueue(output); + appendToQueue(blockArg); + } + }; + auto branchOp = [&](mlir::Block *dest, auto operands) { + for (auto i : llvm::enumerate(operands)) + if (operand->get() == i.value()) { + auto blockArg = dest->getArgument(i.index()); + appendToQueue(blockArg); + } + }; + // Thread uses into structured loop bodies and return value uses. + if (auto ro = mlir::dyn_cast(owner)) { + structuredLoop(ro); + } else if (auto ro = mlir::dyn_cast(owner)) { + structuredLoop(ro); + } else if (auto rs = mlir::dyn_cast(owner)) { + // Thread any uses of fir.if that return the marked array value. + auto *parent = rs->getParentRegion()->getParentOp(); + if (auto ifOp = mlir::dyn_cast(parent)) + appendToQueue(ifOp.getResult(operand->getOperandNumber())); + } else if (mlir::isa(owner)) { + // Keep track of array value fetches. + LLVM_DEBUG(llvm::dbgs() + << "add fetch {" << *owner << "} to array value set\n"); + accesses.push_back(owner); + } else if (auto update = mlir::dyn_cast(owner)) { + // Keep track of array value updates and thread the return value uses. + LLVM_DEBUG(llvm::dbgs() + << "add update {" << *owner << "} to array value set\n"); + accesses.push_back(owner); + appendToQueue(update.getResult()); + } else if (auto update = mlir::dyn_cast(owner)) { + // Keep track of array value modification and thread the return value + // uses. + LLVM_DEBUG(llvm::dbgs() + << "add modify {" << *owner << "} to array value set\n"); + accesses.push_back(owner); + appendToQueue(update.getResult(1)); + } else if (auto br = mlir::dyn_cast(owner)) { + branchOp(br.getDest(), br.destOperands()); + } else if (auto br = mlir::dyn_cast(owner)) { + branchOp(br.getTrueDest(), br.getTrueOperands()); + branchOp(br.getFalseDest(), br.getFalseOperands()); + } else if (mlir::isa(owner)) { + // do nothing + } else { + llvm::report_fatal_error("array value reached unexpected op"); + } + } + loadMapSets.insert({load, visited}); +} + +/// Is there a conflict between the array value that was updated and to be +/// stored to `st` and the set of arrays loaded (`reach`) and used to compute +/// the updated value? +static bool conflictOnLoad(llvm::ArrayRef reach, + ArrayMergeStoreOp st) { + mlir::Value load; + auto addr = st.memref(); + auto stEleTy = fir::dyn_cast_ptrOrBoxEleTy(addr.getType()); + for (auto *op : reach) + if (auto ld = mlir::dyn_cast(op)) { + auto ldTy = ld.memref().getType(); + if (auto boxTy = ldTy.dyn_cast()) + ldTy = boxTy.getEleTy(); + if (ldTy.isa() && stEleTy == dyn_cast_ptrEleTy(ldTy)) + return true; + if (ld.memref() == addr) { + if (ld.getResult() != st.original()) + return true; + if (load) + return true; + load = ld; + } + } + return false; +} + +static bool conflictOnMerge(llvm::ArrayRef accesses) { + if (accesses.size() < 2) + return false; + llvm::SmallVector indices; + LLVM_DEBUG(llvm::dbgs() << "check merge conflict on with " << accesses.size() + << " accesses on the list\n"); + for (auto *op : accesses) { + llvm::SmallVector compareVector; + if (auto u = mlir::dyn_cast(op)) { + if (indices.empty()) { + indices = u.indices(); + continue; + } + compareVector = u.indices(); + } else if (auto f = mlir::dyn_cast(op)) { + if (indices.empty()) { + indices = f.indices(); + continue; + } + compareVector = f.indices(); + } else if (auto f = mlir::dyn_cast(op)) { + if (indices.empty()) { + indices = f.indices(); + continue; + } + compareVector = f.indices(); + } else { + mlir::emitError(op->getLoc(), "unexpected operation in analysis"); + } + if (compareVector.size() != indices.size() || + llvm::any_of(llvm::zip(compareVector, indices), [&](auto pair) { + return std::get<0>(pair) != std::get<1>(pair); + })) + return true; + LLVM_DEBUG(llvm::dbgs() << "vectors compare equal\n"); + } + return false; +} + +// Are either of types of conflicts present? +inline bool conflictDetected(llvm::ArrayRef reach, + llvm::ArrayRef accesses, + ArrayMergeStoreOp st) { + return conflictOnLoad(reach, st) || conflictOnMerge(accesses); +} + +/// Constructor of the array copy analysis. +/// This performs the analysis and saves the intermediate results. +void ArrayCopyAnalysis::construct(mlir::MutableArrayRef regions) { + for (auto ®ion : regions) + for (auto &block : region.getBlocks()) + for (auto &op : block.getOperations()) { + if (op.getNumRegions()) + construct(op.getRegions()); + if (auto st = mlir::dyn_cast(op)) { + llvm::SmallVector values; + ReachCollector::reachingValues(values, st.sequence()); + llvm::SmallVector accesses; + arrayAccesses(accesses, + mlir::cast(st.original().getDefiningOp())); + if (conflictDetected(values, accesses, st)) { + LLVM_DEBUG(llvm::dbgs() + << "CONFLICT: copies required for " << st << '\n' + << " adding conflicts on: " << op << " and " + << st.original() << '\n'); + conflicts.insert(&op); + conflicts.insert(st.original().getDefiningOp()); + } + auto *ld = st.original().getDefiningOp(); + LLVM_DEBUG(llvm::dbgs() + << "map: adding {" << *ld << " -> " << st << "}\n"); + useMap.insert({ld, &op}); + } else if (auto load = mlir::dyn_cast(op)) { + llvm::SmallVector accesses; + arrayAccesses(accesses, load); + LLVM_DEBUG(llvm::dbgs() << "process load: " << load + << ", accesses: " << accesses.size() << '\n'); + for (auto *acc : accesses) { + LLVM_DEBUG(llvm::dbgs() << " access: " << *acc << '\n'); + if (mlir::isa(acc)) { + if (useMap.count(acc)) { + mlir::emitError( + load.getLoc(), + "The parallel semantics of multiple array_merge_stores per " + "array_load are not supported."); + continue; + } + LLVM_DEBUG(llvm::dbgs() << "map: adding {" << *acc << "} -> {" + << load << "}\n"); + useMap.insert({acc, &op}); + } + } + } + } +} + +namespace { +class ArrayLoadConversion : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(ArrayLoadOp load, + mlir::PatternRewriter &rewriter) const override { + LLVM_DEBUG(llvm::dbgs() << "replace load " << load << " with undef.\n"); + rewriter.replaceOpWithNewOp(load, load.getType()); + return mlir::success(); + } +}; + +class ArrayMergeStoreConversion + : public mlir::OpRewritePattern { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(ArrayMergeStoreOp store, + mlir::PatternRewriter &rewriter) const override { + LLVM_DEBUG(llvm::dbgs() << "marking store " << store << " as dead.\n"); + rewriter.eraseOp(store); + return mlir::success(); + } +}; +} // namespace + +static mlir::Type getEleTy(mlir::Type ty) { + if (auto t = dyn_cast_ptrEleTy(ty)) + ty = t; + if (auto t = ty.dyn_cast()) + ty = t.getEleTy(); + // FIXME: keep ptr/heap/ref information. + return ReferenceType::get(ty); +} + +// Extract extents from the ShapeOp/ShapeShiftOp into the result vector. +static void getExtents(llvm::SmallVectorImpl &result, + mlir::Value shape) { + auto *shapeOp = shape.getDefiningOp(); + if (auto s = mlir::dyn_cast(shapeOp)) { + auto e = s.getExtents(); + result.insert(result.end(), e.begin(), e.end()); + return; + } + if (auto s = mlir::dyn_cast(shapeOp)) { + auto e = s.getExtents(); + result.insert(result.end(), e.begin(), e.end()); + return; + } + llvm::report_fatal_error("not a fir.shape/fir.shape_shift op"); +} + +// Place the extents of the array loaded by an ArrayLoadOp into the result +// vector and return a ShapeOp/ShapeShiftOp with the corresponding extents. If +// the ArrayLoadOp is loading a fir.box, code will be generated to read the +// extents from the fir.box, and a the retunred ShapeOp is built with the read +// extents. +// Otherwise, the extents will be extracted from the ShapeOp/ShapeShiftOp +// argument of the ArrayLoadOp that is returned. +static mlir::Value +getOrReadExtentsAndShapeOp(mlir::Location loc, mlir::PatternRewriter &rewriter, + fir::ArrayLoadOp loadOp, + llvm::SmallVectorImpl &result) { + assert(result.empty()); + if (auto boxTy = loadOp.memref().getType().dyn_cast()) { + auto rank = fir::dyn_cast_ptrOrBoxEleTy(boxTy) + .cast() + .getDimension(); + auto idxTy = rewriter.getIndexType(); + for (decltype(rank) dim = 0; dim < rank; ++dim) { + auto dimVal = rewriter.create(loc, dim); + auto dimInfo = rewriter.create(loc, idxTy, idxTy, idxTy, + loadOp.memref(), dimVal); + result.emplace_back(dimInfo.getResult(1)); + } + auto shapeType = fir::ShapeType::get(rewriter.getContext(), rank); + return rewriter.create(loc, shapeType, result); + } + getExtents(result, loadOp.shape()); + return loadOp.shape(); +} + +static mlir::Type toRefType(mlir::Type ty) { + if (fir::isa_ref_type(ty)) + return ty; + return fir::ReferenceType::get(ty); +} + +static mlir::Value +genCoorOp(mlir::PatternRewriter &rewriter, mlir::Location loc, mlir::Type eleTy, + mlir::Type resTy, mlir::Value alloc, mlir::Value shape, + mlir::Value slice, mlir::ValueRange indices, + mlir::ValueRange typeparams, bool skipOrig = false) { + llvm::SmallVector originated; + if (skipOrig) + originated.assign(indices.begin(), indices.end()); + else + originated = fir::factory::originateIndices(loc, rewriter, alloc.getType(), + shape, indices); + auto seqTy = fir::dyn_cast_ptrOrBoxEleTy(alloc.getType()); + assert(seqTy && seqTy.isa()); + const auto dimension = seqTy.cast().getDimension(); + mlir::Value result = rewriter.create( + loc, eleTy, alloc, shape, slice, + llvm::ArrayRef{originated}.take_front(dimension), + typeparams); + if (dimension < originated.size()) + result = rewriter.create( + loc, resTy, result, + llvm::ArrayRef{originated}.drop_front(dimension)); + return result; +} + +namespace { +/// Conversion of fir.array_update and fir.array_modify Ops. +/// If there is a conflict for the update, then we need to perform a +/// copy-in/copy-out to preserve the original values of the array. If there is +/// no conflict, then it is save to eschew making any copies. +template +class ArrayUpdateConversionBase : public mlir::OpRewritePattern { +public: + explicit ArrayUpdateConversionBase(mlir::MLIRContext *ctx, + const ArrayCopyAnalysis &a, + const OperationUseMapT &m) + : mlir::OpRewritePattern{ctx}, analysis{a}, useMap{m} {} + + static llvm::SmallVector recoverTypeParams(mlir::Value val) { + auto *op = val.getDefiningOp(); + if (!fir::hasDynamicSize(fir::dyn_cast_ptrEleTy(val.getType()))) + return {}; + if (auto co = mlir::dyn_cast(op)) + return recoverTypeParams(co.value()); + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + if (auto ao = mlir::dyn_cast(op)) + return {ao.typeparams().begin(), ao.typeparams().end()}; + llvm::report_fatal_error("unexpected buffer"); + } + + static mlir::Value recoverCharLen(mlir::Value val) { + auto params = recoverTypeParams(val); + return params.empty() ? mlir::Value{} : params[0]; + } + + void genArrayCopy(mlir::Location loc, mlir::PatternRewriter &rewriter, + mlir::Value dst, mlir::Value src, mlir::Value shapeOp, + mlir::Type arrTy) const { + auto insPt = rewriter.saveInsertionPoint(); + llvm::SmallVector indices; + llvm::SmallVector extents; + getExtents(extents, shapeOp); + // Build loop nest from column to row. + for (auto sh : llvm::reverse(extents)) { + auto idxTy = rewriter.getIndexType(); + auto ubi = rewriter.create(loc, idxTy, sh); + auto zero = rewriter.create(loc, 0); + auto one = rewriter.create(loc, 1); + auto ub = rewriter.create(loc, idxTy, ubi, one); + auto loop = rewriter.create(loc, zero, ub, one); + rewriter.setInsertionPointToStart(loop.getBody()); + indices.push_back(loop.getInductionVar()); + } + // Reverse the indices so they are in column-major order. + std::reverse(indices.begin(), indices.end()); + auto ty = getEleTy(arrTy); + auto fromAddr = rewriter.create( + loc, ty, src, shapeOp, mlir::Value{}, + fir::factory::originateIndices(loc, rewriter, src.getType(), shapeOp, + indices), + mlir::ValueRange{}); + auto load = rewriter.create(loc, fromAddr); + auto toAddr = rewriter.create( + loc, ty, dst, shapeOp, mlir::Value{}, + fir::factory::originateIndices(loc, rewriter, dst.getType(), shapeOp, + indices), + mlir::ValueRange{}); + rewriter.create(loc, load, toAddr); + rewriter.restoreInsertionPoint(insPt); + } + + /// Copy the RHS element into the LHS and insert copy-in/copy-out between a + /// temp and the LHS if the analysis found potential overlaps between the RHS + /// and LHS arrays. The element copy generator must be provided through \p + /// assignElement. \p update must be the ArrayUpdateOp or the ArrayModifyOp. + /// Returns the address of the LHS element inside the loop and the LHS + /// ArrayLoad result. + std::pair + materializeAssignment(mlir::Location loc, mlir::PatternRewriter &rewriter, + ArrayOp update, + const std::function &assignElement, + mlir::Type lhsEltRefType) const { + auto *op = update.getOperation(); + auto *loadOp = useMap.lookup(op); + auto load = mlir::cast(loadOp); + LLVM_DEBUG(llvm::outs() << "does " << load << " have a conflict?\n"); + if (analysis.hasPotentialConflict(loadOp)) { + // If there is a conflict between the arrays, then we copy the lhs array + // to a temporary, update the temporary, and copy the temporary back to + // the lhs array. This yields Fortran's copy-in copy-out array semantics. + LLVM_DEBUG(llvm::outs() << "Yes, conflict was found\n"); + rewriter.setInsertionPoint(loadOp); + // Copy in. + llvm::SmallVector extents; + auto shapeOp = getOrReadExtentsAndShapeOp(loc, rewriter, load, extents); + auto allocmem = rewriter.create( + loc, dyn_cast_ptrOrBoxEleTy(load.memref().getType()), + load.typeparams(), extents); + genArrayCopy(load.getLoc(), rewriter, allocmem, load.memref(), shapeOp, + load.getType()); + rewriter.setInsertionPoint(op); + auto coor = genCoorOp( + rewriter, loc, getEleTy(load.getType()), lhsEltRefType, allocmem, + shapeOp, load.slice(), update.indices(), load.typeparams(), + update->hasAttr(fir::factory::attrFortranArrayOffsets())); + assignElement(coor); + auto *storeOp = useMap.lookup(loadOp); + auto store = mlir::cast(storeOp); + rewriter.setInsertionPoint(storeOp); + // Copy out. + genArrayCopy(store.getLoc(), rewriter, store.memref(), allocmem, shapeOp, + load.getType()); + rewriter.create(loc, allocmem); + return {coor, load.getResult()}; + } + // Otherwise, when there is no conflict (a possible loop-carried + // dependence), the lhs array can be updated in place. + LLVM_DEBUG(llvm::outs() << "No, conflict wasn't found\n"); + rewriter.setInsertionPoint(op); + auto coorTy = getEleTy(load.getType()); + auto coor = genCoorOp( + rewriter, loc, coorTy, lhsEltRefType, load.memref(), load.shape(), + load.slice(), update.indices(), load.typeparams(), + update->hasAttr(fir::factory::attrFortranArrayOffsets())); + assignElement(coor); + return {coor, load.getResult()}; + } + +private: + const ArrayCopyAnalysis &analysis; + const OperationUseMapT &useMap; +}; + +class ArrayUpdateConversion : public ArrayUpdateConversionBase { +public: + explicit ArrayUpdateConversion(mlir::MLIRContext *ctx, + const ArrayCopyAnalysis &a, + const OperationUseMapT &m) + : ArrayUpdateConversionBase{ctx, a, m} {} + + mlir::LogicalResult + matchAndRewrite(ArrayUpdateOp update, + mlir::PatternRewriter &rewriter) const override { + auto loc = update.getLoc(); + auto assignElement = [&](mlir::Value coor) { + auto input = update.merge(); + if (auto inEleTy = fir::dyn_cast_ptrEleTy(input.getType())) { + [[maybe_unused]] auto outEleTy = + fir::unwrapSequenceType(update.getType()); + if (auto inChrTy = inEleTy.dyn_cast()) { + assert(outEleTy.isa()); + fir::factory::genCharacterCopy(input, recoverCharLen(input), coor, + recoverCharLen(coor), rewriter, loc); + } else if (inEleTy.isa()) { + fir::FirOpBuilder builder( + rewriter, + fir::getKindMapping(update->getParentOfType())); + if (!update.typeparams().empty()) { + auto boxTy = fir::BoxType::get(inEleTy); + mlir::Value emptyShape, emptySlice; + auto lhs = rewriter.create( + loc, boxTy, coor, emptyShape, emptySlice, update.typeparams()); + auto rhs = rewriter.create( + loc, boxTy, input, emptyShape, emptySlice, update.typeparams()); + fir::factory::genRecordAssignment(builder, loc, fir::BoxValue(lhs), + fir::BoxValue(rhs)); + } else { + fir::factory::genRecordAssignment(builder, loc, coor, input); + } + } else { + llvm::report_fatal_error("not a legal reference type"); + } + } else { + rewriter.create(loc, input, coor); + } + }; + auto lhsEltRefType = toRefType(update.merge().getType()); + auto [_, lhsLoadResult] = materializeAssignment( + loc, rewriter, update, assignElement, lhsEltRefType); + update.replaceAllUsesWith(lhsLoadResult); + rewriter.replaceOp(update, lhsLoadResult); + return mlir::success(); + } +}; + +class ArrayModifyConversion : public ArrayUpdateConversionBase { +public: + explicit ArrayModifyConversion(mlir::MLIRContext *ctx, + const ArrayCopyAnalysis &a, + const OperationUseMapT &m) + : ArrayUpdateConversionBase{ctx, a, m} {} + + mlir::LogicalResult + matchAndRewrite(ArrayModifyOp modify, + mlir::PatternRewriter &rewriter) const override { + auto loc = modify.getLoc(); + auto assignElement = [](mlir::Value) { + // Assignment already materialized by lowering using lhs element address. + }; + auto lhsEltRefType = modify.getResult(0).getType(); + auto [lhsEltCoor, lhsLoadResult] = materializeAssignment( + loc, rewriter, modify, assignElement, lhsEltRefType); + modify.replaceAllUsesWith(mlir::ValueRange{lhsEltCoor, lhsLoadResult}); + rewriter.replaceOp(modify, mlir::ValueRange{lhsEltCoor, lhsLoadResult}); + return mlir::success(); + } +}; + +class ArrayFetchConversion : public mlir::OpRewritePattern { +public: + explicit ArrayFetchConversion(mlir::MLIRContext *ctx, + const OperationUseMapT &m) + : OpRewritePattern{ctx}, useMap{m} {} + + mlir::LogicalResult + matchAndRewrite(ArrayFetchOp fetch, + mlir::PatternRewriter &rewriter) const override { + auto *op = fetch.getOperation(); + rewriter.setInsertionPoint(op); + auto load = mlir::cast(useMap.lookup(op)); + auto loc = fetch.getLoc(); + auto coor = + genCoorOp(rewriter, loc, getEleTy(load.getType()), + toRefType(fetch.getType()), load.memref(), load.shape(), + load.slice(), fetch.indices(), load.typeparams(), + fetch->hasAttr(fir::factory::attrFortranArrayOffsets())); + if (fir::isa_ref_type(fetch.getType())) + rewriter.replaceOp(fetch, coor); + else + rewriter.replaceOpWithNewOp(fetch, coor); + return mlir::success(); + } + +private: + const OperationUseMapT &useMap; +}; +} // namespace + +namespace { +class ArrayValueCopyConverter + : public ArrayValueCopyBase { +public: + void runOnFunction() override { + auto func = getFunction(); + LLVM_DEBUG(llvm::dbgs() << "\n\narray-value-copy pass on function '" + << func.getName() << "'\n"); + auto *context = &getContext(); + + // Perform the conflict analysis. + auto &analysis = getAnalysis(); + const auto &useMap = analysis.getUseMap(); + + mlir::OwningRewritePatternList patterns1(context); + patterns1.insert(context, useMap); + patterns1.insert(context, analysis, useMap); + patterns1.insert(context, analysis, useMap); + mlir::ConversionTarget target(*context); + target.addLegalDialect(); + target.addIllegalOp(); + // Rewrite the array fetch and array update ops. + if (mlir::failed( + mlir::applyPartialConversion(func, target, std::move(patterns1)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "failure in array-value-copy pass, phase 1"); + signalPassFailure(); + } + + mlir::OwningRewritePatternList patterns2(context); + patterns2.insert(context); + patterns2.insert(context); + target.addIllegalOp(); + if (mlir::failed( + mlir::applyPartialConversion(func, target, std::move(patterns2)))) { + mlir::emitError(mlir::UnknownLoc::get(context), + "failure in array-value-copy pass, phase 2"); + signalPassFailure(); + } + } +}; +} // namespace + +std::unique_ptr fir::createArrayValueCopyPass() { + return std::make_unique(); +} diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt --- a/flang/lib/Optimizer/Transforms/CMakeLists.txt +++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt @@ -1,13 +1,16 @@ add_flang_library(FIRTransforms + ArrayValueCopy.cpp Inliner.cpp ExternalNameConversion.cpp DEPENDS + FIRBuilder FIRDialect FIRSupport FIROptTransformsPassIncGen LINK_LIBS + FIRBuilder FIRDialect MLIRAffineToStandard MLIRLLVMIR diff --git a/flang/test/Fir/array-modify.f90 b/flang/test/Fir/array-modify.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Fir/array-modify.f90 @@ -0,0 +1,130 @@ +// Test array-copy-value pass (copy elision) with fir.array_modify +// RUN: fir-opt %s --array-value-copy | FileCheck %s + +// Test user_defined_assignment(arg0(:), arg1(:)) +func @no_overlap(%arg0: !fir.ref>, %arg1: !fir.ref>) { + %c100 = constant 100 : index + %c99 = constant 99 : index + %c1 = constant 1 : index + %c0 = constant 0 : index + %0 = fir.alloca f32 + %1 = fir.shape %c100 : (index) -> !fir.shape<1> + %2 = fir.array_load %arg0(%1) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> + %3 = fir.array_load %arg1(%1) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> + %4 = fir.do_loop %arg2 = %c0 to %c99 step %c1 unordered iter_args(%arg3 = %2) -> (!fir.array<100xf32>) { + %5 = fir.array_fetch %3, %arg2 : (!fir.array<100xf32>, index) -> f32 + %6:2 = fir.array_modify %arg3, %arg2 : (!fir.array<100xf32>, index) -> (!fir.ref, !fir.array<100xf32>) + fir.store %5 to %0 : !fir.ref + fir.call @user_defined_assignment(%6#0, %0) : (!fir.ref, !fir.ref) -> () + fir.result %6#1 : !fir.array<100xf32> + } + fir.array_merge_store %2, %4 to %arg0 : !fir.array<100xf32>, !fir.array<100xf32>, !fir.ref> + return +} +// CHECK-LABEL: func @no_overlap( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>, +// CHECK-SAME: %[[VAL_1:.*]]: !fir.ref>) { +// CHECK-DAG: %[[VAL_2:.*]] = constant 100 : index +// CHECK-DAG: %[[VAL_3:.*]] = constant 99 : index +// CHECK-DAG: %[[VAL_4:.*]] = constant 1 : index +// CHECK-DAG: %[[VAL_5:.*]] = constant 0 : index +// CHECK: %[[VAL_6:.*]] = fir.alloca f32 +// CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +// CHECK: %[[VAL_8:.*]] = fir.undefined !fir.array<100xf32> +// CHECK: %[[VAL_9:.*]] = fir.undefined !fir.array<100xf32> +// CHECK: %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_5]] to %[[VAL_3]] step %[[VAL_4]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array<100xf32>) { +// CHECK: %[[VAL_13:.*]] = constant 1 : index +// CHECK: %[[VAL_14:.*]] = addi %[[VAL_11]], %[[VAL_13]] : index +// CHECK: %[[VAL_15:.*]] = fir.array_coor %[[VAL_1]](%[[VAL_7]]) %[[VAL_14]] : (!fir.ref>, !fir.shape<1>, index) -> !fir.ref +// CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ref +// CHECK: %[[VAL_17:.*]] = constant 1 : index +// CHECK: %[[VAL_18:.*]] = addi %[[VAL_11]], %[[VAL_17]] : index +// CHECK: %[[VAL_19:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) %[[VAL_18]] : (!fir.ref>, !fir.shape<1>, index) -> !fir.ref +// CHECK: fir.store %[[VAL_16]] to %[[VAL_6]] : !fir.ref +// CHECK: fir.call @user_defined_assignment(%[[VAL_19]], %[[VAL_6]]) : (!fir.ref, !fir.ref) -> () +// CHECK: fir.result %[[VAL_8]] : !fir.array<100xf32> +// CHECK: } +// CHECK: return +// CHECK: } + + +// Test user_defined_assignment(arg0(:), arg0(100:1:-1)) +func @overlap(%arg0: !fir.ref>) { + %c100 = constant 100 : index + %c99 = constant 99 : index + %c1 = constant 1 : index + %c-1 = constant -1 : index + %c0 = constant 0 : index + %0 = fir.alloca f32 + %1 = fir.shape %c100 : (index) -> !fir.shape<1> + %2 = fir.array_load %arg0(%1) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xf32> + %3 = fir.slice %c100, %c1, %c-1 : (index, index, index) -> !fir.slice<1> + %4 = fir.array_load %arg0(%1) [%3] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.array<100xf32> + %5 = fir.do_loop %arg1 = %c0 to %c99 step %c1 unordered iter_args(%arg2 = %2) -> (!fir.array<100xf32>) { + %6 = fir.array_fetch %4, %arg1 : (!fir.array<100xf32>, index) -> f32 + %7:2 = fir.array_modify %arg2, %arg1 : (!fir.array<100xf32>, index) -> (!fir.ref, !fir.array<100xf32>) + fir.store %6 to %0 : !fir.ref + fir.call @user_defined_assignment(%7#0, %0) : (!fir.ref, !fir.ref) -> () + fir.result %7#1 : !fir.array<100xf32> + } + fir.array_merge_store %2, %5 to %arg0 : !fir.array<100xf32>, !fir.array<100xf32>, !fir.ref> + return +} +// CHECK-LABEL: func @overlap( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>) { +// CHECK-DAG: %[[VAL_1:.*]] = constant 100 : index +// CHECK-DAG: %[[VAL_2:.*]] = constant 99 : index +// CHECK-DAG: %[[VAL_3:.*]] = constant 1 : index +// CHECK-DAG: %[[VAL_4:.*]] = constant -1 : index +// CHECK-DAG: %[[VAL_5:.*]] = constant 0 : index +// CHECK: %[[VAL_6:.*]] = fir.alloca f32 +// CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +// CHECK: %[[VAL_8:.*]] = fir.allocmem !fir.array<100xf32>, %[[VAL_1]] +// CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_1]] : (index) -> index +// CHECK: %[[VAL_10:.*]] = constant 0 : index +// CHECK: %[[VAL_11:.*]] = constant 1 : index +// CHECK: %[[VAL_12:.*]] = subi %[[VAL_9]], %[[VAL_11]] : index +// CHECK: fir.do_loop %[[VAL_13:.*]] = %[[VAL_10]] to %[[VAL_12]] step %[[VAL_11]] { +// CHECK: %[[VAL_14:.*]] = constant 1 : index +// CHECK: %[[VAL_15:.*]] = addi %[[VAL_13]], %[[VAL_14]] : index +// CHECK: %[[VAL_16:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) %[[VAL_15]] : (!fir.ref>, !fir.shape<1>, index) -> !fir.ref +// CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_16]] : !fir.ref +// CHECK: %[[VAL_18:.*]] = constant 1 : index +// CHECK: %[[VAL_19:.*]] = addi %[[VAL_13]], %[[VAL_18]] : index +// CHECK: %[[VAL_20:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_7]]) %[[VAL_19]] : (!fir.heap>, !fir.shape<1>, index) -> !fir.ref +// CHECK: fir.store %[[VAL_17]] to %[[VAL_20]] : !fir.ref +// CHECK: } +// CHECK: %[[VAL_21:.*]] = fir.undefined !fir.array<100xf32> +// CHECK: %[[VAL_22:.*]] = fir.slice %[[VAL_1]], %[[VAL_3]], %[[VAL_4]] : (index, index, index) -> !fir.slice<1> +// CHECK: %[[VAL_23:.*]] = fir.undefined !fir.array<100xf32> +// CHECK: %[[VAL_24:.*]] = fir.do_loop %[[VAL_25:.*]] = %[[VAL_5]] to %[[VAL_2]] step %[[VAL_3]] unordered iter_args(%[[VAL_26:.*]] = %[[VAL_21]]) -> (!fir.array<100xf32>) { +// CHECK: %[[VAL_27:.*]] = constant 1 : index +// CHECK: %[[VAL_28:.*]] = addi %[[VAL_25]], %[[VAL_27]] : index +// CHECK: %[[VAL_29:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) {{\[}}%[[VAL_22]]] %[[VAL_28]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref +// CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_29]] : !fir.ref +// CHECK: %[[VAL_31:.*]] = constant 1 : index +// CHECK: %[[VAL_32:.*]] = addi %[[VAL_25]], %[[VAL_31]] : index +// CHECK: %[[VAL_33:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_7]]) %[[VAL_32]] : (!fir.heap>, !fir.shape<1>, index) -> !fir.ref +// CHECK: fir.store %[[VAL_30]] to %[[VAL_6]] : !fir.ref +// CHECK: fir.call @user_defined_assignment(%[[VAL_33]], %[[VAL_6]]) : (!fir.ref, !fir.ref) -> () +// CHECK: fir.result %[[VAL_21]] : !fir.array<100xf32> +// CHECK: } +// CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_1]] : (index) -> index +// CHECK: %[[VAL_35:.*]] = constant 0 : index +// CHECK: %[[VAL_36:.*]] = constant 1 : index +// CHECK: %[[VAL_37:.*]] = subi %[[VAL_34]], %[[VAL_36]] : index +// CHECK: fir.do_loop %[[VAL_38:.*]] = %[[VAL_35]] to %[[VAL_37]] step %[[VAL_36]] { +// CHECK: %[[VAL_39:.*]] = constant 1 : index +// CHECK: %[[VAL_40:.*]] = addi %[[VAL_38]], %[[VAL_39]] : index +// CHECK: %[[VAL_41:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_7]]) %[[VAL_40]] : (!fir.heap>, !fir.shape<1>, index) -> !fir.ref +// CHECK: %[[VAL_42:.*]] = fir.load %[[VAL_41]] : !fir.ref +// CHECK: %[[VAL_43:.*]] = constant 1 : index +// CHECK: %[[VAL_44:.*]] = addi %[[VAL_38]], %[[VAL_43]] : index +// CHECK: %[[VAL_45:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) %[[VAL_44]] : (!fir.ref>, !fir.shape<1>, index) -> !fir.ref +// CHECK: fir.store %[[VAL_42]] to %[[VAL_45]] : !fir.ref +// CHECK: } +// CHECK: fir.freemem %[[VAL_8]] : !fir.heap> +// CHECK: return +// CHECK: } + +func private @user_defined_assignment(!fir.ref, !fir.ref)