//===-- 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;
}
Codebase Browser
llvm