| //===-- HostAssociations.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/Lower/HostAssociations.h" |
| #include "flang/Evaluate/check-expression.h" |
| #include "flang/Lower/AbstractConverter.h" |
| #include "flang/Lower/Allocatable.h" |
| #include "flang/Lower/BoxAnalyzer.h" |
| #include "flang/Lower/CallInterface.h" |
| #include "flang/Lower/ConvertType.h" |
| #include "flang/Lower/ConvertVariable.h" |
| #include "flang/Lower/OpenMP.h" |
| #include "flang/Lower/PFTBuilder.h" |
| #include "flang/Lower/SymbolMap.h" |
| #include "flang/Optimizer/Builder/Character.h" |
| #include "flang/Optimizer/Builder/FIRBuilder.h" |
| #include "flang/Optimizer/Builder/Todo.h" |
| #include "flang/Optimizer/Support/FatalError.h" |
| #include "flang/Semantics/tools.h" |
| #include "llvm/ADT/TypeSwitch.h" |
| #include "llvm/Support/Debug.h" |
| #include <optional> |
| |
| #define DEBUG_TYPE "flang-host-assoc" |
| |
| // Host association inside internal procedures is implemented by allocating an |
| // mlir tuple (a struct) inside the host containing the addresses and properties |
| // of variables that are accessed by internal procedures. The address of this |
| // tuple is passed as an argument by the host when calling internal procedures. |
| // Internal procedures propagate a reference to this tuple when calling other |
| // internal procedures of the host. |
| // |
| // This file defines how the type of the host tuple is built, how the tuple |
| // value is created inside the host, and how the host associated variables are |
| // instantiated inside the internal procedures from the tuple value. The |
| // CapturedXXX classes define each of these three actions for a specific |
| // kind of variables by providing a `getType`, a `instantiateHostTuple`, and a |
| // `getFromTuple` method. These classes are structured as follow: |
| // |
| // class CapturedKindOfVar : public CapturedSymbols<CapturedKindOfVar> { |
| // // Return the type of the tuple element for a host associated |
| // // variable given its symbol inside the host. This is called when |
| // // building function interfaces. |
| // static mlir::Type getType(); |
| // // Build the tuple element value for a host associated variable given its |
| // // value inside the host. This is called when lowering the host body. |
| // static void instantiateHostTuple(); |
| // // Instantiate a host variable inside an internal procedure given its |
| // // tuple element value. This is called when lowering internal procedure |
| // // bodies. |
| // static void getFromTuple(); |
| // }; |
| // |
| // If a new kind of variable requires ad-hoc handling, a new CapturedXXX class |
| // should be added to handle it, and `walkCaptureCategories` should be updated |
| // to dispatch this new kind of variable to this new class. |
| |
| /// Is \p sym a derived type entity with length parameters ? |
| static bool isDerivedWithLenParameters(const Fortran::semantics::Symbol &sym) { |
| if (const auto *declTy = sym.GetType()) |
| if (const auto *derived = declTy->AsDerived()) |
| return Fortran::semantics::CountLenParameters(*derived) != 0; |
| return false; |
| } |
| |
| /// Map the extracted fir::ExtendedValue for a host associated variable inside |
| /// and internal procedure to its symbol. Generates an hlfir.declare in HLFIR. |
| static void bindCapturedSymbol(const Fortran::semantics::Symbol &sym, |
| fir::ExtendedValue val, |
| Fortran::lower::AbstractConverter &converter, |
| Fortran::lower::SymMap &symMap) { |
| if (converter.getLoweringOptions().getLowerToHighLevelFIR()) |
| Fortran::lower::genDeclareSymbol(converter, symMap, sym, val, |
| fir::FortranVariableFlagsEnum::host_assoc); |
| else |
| symMap.addSymbol(sym, val); |
| } |
| |
| namespace { |
| /// Struct to be used as argument in walkCaptureCategories when building the |
| /// tuple element type for a host associated variable. |
| struct GetTypeInTuple { |
| /// walkCaptureCategories must return a type. |
| using Result = mlir::Type; |
| }; |
| |
| /// Struct to be used as argument in walkCaptureCategories when building the |
| /// tuple element value for a host associated variable. |
| struct InstantiateHostTuple { |
| /// walkCaptureCategories returns nothing. |
| using Result = void; |
| /// Value of the variable inside the host procedure. |
| fir::ExtendedValue hostValue; |
| /// Address of the tuple element of the variable. |
| mlir::Value addrInTuple; |
| mlir::Location loc; |
| }; |
| |
| /// Struct to be used as argument in walkCaptureCategories when instantiating a |
| /// host associated variables from its tuple element value. |
| struct GetFromTuple { |
| /// walkCaptureCategories returns nothing. |
| using Result = void; |
| /// Symbol map inside the internal procedure. |
| Fortran::lower::SymMap &symMap; |
| /// Value of the tuple element for the host associated variable. |
| mlir::Value valueInTuple; |
| mlir::Location loc; |
| }; |
| |
| /// Base class that must be inherited with CRTP by classes defining |
| /// how host association is implemented for a type of symbol. |
| /// It simply dispatches visit() calls to the implementations according |
| /// to the argument type. |
| template <typename SymbolCategory> |
| class CapturedSymbols { |
| public: |
| template <typename T> |
| static void visit(const T &, Fortran::lower::AbstractConverter &, |
| const Fortran::semantics::Symbol &, |
| const Fortran::lower::BoxAnalyzer &) { |
| static_assert(!std::is_same_v<T, T> && |
| "default visit must not be instantiated"); |
| } |
| static mlir::Type visit(const GetTypeInTuple &, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &) { |
| return SymbolCategory::getType(converter, sym); |
| } |
| static void visit(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &) { |
| return SymbolCategory::instantiateHostTuple(args, converter, sym); |
| } |
| static void visit(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &ba) { |
| return SymbolCategory::getFromTuple(args, converter, sym, ba); |
| } |
| }; |
| |
| /// Class defining simple scalars are captured in internal procedures. |
| /// Simple scalars are non character intrinsic scalars. They are captured |
| /// as `!fir.ref<T>`, for example `!fir.ref<i32>` for `INTEGER*4`. |
| class CapturedSimpleScalars : public CapturedSymbols<CapturedSimpleScalars> { |
| public: |
| static mlir::Type getType(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| return fir::ReferenceType::get(converter.genType(sym)); |
| } |
| |
| static void instantiateHostTuple(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); |
| assert(typeInTuple && "addrInTuple must be an address"); |
| mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, |
| fir::getBase(args.hostValue)); |
| builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple); |
| } |
| |
| static void getFromTuple(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &) { |
| bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap); |
| } |
| }; |
| |
| /// Class defining how dummy procedures and procedure pointers |
| /// are captured in internal procedures. |
| class CapturedProcedure : public CapturedSymbols<CapturedProcedure> { |
| public: |
| static mlir::Type getType(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| mlir::Type funTy = Fortran::lower::getDummyProcedureType(sym, converter); |
| if (Fortran::semantics::IsPointer(sym)) |
| return fir::ReferenceType::get(funTy); |
| return funTy; |
| } |
| |
| static void instantiateHostTuple(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); |
| assert(typeInTuple && "addrInTuple must be an address"); |
| mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, |
| fir::getBase(args.hostValue)); |
| builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple); |
| } |
| |
| static void getFromTuple(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &) { |
| bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap); |
| } |
| }; |
| |
| /// Class defining how character scalars are captured in internal procedures. |
| /// Character scalars are passed as !fir.boxchar<kind> in the tuple. |
| class CapturedCharacterScalars |
| : public CapturedSymbols<CapturedCharacterScalars> { |
| public: |
| // Note: so far, do not specialize constant length characters. They can be |
| // implemented by only passing the address. This could be done later in |
| // lowering or a CapturedStaticLenCharacterScalars class could be added here. |
| |
| static mlir::Type getType(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| fir::KindTy kind = |
| mlir::cast<fir::CharacterType>(converter.genType(sym)).getFKind(); |
| return fir::BoxCharType::get(&converter.getMLIRContext(), kind); |
| } |
| |
| static void instantiateHostTuple(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &) { |
| const fir::CharBoxValue *charBox = args.hostValue.getCharBox(); |
| assert(charBox && "host value must be a fir::CharBoxValue"); |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Value boxchar = fir::factory::CharacterExprHelper(builder, args.loc) |
| .createEmbox(*charBox); |
| builder.create<fir::StoreOp>(args.loc, boxchar, args.addrInTuple); |
| } |
| |
| static void getFromTuple(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &) { |
| fir::factory::CharacterExprHelper charHelp(converter.getFirOpBuilder(), |
| args.loc); |
| std::pair<mlir::Value, mlir::Value> unboxchar = |
| charHelp.createUnboxChar(args.valueInTuple); |
| bindCapturedSymbol(sym, |
| fir::CharBoxValue{unboxchar.first, unboxchar.second}, |
| converter, args.symMap); |
| } |
| }; |
| |
| /// Class defining how polymorphic scalar entities are captured in internal |
| /// procedures. Polymorphic entities are always boxed as a fir.class box. |
| /// Polymorphic array can be handled in CapturedArrays directly |
| class CapturedPolymorphicScalar |
| : public CapturedSymbols<CapturedPolymorphicScalar> { |
| public: |
| static mlir::Type getType(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| return converter.genType(sym); |
| } |
| static void instantiateHostTuple(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Location loc = args.loc; |
| mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); |
| assert(typeInTuple && "addrInTuple must be an address"); |
| mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, |
| fir::getBase(args.hostValue)); |
| if (Fortran::semantics::IsOptional(sym)) { |
| auto isPresent = |
| builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), castBox); |
| builder.genIfThenElse(loc, isPresent) |
| .genThen([&]() { |
| builder.create<fir::StoreOp>(loc, castBox, args.addrInTuple); |
| }) |
| .genElse([&]() { |
| mlir::Value null = fir::factory::createUnallocatedBox( |
| builder, loc, typeInTuple, |
| /*nonDeferredParams=*/mlir::ValueRange{}); |
| builder.create<fir::StoreOp>(loc, null, args.addrInTuple); |
| }) |
| .end(); |
| } else { |
| builder.create<fir::StoreOp>(loc, castBox, args.addrInTuple); |
| } |
| } |
| static void getFromTuple(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &ba) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Location loc = args.loc; |
| mlir::Value box = args.valueInTuple; |
| if (Fortran::semantics::IsOptional(sym)) { |
| auto boxTy = mlir::cast<fir::BaseBoxType>(box.getType()); |
| auto eleTy = boxTy.getEleTy(); |
| if (!fir::isa_ref_type(eleTy)) |
| eleTy = builder.getRefType(eleTy); |
| auto addr = builder.create<fir::BoxAddrOp>(loc, eleTy, box); |
| mlir::Value isPresent = builder.genIsNotNullAddr(loc, addr); |
| auto absentBox = builder.create<fir::AbsentOp>(loc, boxTy); |
| box = |
| builder.create<mlir::arith::SelectOp>(loc, isPresent, box, absentBox); |
| } |
| bindCapturedSymbol(sym, box, converter, args.symMap); |
| } |
| }; |
| |
| /// Class defining how allocatable and pointers entities are captured in |
| /// internal procedures. Allocatable and pointers are simply captured by placing |
| /// their !fir.ref<fir.box<>> address in the host tuple. |
| class CapturedAllocatableAndPointer |
| : public CapturedSymbols<CapturedAllocatableAndPointer> { |
| public: |
| static mlir::Type getType(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| mlir::Type baseType = converter.genType(sym); |
| if (sym.GetUltimate().test(Fortran::semantics::Symbol::Flag::CrayPointee)) |
| return fir::ReferenceType::get( |
| Fortran::lower::getCrayPointeeBoxType(baseType)); |
| return fir::ReferenceType::get(baseType); |
| } |
| static void instantiateHostTuple(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &) { |
| assert(args.hostValue.getBoxOf<fir::MutableBoxValue>() && |
| "host value must be a fir::MutableBoxValue"); |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Type typeInTuple = fir::dyn_cast_ptrEleTy(args.addrInTuple.getType()); |
| assert(typeInTuple && "addrInTuple must be an address"); |
| mlir::Value castBox = builder.createConvert(args.loc, typeInTuple, |
| fir::getBase(args.hostValue)); |
| builder.create<fir::StoreOp>(args.loc, castBox, args.addrInTuple); |
| } |
| static void getFromTuple(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &ba) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Location loc = args.loc; |
| // Non deferred type parameters impact the semantics of some statements |
| // where allocatables/pointer can appear. For instance, assignment to a |
| // scalar character allocatable with has a different semantics in F2003 and |
| // later if the length is non deferred vs when it is deferred. So it is |
| // important to keep track of the non deferred parameters here. |
| llvm::SmallVector<mlir::Value> nonDeferredLenParams; |
| if (ba.isChar()) { |
| mlir::IndexType idxTy = builder.getIndexType(); |
| if (std::optional<int64_t> len = ba.getCharLenConst()) { |
| nonDeferredLenParams.push_back( |
| builder.createIntegerConstant(loc, idxTy, *len)); |
| } else if (Fortran::semantics::IsAssumedLengthCharacter(sym) || |
| ba.getCharLenExpr()) { |
| nonDeferredLenParams.push_back( |
| Fortran::lower::getAssumedCharAllocatableOrPointerLen( |
| builder, loc, sym, args.valueInTuple)); |
| } |
| } else if (isDerivedWithLenParameters(sym)) { |
| TODO(loc, "host associated derived type allocatable or pointer with " |
| "length parameters"); |
| } |
| bindCapturedSymbol( |
| sym, fir::MutableBoxValue(args.valueInTuple, nonDeferredLenParams, {}), |
| converter, args.symMap); |
| } |
| }; |
| |
| /// Class defining how arrays, including assumed-ranks, are captured inside |
| /// internal procedures. |
| /// Array are captured via a `fir.box<fir.array<T>>` descriptor that belongs to |
| /// the host tuple. This allows capturing lower bounds, which can be done by |
| /// providing a ShapeShiftOp argument to the EmboxOp. |
| class CapturedArrays : public CapturedSymbols<CapturedArrays> { |
| |
| // Note: Constant shape arrays are not specialized (their base address would |
| // be sufficient information inside the tuple). They could be specialized in |
| // a later FIR pass, or a CapturedStaticShapeArrays could be added to deal |
| // with them here. |
| public: |
| static mlir::Type getType(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| mlir::Type type = converter.genType(sym); |
| bool isPolymorphic = Fortran::semantics::IsPolymorphic(sym); |
| assert((mlir::isa<fir::SequenceType>(type) || |
| (isPolymorphic && mlir::isa<fir::ClassType>(type))) && |
| "must be a sequence type"); |
| if (isPolymorphic) |
| return type; |
| return fir::BoxType::get(type); |
| } |
| |
| static void instantiateHostTuple(const InstantiateHostTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Location loc = args.loc; |
| fir::MutableBoxValue boxInTuple(args.addrInTuple, {}, {}); |
| if (args.hostValue.getBoxOf<fir::BoxValue>() && |
| Fortran::semantics::IsOptional(sym)) { |
| // The assumed shape optional case need some care because it is illegal to |
| // read the incoming box if it is absent (this would cause segfaults). |
| // Pointer association requires reading the target box, so it can only be |
| // done on present optional. For absent optionals, simply create a |
| // disassociated pointer (it is illegal to inquire about lower bounds or |
| // lengths of optional according to 15.5.2.12 3 (9) and 10.1.11 2 (7)b). |
| auto isPresent = builder.create<fir::IsPresentOp>( |
| loc, builder.getI1Type(), fir::getBase(args.hostValue)); |
| builder.genIfThenElse(loc, isPresent) |
| .genThen([&]() { |
| fir::factory::associateMutableBox(builder, loc, boxInTuple, |
| args.hostValue, |
| /*lbounds=*/std::nullopt); |
| }) |
| .genElse([&]() { |
| fir::factory::disassociateMutableBox(builder, loc, boxInTuple); |
| }) |
| .end(); |
| } else { |
| fir::factory::associateMutableBox( |
| builder, loc, boxInTuple, args.hostValue, /*lbounds=*/std::nullopt); |
| } |
| } |
| |
| static void getFromTuple(const GetFromTuple &args, |
| Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym, |
| const Fortran::lower::BoxAnalyzer &ba) { |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Location loc = args.loc; |
| mlir::Value box = args.valueInTuple; |
| mlir::IndexType idxTy = builder.getIndexType(); |
| llvm::SmallVector<mlir::Value> lbounds; |
| if (!ba.lboundIsAllOnes() && !Fortran::evaluate::IsAssumedRank(sym)) { |
| if (ba.isStaticArray()) { |
| for (std::int64_t lb : ba.staticLBound()) |
| lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb)); |
| } else { |
| // Cannot re-evaluate specification expressions here. |
| // Operands values may have changed. Get value from fir.box |
| const unsigned rank = sym.Rank(); |
| for (unsigned dim = 0; dim < rank; ++dim) { |
| mlir::Value dimVal = builder.createIntegerConstant(loc, idxTy, dim); |
| auto dims = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, |
| box, dimVal); |
| lbounds.emplace_back(dims.getResult(0)); |
| } |
| } |
| } |
| |
| if (canReadCapturedBoxValue(converter, sym)) { |
| fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/std::nullopt); |
| bindCapturedSymbol(sym, |
| fir::factory::readBoxValue(builder, loc, boxValue), |
| converter, args.symMap); |
| } else { |
| // Keep variable as a fir.box/fir.class. |
| // If this is an optional that is absent, the fir.box needs to be an |
| // AbsentOp result, otherwise it will not work properly with IsPresentOp |
| // (absent boxes are null descriptor addresses, not descriptors containing |
| // a null base address). |
| if (Fortran::semantics::IsOptional(sym)) { |
| auto boxTy = mlir::cast<fir::BaseBoxType>(box.getType()); |
| auto eleTy = boxTy.getEleTy(); |
| if (!fir::isa_ref_type(eleTy)) |
| eleTy = builder.getRefType(eleTy); |
| auto addr = builder.create<fir::BoxAddrOp>(loc, eleTy, box); |
| mlir::Value isPresent = builder.genIsNotNullAddr(loc, addr); |
| auto absentBox = builder.create<fir::AbsentOp>(loc, boxTy); |
| box = builder.create<mlir::arith::SelectOp>(loc, isPresent, box, |
| absentBox); |
| } |
| fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/std::nullopt); |
| bindCapturedSymbol(sym, boxValue, converter, args.symMap); |
| } |
| } |
| |
| private: |
| /// Can the fir.box from the host link be read into simpler values ? |
| /// Later, without the symbol information, it might not be possible |
| /// to tell if the fir::BoxValue from the host link is contiguous. |
| static bool |
| canReadCapturedBoxValue(Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| bool isScalarOrContiguous = |
| sym.Rank() == 0 || Fortran::evaluate::IsSimplyContiguous( |
| Fortran::evaluate::AsGenericExpr(sym).value(), |
| converter.getFoldingContext()); |
| const Fortran::semantics::DeclTypeSpec *type = sym.GetType(); |
| bool isPolymorphic = type && type->IsPolymorphic(); |
| return isScalarOrContiguous && !isPolymorphic && |
| !isDerivedWithLenParameters(sym) && |
| !Fortran::evaluate::IsAssumedRank(sym); |
| } |
| }; |
| } // namespace |
| |
| /// Dispatch \p visitor to the CapturedSymbols which is handling how host |
| /// association is implemented for this kind of symbols. This ensures the same |
| /// dispatch decision is taken when building the tuple type, when creating the |
| /// tuple, and when instantiating host associated variables from it. |
| template <typename T> |
| static typename T::Result |
| walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter, |
| const Fortran::semantics::Symbol &sym) { |
| if (isDerivedWithLenParameters(sym)) |
| // Should be boxed. |
| TODO(converter.genLocation(sym.name()), |
| "host associated derived type with length parameters"); |
| Fortran::lower::BoxAnalyzer ba; |
| // Do not analyze procedures, they may be subroutines with no types that would |
| // crash the analysis. |
| if (Fortran::semantics::IsProcedure(sym)) |
| return CapturedProcedure::visit(visitor, converter, sym, ba); |
| ba.analyze(sym); |
| if (Fortran::semantics::IsAllocatableOrPointer(sym) || |
| sym.GetUltimate().test(Fortran::semantics::Symbol::Flag::CrayPointee)) |
| return CapturedAllocatableAndPointer::visit(visitor, converter, sym, ba); |
| if (ba.isArray()) // include assumed-ranks. |
| return CapturedArrays::visit(visitor, converter, sym, ba); |
| if (Fortran::semantics::IsPolymorphic(sym)) |
| return CapturedPolymorphicScalar::visit(visitor, converter, sym, ba); |
| if (ba.isChar()) |
| return CapturedCharacterScalars::visit(visitor, converter, sym, ba); |
| assert(ba.isTrivial() && "must be trivial scalar"); |
| return CapturedSimpleScalars::visit(visitor, converter, sym, ba); |
| } |
| |
| // `t` should be the result of getArgumentType, which has a type of |
| // `!fir.ref<tuple<...>>`. |
| static mlir::TupleType unwrapTupleTy(mlir::Type t) { |
| return mlir::cast<mlir::TupleType>(fir::dyn_cast_ptrEleTy(t)); |
| } |
| |
| static mlir::Value genTupleCoor(fir::FirOpBuilder &builder, mlir::Location loc, |
| mlir::Type varTy, mlir::Value tupleArg, |
| mlir::Value offset) { |
| // fir.ref<fir.ref> and fir.ptr<fir.ref> are forbidden. Use |
| // fir.llvm_ptr if needed. |
| auto ty = mlir::isa<fir::ReferenceType>(varTy) |
| ? mlir::Type(fir::LLVMPointerType::get(varTy)) |
| : mlir::Type(builder.getRefType(varTy)); |
| return builder.create<fir::CoordinateOp>(loc, ty, tupleArg, offset); |
| } |
| |
| void Fortran::lower::HostAssociations::addSymbolsToBind( |
| const llvm::SetVector<const Fortran::semantics::Symbol *> &symbols, |
| const Fortran::semantics::Scope &hostScope) { |
| assert(tupleSymbols.empty() && globalSymbols.empty() && |
| "must be initially empty"); |
| this->hostScope = &hostScope; |
| for (const auto *s : symbols) |
| // GlobalOp are created for non-global threadprivate variable, |
| // so considering them as globals. |
| if (Fortran::lower::symbolIsGlobal(*s) || |
| (*s).test(Fortran::semantics::Symbol::Flag::OmpThreadprivate)) { |
| // The ultimate symbol is stored here so that global symbols from the |
| // host scope can later be searched in this set. |
| globalSymbols.insert(&s->GetUltimate()); |
| } else { |
| tupleSymbols.insert(s); |
| } |
| } |
| |
| void Fortran::lower::HostAssociations::hostProcedureBindings( |
| Fortran::lower::AbstractConverter &converter, |
| Fortran::lower::SymMap &symMap) { |
| if (tupleSymbols.empty()) |
| return; |
| |
| // Create the tuple variable. |
| mlir::TupleType tupTy = unwrapTupleTy(getArgumentType(converter)); |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Location loc = converter.getCurrentLocation(); |
| auto hostTuple = builder.create<fir::AllocaOp>(loc, tupTy); |
| mlir::IntegerType offTy = builder.getIntegerType(32); |
| |
| // Walk the list of tupleSymbols and update the pointers in the tuple. |
| for (auto s : llvm::enumerate(tupleSymbols)) { |
| auto indexInTuple = s.index(); |
| mlir::Value off = builder.createIntegerConstant(loc, offTy, indexInTuple); |
| mlir::Type varTy = tupTy.getType(indexInTuple); |
| mlir::Value eleOff = genTupleCoor(builder, loc, varTy, hostTuple, off); |
| InstantiateHostTuple instantiateHostTuple{ |
| converter.getSymbolExtendedValue(*s.value(), &symMap), eleOff, loc}; |
| walkCaptureCategories(instantiateHostTuple, converter, *s.value()); |
| } |
| |
| converter.bindHostAssocTuple(hostTuple); |
| } |
| |
| void Fortran::lower::HostAssociations::internalProcedureBindings( |
| Fortran::lower::AbstractConverter &converter, |
| Fortran::lower::SymMap &symMap) { |
| if (!globalSymbols.empty()) { |
| assert(hostScope && "host scope must have been set"); |
| Fortran::lower::AggregateStoreMap storeMap; |
| // The host scope variable list is required to deal with host variables |
| // that are equivalenced and requires instantiating the right global |
| // AggregateStore. |
| for (auto &hostVariable : pft::getScopeVariableList(*hostScope)) |
| if ((hostVariable.isAggregateStore() && hostVariable.isGlobal()) || |
| (hostVariable.hasSymbol() && |
| globalSymbols.contains(&hostVariable.getSymbol().GetUltimate()))) { |
| Fortran::lower::instantiateVariable(converter, hostVariable, symMap, |
| storeMap); |
| // Generate threadprivate Op for host associated variables. |
| if (hostVariable.hasSymbol() && |
| hostVariable.getSymbol().test( |
| Fortran::semantics::Symbol::Flag::OmpThreadprivate)) |
| Fortran::lower::genThreadprivateOp(converter, hostVariable); |
| } |
| } |
| if (tupleSymbols.empty()) |
| return; |
| |
| // Find the argument with the tuple type. The argument ought to be appended. |
| fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
| mlir::Type argTy = getArgumentType(converter); |
| mlir::TupleType tupTy = unwrapTupleTy(argTy); |
| mlir::Location loc = converter.getCurrentLocation(); |
| mlir::func::FuncOp func = builder.getFunction(); |
| mlir::Value tupleArg; |
| for (auto [ty, arg] : llvm::reverse(llvm::zip( |
| func.getFunctionType().getInputs(), func.front().getArguments()))) |
| if (ty == argTy) { |
| tupleArg = arg; |
| break; |
| } |
| if (!tupleArg) |
| fir::emitFatalError(loc, "no host association argument found"); |
| |
| converter.bindHostAssocTuple(tupleArg); |
| |
| mlir::IntegerType offTy = builder.getIntegerType(32); |
| |
| // Walk the list and add the bindings to the symbol table. |
| for (auto s : llvm::enumerate(tupleSymbols)) { |
| mlir::Value off = builder.createIntegerConstant(loc, offTy, s.index()); |
| mlir::Type varTy = tupTy.getType(s.index()); |
| mlir::Value eleOff = genTupleCoor(builder, loc, varTy, tupleArg, off); |
| mlir::Value valueInTuple = builder.create<fir::LoadOp>(loc, eleOff); |
| GetFromTuple getFromTuple{symMap, valueInTuple, loc}; |
| walkCaptureCategories(getFromTuple, converter, *s.value()); |
| } |
| } |
| |
| mlir::Type Fortran::lower::HostAssociations::getArgumentType( |
| Fortran::lower::AbstractConverter &converter) { |
| if (tupleSymbols.empty()) |
| return {}; |
| if (argType) |
| return argType; |
| |
| // Walk the list of Symbols and create their types. Wrap them in a reference |
| // to a tuple. |
| mlir::MLIRContext *ctxt = &converter.getMLIRContext(); |
| llvm::SmallVector<mlir::Type> tupleTys; |
| for (const Fortran::semantics::Symbol *sym : tupleSymbols) |
| tupleTys.emplace_back( |
| walkCaptureCategories(GetTypeInTuple{}, converter, *sym)); |
| argType = fir::ReferenceType::get(mlir::TupleType::get(ctxt, tupleTys)); |
| return argType; |
| } |
