| //===-- 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/Optimizer/Builder/Character.h" |
| #include "flang/Optimizer/Builder/FIRBuilder.h" |
| #include "flang/Optimizer/Builder/Runtime/Derived.h" |
| #include "flang/Optimizer/Builder/Runtime/Stop.h" |
| #include "flang/Optimizer/Builder/Todo.h" |
| #include "flang/Optimizer/Dialect/FIRAttr.h" |
| #include "flang/Optimizer/Dialect/FIROps.h" |
| #include "flang/Optimizer/Dialect/FIROpsSupport.h" |
| #include "flang/Optimizer/Support/FatalError.h" |
| |
| /// Create a fir.box describing the new address, bounds, and length parameters |
| /// for a MutableBox \p box. |
| static mlir::Value |
| createNewFirBox(fir::FirOpBuilder &builder, mlir::Location loc, |
| const fir::MutableBoxValue &box, mlir::Value addr, |
| mlir::ValueRange lbounds, mlir::ValueRange extents, |
| mlir::ValueRange lengths, mlir::Value tdesc = {}) { |
| if (mlir::isa<fir::BaseBoxType>(addr.getType())) |
| // The entity is already boxed. |
| return builder.createConvert(loc, box.getBoxTy(), addr); |
| |
| mlir::Value shape; |
| if (!extents.empty()) { |
| if (lbounds.empty()) { |
| shape = builder.create<fir::ShapeOp>(loc, extents); |
| } else { |
| llvm::SmallVector<mlir::Value> 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<fir::ShapeShiftOp>(loc, shapeShiftType, |
| shapeShiftBounds); |
| } |
| } // Otherwise, this a scalar. Leave the shape empty. |
| |
| // Ignore lengths if already constant in the box type (this would trigger an |
| // error in the embox). |
| llvm::SmallVector<mlir::Value> cleanedLengths; |
| auto cleanedAddr = addr; |
| if (auto charTy = mlir::dyn_cast<fir::CharacterType>(box.getEleTy())) { |
| // 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 = mlir::isa<fir::HeapType>(addrTy) ? fir::HeapType::get(bt) |
| : mlir::isa<fir::PointerType>(addrTy) |
| ? 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 (fir::isUnlimitedPolymorphicType(box.getBoxTy())) { |
| if (auto charTy = mlir::dyn_cast<fir::CharacterType>( |
| fir::dyn_cast_ptrEleTy(addr.getType()))) { |
| if (charTy.getLen() == fir::CharacterType::unknownLen()) |
| cleanedLengths.append(lengths.begin(), lengths.end()); |
| } |
| } else if (box.isDerivedWithLenParameters()) { |
| TODO(loc, "updating mutablebox of derived type with length parameters"); |
| cleanedLengths = lengths; |
| } |
| mlir::Value emptySlice; |
| return builder.create<fir::EmboxOp>(loc, box.getBoxTy(), cleanedAddr, shape, |
| emptySlice, cleanedLengths, tdesc); |
| } |
| |
| //===----------------------------------------------------------------------===// |
| // 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<fir::LoadOp>(loc, box.getAddr()); |
| } |
| /// Get base address of allocated/associated entity. |
| mlir::Value readBaseAddress() { |
| if (irBox) { |
| auto memrefTy = box.getBoxTy().getEleTy(); |
| if (!fir::isa_ref_type(memrefTy)) |
| memrefTy = builder.getRefType(memrefTy); |
| return builder.create<fir::BoxAddrOp>(loc, memrefTy, irBox); |
| } |
| auto addrVar = box.getMutableProperties().addr; |
| return builder.create<fir::LoadOp>(loc, addrVar); |
| } |
| /// Return {lbound, extent} values read from the MutableBoxValue given |
| /// the dimension. |
| std::pair<mlir::Value, mlir::Value> readShape(unsigned dim) { |
| auto idxTy = builder.getIndexType(); |
| if (irBox) { |
| auto dimVal = builder.createIntegerConstant(loc, idxTy, dim); |
| auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, |
| irBox, dimVal); |
| return {dimInfo.getResult(0), dimInfo.getResult(1)}; |
| } |
| const auto &mutableProperties = box.getMutableProperties(); |
| auto lb = builder.create<fir::LoadOp>(loc, mutableProperties.lbounds[dim]); |
| auto ext = builder.create<fir::LoadOp>(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<fir::LoadOp>(loc, deferred[0]); |
| } |
| |
| /// Read and return all extents. If \p lbounds vector is provided, lbounds are |
| /// also read into it. |
| llvm::SmallVector<mlir::Value> |
| readShape(llvm::SmallVectorImpl<mlir::Value> *lbounds = nullptr) { |
| llvm::SmallVector<mlir::Value> 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<mlir::Value> &lbounds, |
| llvm::SmallVectorImpl<mlir::Value> &extents, |
| llvm::SmallVectorImpl<mlir::Value> &lengths) { |
| extents = readShape(&lbounds); |
| if (box.isCharacter()) |
| lengths.emplace_back(readCharacterLength()); |
| else if (box.isDerivedWithLenParameters()) |
| 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<mlir::Value> &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, |
| mlir::Value typeSourceBox = {}, unsigned allocator = 0) |
| : builder{builder}, loc{loc}, box{box}, typeSourceBox{typeSourceBox}, |
| allocator{allocator} {} |
| /// 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, |
| mlir::Value tdesc = {}) { |
| if (box.isDescribedByVariables()) |
| updateMutableProperties(addr, lbounds, extents, lengths); |
| else |
| updateIRBox(addr, lbounds, extents, lengths, tdesc); |
| } |
| |
| /// 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<fir::StoreOp>(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<fir::StoreOp>(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(), |
| typeSourceBox, allocator); |
| builder.create<fir::StoreOp>(loc, deallocatedBox, box.getAddr()); |
| } |
| } |
| |
| /// Copy Values from the fir.box into the property variables if any. |
| void syncMutablePropertiesFromIRBox() { |
| if (!box.isDescribedByVariables()) |
| return; |
| llvm::SmallVector<mlir::Value> lbounds; |
| llvm::SmallVector<mlir::Value> extents; |
| llvm::SmallVector<mlir::Value> 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<mlir::Value> lbounds; |
| llvm::SmallVector<mlir::Value> extents; |
| llvm::SmallVector<mlir::Value> lengths; |
| auto addr = MutablePropertyReader{builder, loc, box}.read(lbounds, extents, |
| lengths); |
| updateIRBox(addr, lbounds, extents, lengths); |
| } |
| |
| private: |
| /// Update the IR box (fir.ref<fir.box<T>>) of the MutableBoxValue. |
| void updateIRBox(mlir::Value addr, mlir::ValueRange lbounds, |
| mlir::ValueRange extents, mlir::ValueRange lengths, |
| mlir::Value tdesc = {}, |
| unsigned allocator = kDefaultAllocator) { |
| mlir::Value irBox = createNewFirBox(builder, loc, box, addr, lbounds, |
| extents, lengths, tdesc); |
| builder.create<fir::StoreOp>(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<fir::StoreOp>(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.isDerivedWithLenParameters()) |
| TODO(loc, "update allocatable derived type length parameters"); |
| } |
| fir::FirOpBuilder &builder; |
| mlir::Location loc; |
| fir::MutableBoxValue box; |
| mlir::Value typeSourceBox; |
| unsigned allocator; |
| }; |
| |
| } // namespace |
| |
| mlir::Value fir::factory::createUnallocatedBox( |
| fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type boxType, |
| mlir::ValueRange nonDeferredParams, mlir::Value typeSourceBox, |
| unsigned allocator) { |
| auto baseBoxType = mlir::cast<fir::BaseBoxType>(boxType); |
| // Giving unallocated/disassociated status to assumed-rank POINTER/ |
| // ALLOCATABLE is not directly possible to a Fortran user. But the |
| // compiler may need to create such temporary descriptor to deal with |
| // cases like ENTRY or host association. In such case, all that mater |
| // is that the base address is set to zero and the rank is set to |
| // some defined value. Hence, a scalar descriptor is created and |
| // cast to assumed-rank. |
| const bool isAssumedRank = baseBoxType.isAssumedRank(); |
| if (isAssumedRank) |
| baseBoxType = baseBoxType.getBoxTypeWithNewShape(/*rank=*/0); |
| auto baseAddrType = baseBoxType.getEleTy(); |
| if (!fir::isa_ref_type(baseAddrType)) |
| baseAddrType = builder.getRefType(baseAddrType); |
| auto type = fir::unwrapRefType(baseAddrType); |
| auto eleTy = fir::unwrapSequenceType(type); |
| if (auto recTy = mlir::dyn_cast<fir::RecordType>(eleTy)) |
| if (recTy.getNumLenParams() > 0) |
| TODO(loc, "creating unallocated fir.box of derived type with length " |
| "parameters"); |
| auto nullAddr = builder.createNullConstant(loc, baseAddrType); |
| mlir::Value shape; |
| if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(type)) { |
| auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); |
| llvm::SmallVector<mlir::Value> extents(seqTy.getDimension(), zero); |
| shape = builder.createShape( |
| loc, fir::ArrayBoxValue{nullAddr, extents, /*lbounds=*/std::nullopt}); |
| } |
| // 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<mlir::Value> lenParams; |
| if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) { |
| 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; |
| auto embox = builder.create<fir::EmboxOp>( |
| loc, baseBoxType, nullAddr, shape, emptySlice, lenParams, typeSourceBox); |
| if (allocator != 0) |
| embox.setAllocatorIdx(allocator); |
| if (isAssumedRank) |
| return builder.createConvert(loc, boxType, embox); |
| return embox; |
| } |
| |
| fir::MutableBoxValue fir::factory::createTempMutableBox( |
| fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type type, |
| llvm::StringRef name, mlir::Value typeSourceBox, bool isPolymorphic) { |
| mlir::Type boxType; |
| if (typeSourceBox || isPolymorphic) |
| boxType = fir::ClassType::get(fir::HeapType::get(type)); |
| else |
| 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, typeSourceBox} |
| .setUnallocatedStatus(); |
| return box; |
| } |
| |
| /// Helper to decide if a MutableBoxValue must be read to a 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; |
| if (box.hasAssumedRank()) |
| return true; |
| // Intrinsic allocatables are contiguous, no need to track the value by |
| // fir.box. |
| if (box.isAllocatable() || box.rank() == 0) |
| return false; |
| // Pointers 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, |
| bool preserveLowerBounds) { |
| llvm::SmallVector<mlir::Value> lbounds; |
| llvm::SmallVector<mlir::Value> extents; |
| llvm::SmallVector<mlir::Value> lengths; |
| if (readToBoxValue(box, mayBePolymorphic)) { |
| auto reader = MutablePropertyReader(builder, loc, box); |
| if (preserveLowerBounds && !box.hasAssumedRank()) |
| 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); |
| if (!preserveLowerBounds) |
| lbounds.clear(); |
| 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}; |
| } |
| mlir::Value sourceBox; |
| if (box.isPolymorphic()) |
| sourceBox = builder.create<fir::LoadOp>(loc, box.getAddr()); |
| if (rank) |
| return fir::ArrayBoxValue{addr, extents, lbounds, sourceBox}; |
| if (box.isPolymorphic()) |
| return fir::PolymorphicValue(addr, sourceBox); |
| 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.genIsNotNullAddr(loc, addr); |
| } |
| |
| mlir::Value fir::factory::genIsNotAllocatedOrAssociatedTest( |
| fir::FirOpBuilder &builder, mlir::Location loc, |
| const fir::MutableBoxValue &box) { |
| auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); |
| return builder.genIsNullAddr(loc, addr); |
| } |
| |
| /// Call freemem. This does not check that the |
| /// address was allocated. |
| static void genFreemem(fir::FirOpBuilder &builder, mlir::Location loc, |
| mlir::Value addr) { |
| // 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<fir::FreeMemOp>(loc, cast); |
| } |
| |
| void fir::factory::genFreememIfAllocated(fir::FirOpBuilder &builder, |
| mlir::Location loc, |
| const fir::MutableBoxValue &box) { |
| auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); |
| auto isAllocated = builder.genIsNotNullAddr(loc, addr); |
| auto ifOp = builder.create<fir::IfOp>(loc, isAllocated, |
| /*withElseRegion=*/false); |
| auto insPt = builder.saveInsertionPoint(); |
| builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); |
| ::genFreemem(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::PolymorphicValue &p) { |
| mlir::Value sourceBox; |
| if (auto polyBox = source.getBoxOf<fir::PolymorphicValue>()) |
| sourceBox = polyBox->getSourceBox(); |
| writer.updateMutableBox(p.getAddr(), /*lbounds=*/std::nullopt, |
| /*extents=*/std::nullopt, |
| /*lengths=*/std::nullopt, sourceBox); |
| }, |
| [&](const fir::UnboxedValue &addr) { |
| writer.updateMutableBox(addr, /*lbounds=*/std::nullopt, |
| /*extents=*/std::nullopt, |
| /*lengths=*/std::nullopt); |
| }, |
| [&](const fir::CharBoxValue &ch) { |
| writer.updateMutableBox(ch.getAddr(), /*lbounds=*/std::nullopt, |
| /*extents=*/std::nullopt, {ch.getLen()}); |
| }, |
| [&](const fir::ArrayBoxValue &arr) { |
| writer.updateMutableBox(arr.getAddr(), |
| lbounds.empty() ? arr.getLBounds() : lbounds, |
| arr.getExtents(), /*lengths=*/std::nullopt); |
| }, |
| [&](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.hasAssumedRank()) { |
| assert(arr.hasAssumedRank() && |
| "expect both arr and box to be assumed-rank"); |
| mlir::Value reboxed = builder.create<fir::ReboxAssumedRankOp>( |
| loc, box.getBoxTy(), arr.getAddr(), |
| fir::LowerBoundModifierAttribute::Preserve); |
| writer.updateWithIrBox(reboxed); |
| } else if (box.isDescribedByVariables()) { |
| // LHS is a contiguous pointer described by local variables. Open RHS |
| // fir.box to update the LHS. |
| auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(), |
| arr.getAddr()); |
| auto extents = fir::factory::getExtents(loc, builder, source); |
| llvm::SmallVector<mlir::Value> lenParams; |
| if (arr.isCharacter()) { |
| lenParams.emplace_back( |
| fir::factory::readCharLen(builder, loc, source)); |
| } else if (arr.isDerivedWithLenParameters()) { |
| 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<fir::ShiftOp>(loc, shiftType, newLbounds); |
| } |
| auto reboxed = |
| builder.create<fir::ReboxOp>(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<mlir::Value> 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<mlir::arith::SubIOp>(loc, idxTy, ubi, lbi); |
| extents.emplace_back( |
| builder.create<mlir::arith::AddIOp>(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 = mlir::dyn_cast<fir::SequenceType>(ty)) { |
| 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::PolymorphicValue &p) { |
| writer.updateMutableBox(cast(p.getAddr()), lbounds, extents, |
| /*lengths=*/std::nullopt); |
| }, |
| [&](const fir::UnboxedValue &addr) { |
| writer.updateMutableBox(cast(addr), lbounds, extents, |
| /*lengths=*/std::nullopt); |
| }, |
| [&](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=*/std::nullopt); |
| }, |
| [&](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<fir::BoxAddrOp>(loc, arr.getMemTy(), |
| arr.getAddr()); |
| llvm::SmallVector<mlir::Value> lenParams; |
| if (arr.isCharacter()) { |
| lenParams.emplace_back( |
| fir::factory::readCharLen(builder, loc, source)); |
| } else if (arr.isDerivedWithLenParameters()) { |
| 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<mlir::Value> 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<fir::ShapeShiftOp>(loc, shapeType, shapeArgs); |
| auto reboxed = |
| builder.create<fir::ReboxOp>(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, |
| bool polymorphicSetType, |
| unsigned allocator) { |
| if (box.isPolymorphic() && polymorphicSetType) { |
| // 7.3.2.3 point 7. The dynamic type of a disassociated pointer is the |
| // same as its declared type. |
| auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(box.getBoxTy()); |
| auto eleTy = fir::unwrapPassByRefType(boxTy.getEleTy()); |
| mlir::Type derivedType = fir::getDerivedType(eleTy); |
| if (auto recTy = mlir::dyn_cast<fir::RecordType>(derivedType)) { |
| fir::runtime::genNullifyDerivedType(builder, loc, box.getAddr(), recTy, |
| box.rank()); |
| return; |
| } |
| } |
| MutablePropertyWriter{builder, loc, box, {}, allocator} |
| .setUnallocatedStatus(); |
| } |
| |
| static llvm::SmallVector<mlir::Value> |
| getNewLengths(fir::FirOpBuilder &builder, mlir::Location loc, |
| const fir::MutableBoxValue &box, mlir::ValueRange lenParams) { |
| llvm::SmallVector<mlir::Value> lengths; |
| auto idxTy = builder.getIndexType(); |
| if (auto charTy = mlir::dyn_cast<fir::CharacterType>(box.getEleTy())) { |
| if (charTy.getLen() == fir::CharacterType::unknownLen()) { |
| if (box.hasNonDeferredLenParams()) { |
| lengths.emplace_back( |
| builder.createConvert(loc, idxTy, box.nonDeferredLenParams()[0])); |
| } else if (!lenParams.empty()) { |
| mlir::Value len = |
| fir::factory::genMaxWithZero(builder, loc, lenParams[0]); |
| lengths.emplace_back(builder.createConvert(loc, idxTy, len)); |
| } else { |
| fir::emitFatalError( |
| loc, "could not deduce character lengths in character allocation"); |
| } |
| } |
| } |
| return lengths; |
| } |
| |
| static mlir::Value allocateAndInitNewStorage(fir::FirOpBuilder &builder, |
| mlir::Location loc, |
| const fir::MutableBoxValue &box, |
| mlir::ValueRange extents, |
| mlir::ValueRange lenParams, |
| llvm::StringRef allocName) { |
| auto lengths = getNewLengths(builder, loc, box, lenParams); |
| auto newStorage = builder.create<fir::AllocMemOp>( |
| loc, box.getBaseTy(), allocName, lengths, extents); |
| if (mlir::isa<fir::RecordType>(box.getEleTy())) { |
| // TODO: skip runtime initialization if this is not required. Currently, |
| // there is no way to know here if a derived type needs it or not. But the |
| // information is available at compile time and could be reflected here |
| // somehow. |
| mlir::Value irBox = createNewFirBox(builder, loc, box, newStorage, |
| std::nullopt, extents, lengths); |
| fir::runtime::genDerivedTypeInitialize(builder, loc, irBox); |
| } |
| return newStorage; |
| } |
| |
| 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, bool mustBeHeap) { |
| auto lengths = getNewLengths(builder, loc, box, lenParams); |
| llvm::SmallVector<mlir::Value> safeExtents; |
| for (mlir::Value extent : extents) |
| safeExtents.push_back(fir::factory::genMaxWithZero(builder, loc, extent)); |
| auto heap = builder.create<fir::AllocMemOp>(loc, box.getBaseTy(), allocName, |
| lengths, safeExtents); |
| MutablePropertyWriter{builder, loc, box}.updateMutableBox( |
| heap, lbounds, safeExtents, lengths); |
| if (mlir::isa<fir::RecordType>(box.getEleTy())) { |
| // TODO: skip runtime initialization if this is not required. Currently, |
| // there is no way to know here if a derived type needs it or not. But the |
| // information is available at compile time and could be reflected here |
| // somehow. |
| mlir::Value irBox = fir::factory::getMutableIRBox(builder, loc, box); |
| fir::runtime::genDerivedTypeInitialize(builder, loc, irBox); |
| } |
| |
| heap->setAttr(fir::MustBeHeapAttr::getAttrName(), |
| fir::MustBeHeapAttr::get(builder.getContext(), mustBeHeap)); |
| } |
| |
| mlir::Value fir::factory::genFreemem(fir::FirOpBuilder &builder, |
| mlir::Location loc, |
| const fir::MutableBoxValue &box) { |
| auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); |
| ::genFreemem(builder, loc, addr); |
| MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); |
| return addr; |
| } |
| |
| fir::factory::MutableBoxReallocation fir::factory::genReallocIfNeeded( |
| fir::FirOpBuilder &builder, mlir::Location loc, |
| const fir::MutableBoxValue &box, mlir::ValueRange shape, |
| mlir::ValueRange lengthParams, |
| fir::factory::ReallocStorageHandlerFunc storageHandler) { |
| // Implement 10.2.1.3 point 3 logic when lhs is an array. |
| auto reader = MutablePropertyReader(builder, loc, box); |
| auto addr = reader.readBaseAddress(); |
| auto i1Type = builder.getI1Type(); |
| auto addrType = addr.getType(); |
| auto isAllocated = builder.genIsNotNullAddr(loc, addr); |
| auto getExtValForStorage = [&](mlir::Value newAddr) -> fir::ExtendedValue { |
| mlir::SmallVector<mlir::Value> extents; |
| if (box.hasRank()) { |
| if (shape.empty()) |
| extents = reader.readShape(); |
| else |
| extents.append(shape.begin(), shape.end()); |
| } |
| if (box.isCharacter()) { |
| auto len = box.hasNonDeferredLenParams() ? reader.readCharacterLength() |
| : lengthParams[0]; |
| if (box.hasRank()) |
| return fir::CharArrayBoxValue{newAddr, len, extents}; |
| return fir::CharBoxValue{newAddr, len}; |
| } |
| if (box.isDerivedWithLenParameters()) |
| TODO(loc, "reallocation of derived type entities with length parameters"); |
| if (box.hasRank()) |
| return fir::ArrayBoxValue{newAddr, extents}; |
| return newAddr; |
| }; |
| auto ifOp = |
| builder |
| .genIfOp(loc, {i1Type, addrType}, isAllocated, |
| /*withElseRegion=*/true) |
| .genThen([&]() { |
| // The box is allocated. Check if it must be reallocated and |
| // reallocate. |
| auto mustReallocate = builder.createBool(loc, false); |
| auto compareProperty = [&](mlir::Value previous, |
| mlir::Value required) { |
| auto castPrevious = |
| builder.createConvert(loc, required.getType(), previous); |
| auto cmp = builder.create<mlir::arith::CmpIOp>( |
| loc, mlir::arith::CmpIPredicate::ne, castPrevious, required); |
| mustReallocate = builder.create<mlir::arith::SelectOp>( |
| loc, cmp, cmp, mustReallocate); |
| }; |
| llvm::SmallVector<mlir::Value> previousExtents = reader.readShape(); |
| 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 occur in later assignment to it. |
| assert(!lengthParams.empty() && |
| "must provide length parameters for character"); |
| compareProperty(reader.readCharacterLength(), lengthParams[0]); |
| } else if (box.isDerivedWithLenParameters()) { |
| TODO(loc, "automatic allocation of derived type allocatable with " |
| "length parameters"); |
| } |
| auto ifOp = builder |
| .genIfOp(loc, {addrType}, mustReallocate, |
| /*withElseRegion=*/true) |
| .genThen([&]() { |
| // If shape or length mismatch, allocate new |
| // storage. When rhs is a scalar, keep the |
| // previous shape |
| auto extents = |
| shape.empty() |
| ? mlir::ValueRange(previousExtents) |
| : shape; |
| auto heap = allocateAndInitNewStorage( |
| builder, loc, box, extents, lengthParams, |
| ".auto.alloc"); |
| if (storageHandler) |
| storageHandler(getExtValForStorage(heap)); |
| builder.create<fir::ResultOp>(loc, heap); |
| }) |
| .genElse([&]() { |
| if (storageHandler) |
| storageHandler(getExtValForStorage(addr)); |
| builder.create<fir::ResultOp>(loc, addr); |
| }); |
| ifOp.end(); |
| auto newAddr = ifOp.getResults()[0]; |
| builder.create<fir::ResultOp>( |
| loc, mlir::ValueRange{mustReallocate, newAddr}); |
| }) |
| .genElse([&]() { |
| auto trueValue = builder.createBool(loc, true); |
| // The box is not yet allocated, simply allocate it. |
| if (shape.empty() && box.rank() != 0) { |
| // See 10.2.1.3 p3. |
| fir::runtime::genReportFatalUserError( |
| builder, loc, |
| "array left hand side must be allocated when the right hand " |
| "side is a scalar"); |
| builder.create<fir::ResultOp>(loc, |
| mlir::ValueRange{trueValue, addr}); |
| } else { |
| auto heap = allocateAndInitNewStorage( |
| builder, loc, box, shape, lengthParams, ".auto.alloc"); |
| if (storageHandler) |
| storageHandler(getExtValForStorage(heap)); |
| builder.create<fir::ResultOp>(loc, |
| mlir::ValueRange{trueValue, heap}); |
| } |
| }); |
| ifOp.end(); |
| auto wasReallocated = ifOp.getResults()[0]; |
| auto newAddr = ifOp.getResults()[1]; |
| // Create an ExtentedValue for the new storage. |
| auto newValue = getExtValForStorage(newAddr); |
| return {newValue, addr, wasReallocated, isAllocated}; |
| } |
| |
| void fir::factory::finalizeRealloc(fir::FirOpBuilder &builder, |
| mlir::Location loc, |
| const fir::MutableBoxValue &box, |
| mlir::ValueRange lbounds, |
| bool takeLboundsIfRealloc, |
| const MutableBoxReallocation &realloc) { |
| builder.genIfThen(loc, realloc.wasReallocated) |
| .genThen([&]() { |
| auto reader = MutablePropertyReader(builder, loc, box); |
| llvm::SmallVector<mlir::Value> previousLbounds; |
| if (!takeLboundsIfRealloc && box.hasRank()) |
| reader.readShape(&previousLbounds); |
| auto lbs = |
| takeLboundsIfRealloc ? lbounds : mlir::ValueRange{previousLbounds}; |
| llvm::SmallVector<mlir::Value> lenParams; |
| if (box.isCharacter()) |
| lenParams.push_back(fir::getLen(realloc.newValue)); |
| if (box.isDerivedWithLenParameters()) |
| TODO(loc, |
| "reallocation of derived type entities with length parameters"); |
| auto lengths = getNewLengths(builder, loc, box, lenParams); |
| auto heap = fir::getBase(realloc.newValue); |
| auto extents = fir::factory::getExtents(loc, builder, realloc.newValue); |
| builder.genIfThen(loc, realloc.oldAddressWasAllocated) |
| .genThen([&]() { ::genFreemem(builder, loc, realloc.oldAddress); }) |
| .end(); |
| MutablePropertyWriter{builder, loc, box}.updateMutableBox( |
| heap, lbs, extents, lengths); |
| }) |
| .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 or 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(); |
| } |
| |
| mlir::Value fir::factory::genNullBoxStorage(fir::FirOpBuilder &builder, |
| mlir::Location loc, |
| mlir::Type boxTy) { |
| mlir::Value boxStorage = builder.createTemporary(loc, boxTy); |
| mlir::Value nullBox = fir::factory::createUnallocatedBox( |
| builder, loc, boxTy, /*nonDeferredParams=*/{}); |
| builder.create<fir::StoreOp>(loc, nullBox, boxStorage); |
| return boxStorage; |
| } |
