1003 lines · cpp
1//===-- MutableBox.cpp -- MutableBox utilities ----------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8//9// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/10//11//===----------------------------------------------------------------------===//12 13#include "flang/Optimizer/Builder/MutableBox.h"14#include "flang/Optimizer/Builder/Character.h"15#include "flang/Optimizer/Builder/FIRBuilder.h"16#include "flang/Optimizer/Builder/Runtime/Derived.h"17#include "flang/Optimizer/Builder/Runtime/Stop.h"18#include "flang/Optimizer/Builder/Todo.h"19#include "flang/Optimizer/Dialect/FIRAttr.h"20#include "flang/Optimizer/Dialect/FIROps.h"21#include "flang/Optimizer/Dialect/FIROpsSupport.h"22#include "flang/Optimizer/Support/FatalError.h"23 24/// Create a fir.box describing the new address, bounds, and length parameters25/// for a MutableBox \p box.26static mlir::Value27createNewFirBox(fir::FirOpBuilder &builder, mlir::Location loc,28 const fir::MutableBoxValue &box, mlir::Value addr,29 mlir::ValueRange lbounds, mlir::ValueRange extents,30 mlir::ValueRange lengths, mlir::Value tdesc = {}) {31 if (mlir::isa<fir::BaseBoxType>(addr.getType()))32 // The entity is already boxed.33 return builder.createConvert(loc, box.getBoxTy(), addr);34 35 mlir::Value shape;36 if (!extents.empty()) {37 if (lbounds.empty()) {38 shape = fir::ShapeOp::create(builder, loc, extents);39 } else {40 llvm::SmallVector<mlir::Value> shapeShiftBounds;41 for (auto [lb, extent] : llvm::zip(lbounds, extents)) {42 shapeShiftBounds.emplace_back(lb);43 shapeShiftBounds.emplace_back(extent);44 }45 auto shapeShiftType =46 fir::ShapeShiftType::get(builder.getContext(), extents.size());47 shape = fir::ShapeShiftOp::create(builder, loc, shapeShiftType,48 shapeShiftBounds);49 }50 } // Otherwise, this a scalar. Leave the shape empty.51 52 // Ignore lengths if already constant in the box type (this would trigger an53 // error in the embox).54 llvm::SmallVector<mlir::Value> cleanedLengths;55 auto cleanedAddr = addr;56 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(box.getEleTy())) {57 // Cast address to box type so that both input and output type have58 // unknown or constant lengths.59 auto bt = box.getBaseTy();60 auto addrTy = addr.getType();61 auto type = mlir::isa<fir::HeapType>(addrTy) ? fir::HeapType::get(bt)62 : mlir::isa<fir::PointerType>(addrTy)63 ? fir::PointerType::get(bt)64 : builder.getRefType(bt);65 cleanedAddr = builder.createConvert(loc, type, addr);66 if (charTy.getLen() == fir::CharacterType::unknownLen())67 cleanedLengths.append(lengths.begin(), lengths.end());68 } else if (fir::isUnlimitedPolymorphicType(box.getBoxTy())) {69 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(70 fir::getFortranElementType(addr.getType()))) {71 if (charTy.getLen() == fir::CharacterType::unknownLen())72 cleanedLengths.append(lengths.begin(), lengths.end());73 }74 } else if (box.isDerivedWithLenParameters()) {75 TODO(loc, "updating mutablebox of derived type with length parameters");76 cleanedLengths = lengths;77 }78 mlir::Value emptySlice;79 auto boxType = fir::updateTypeWithVolatility(80 box.getBoxTy(), fir::isa_volatile_type(cleanedAddr.getType()));81 return fir::EmboxOp::create(builder, loc, boxType, cleanedAddr, shape,82 emptySlice, cleanedLengths, tdesc);83}84 85//===----------------------------------------------------------------------===//86// MutableBoxValue writer and reader87//===----------------------------------------------------------------------===//88 89namespace {90/// MutablePropertyWriter and MutablePropertyReader implementations are the only91/// places that depend on how the properties of MutableBoxValue (pointers and92/// allocatables) that can be modified in the lifetime of the entity (address,93/// extents, lower bounds, length parameters) are represented.94/// That is, the properties may be only stored in a fir.box in memory if we95/// need to enforce a single point of truth for the properties across calls.96/// Or, they can be tracked as independent local variables when it is safe to97/// do so. Using bare variables benefits from all optimization passes, even98/// when they are not aware of what a fir.box is and fir.box have not been99/// optimized out yet.100 101/// MutablePropertyWriter allows reading the properties of a MutableBoxValue.102class MutablePropertyReader {103public:104 MutablePropertyReader(fir::FirOpBuilder &builder, mlir::Location loc,105 const fir::MutableBoxValue &box,106 bool forceIRBoxRead = false)107 : builder{builder}, loc{loc}, box{box} {108 if (forceIRBoxRead || !box.isDescribedByVariables())109 irBox = fir::LoadOp::create(builder, loc, box.getAddr());110 }111 /// Get base address of allocated/associated entity.112 mlir::Value readBaseAddress() {113 if (irBox) {114 auto memrefTy = box.getBoxTy().getEleTy();115 if (!fir::isa_ref_type(memrefTy))116 memrefTy = builder.getRefType(memrefTy);117 return fir::BoxAddrOp::create(builder, loc, memrefTy, irBox);118 }119 auto addrVar = box.getMutableProperties().addr;120 return fir::LoadOp::create(builder, loc, addrVar);121 }122 /// Return {lbound, extent} values read from the MutableBoxValue given123 /// the dimension.124 std::pair<mlir::Value, mlir::Value> readShape(unsigned dim) {125 auto idxTy = builder.getIndexType();126 if (irBox) {127 auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);128 auto dimInfo = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,129 irBox, dimVal);130 return {dimInfo.getResult(0), dimInfo.getResult(1)};131 }132 const auto &mutableProperties = box.getMutableProperties();133 auto lb = fir::LoadOp::create(builder, loc, mutableProperties.lbounds[dim]);134 auto ext =135 fir::LoadOp::create(builder, loc, mutableProperties.extents[dim]);136 return {lb, ext};137 }138 139 /// Return the character length. If the length was not deferred, the value140 /// that was specified is returned (The mutable fields is not read).141 mlir::Value readCharacterLength() {142 if (box.hasNonDeferredLenParams())143 return box.nonDeferredLenParams()[0];144 if (irBox)145 return fir::factory::CharacterExprHelper{builder, loc}.readLengthFromBox(146 irBox);147 const auto &deferred = box.getMutableProperties().deferredParams;148 if (deferred.empty())149 fir::emitFatalError(loc, "allocatable entity has no length property");150 return fir::LoadOp::create(builder, loc, deferred[0]);151 }152 153 /// Read and return all extents. If \p lbounds vector is provided, lbounds are154 /// also read into it.155 llvm::SmallVector<mlir::Value>156 readShape(llvm::SmallVectorImpl<mlir::Value> *lbounds = nullptr) {157 llvm::SmallVector<mlir::Value> extents;158 auto rank = box.rank();159 for (decltype(rank) dim = 0; dim < rank; ++dim) {160 auto [lb, extent] = readShape(dim);161 if (lbounds)162 lbounds->push_back(lb);163 extents.push_back(extent);164 }165 return extents;166 }167 168 /// Read all mutable properties. Return the base address.169 mlir::Value read(llvm::SmallVectorImpl<mlir::Value> &lbounds,170 llvm::SmallVectorImpl<mlir::Value> &extents,171 llvm::SmallVectorImpl<mlir::Value> &lengths) {172 extents = readShape(&lbounds);173 if (box.isCharacter())174 lengths.emplace_back(readCharacterLength());175 else if (box.isDerivedWithLenParameters())176 TODO(loc, "read allocatable or pointer derived type LEN parameters");177 return readBaseAddress();178 }179 180 /// Return the loaded fir.box.181 mlir::Value getIrBox() const {182 assert(irBox);183 return irBox;184 }185 186 /// Read the lower bounds187 void getLowerBounds(llvm::SmallVectorImpl<mlir::Value> &lbounds) {188 auto rank = box.rank();189 for (decltype(rank) dim = 0; dim < rank; ++dim)190 lbounds.push_back(std::get<0>(readShape(dim)));191 }192 193private:194 fir::FirOpBuilder &builder;195 mlir::Location loc;196 fir::MutableBoxValue box;197 mlir::Value irBox;198};199 200/// MutablePropertyWriter allows modifying the properties of a MutableBoxValue.201class MutablePropertyWriter {202public:203 MutablePropertyWriter(fir::FirOpBuilder &builder, mlir::Location loc,204 const fir::MutableBoxValue &box,205 mlir::Value typeSourceBox = {}, unsigned allocator = 0)206 : builder{builder}, loc{loc}, box{box}, typeSourceBox{typeSourceBox},207 allocator{allocator} {}208 /// Update MutableBoxValue with new address, shape and length parameters.209 /// Extents and lbounds must all have index type.210 /// lbounds can be empty in which case all ones is assumed.211 /// Length parameters must be provided for the length parameters that are212 /// deferred.213 void updateMutableBox(mlir::Value addr, mlir::ValueRange lbounds,214 mlir::ValueRange extents, mlir::ValueRange lengths,215 mlir::Value tdesc = {}) {216 if (box.isDescribedByVariables())217 updateMutableProperties(addr, lbounds, extents, lengths);218 else219 updateIRBox(addr, lbounds, extents, lengths, tdesc);220 }221 222 /// Update MutableBoxValue with a new fir.box. This requires that the mutable223 /// box is not described by a set of variables, since they could not describe224 /// all that can be described in the new fir.box (e.g. non contiguous entity).225 void updateWithIrBox(mlir::Value newBox) {226 assert(!box.isDescribedByVariables());227 fir::StoreOp::create(builder, loc, newBox, box.getAddr());228 }229 /// Set unallocated/disassociated status for the entity described by230 /// MutableBoxValue. Deallocation is not performed by this helper.231 void setUnallocatedStatus() {232 if (box.isDescribedByVariables()) {233 auto addrVar = box.getMutableProperties().addr;234 auto nullTy = fir::dyn_cast_ptrEleTy(addrVar.getType());235 fir::StoreOp::create(builder, loc,236 builder.createNullConstant(loc, nullTy), addrVar);237 } else {238 // Note that the dynamic type of polymorphic entities must be reset to the239 // declaration type of the mutable box. See Fortran 2018 7.8.2 NOTE 1.240 // For those, we cannot simply set the address to zero. The way we are241 // currently unallocating fir.box guarantees that we are resetting the242 // type to the declared type. Beware if changing this.243 // Note: the standard is not clear in Deallocate and p => NULL semantics244 // regarding the new dynamic type the entity must have. So far, assume245 // this is just like NULLIFY and the dynamic type must be set to the246 // declared type, not retain the previous dynamic type.247 auto deallocatedBox = fir::factory::createUnallocatedBox(248 builder, loc, box.getBoxTy(), box.nonDeferredLenParams(),249 typeSourceBox, allocator);250 fir::StoreOp::create(builder, loc, deallocatedBox, box.getAddr());251 }252 }253 254 /// Copy Values from the fir.box into the property variables if any.255 void syncMutablePropertiesFromIRBox() {256 if (!box.isDescribedByVariables())257 return;258 llvm::SmallVector<mlir::Value> lbounds;259 llvm::SmallVector<mlir::Value> extents;260 llvm::SmallVector<mlir::Value> lengths;261 auto addr =262 MutablePropertyReader{builder, loc, box, /*forceIRBoxRead=*/true}.read(263 lbounds, extents, lengths);264 updateMutableProperties(addr, lbounds, extents, lengths);265 }266 267 /// Copy Values from property variables, if any, into the fir.box.268 void syncIRBoxFromMutableProperties() {269 if (!box.isDescribedByVariables())270 return;271 llvm::SmallVector<mlir::Value> lbounds;272 llvm::SmallVector<mlir::Value> extents;273 llvm::SmallVector<mlir::Value> lengths;274 auto addr = MutablePropertyReader{builder, loc, box}.read(lbounds, extents,275 lengths);276 updateIRBox(addr, lbounds, extents, lengths);277 }278 279private:280 /// Update the IR box (fir.ref<fir.box<T>>) of the MutableBoxValue.281 void updateIRBox(mlir::Value addr, mlir::ValueRange lbounds,282 mlir::ValueRange extents, mlir::ValueRange lengths,283 mlir::Value tdesc = {},284 unsigned allocator = kDefaultAllocator) {285 mlir::Value irBox = createNewFirBox(builder, loc, box, addr, lbounds,286 extents, lengths, tdesc);287 const bool valueTypeIsVolatile =288 fir::isa_volatile_type(fir::unwrapRefType(box.getAddr().getType()));289 irBox = builder.createVolatileCast(loc, valueTypeIsVolatile, irBox);290 fir::StoreOp::create(builder, loc, irBox, box.getAddr());291 }292 293 /// Update the set of property variables of the MutableBoxValue.294 void updateMutableProperties(mlir::Value addr, mlir::ValueRange lbounds,295 mlir::ValueRange extents,296 mlir::ValueRange lengths) {297 auto castAndStore = [&](mlir::Value val, mlir::Value addr) {298 auto type = fir::dyn_cast_ptrEleTy(addr.getType());299 fir::StoreOp::create(builder, loc, builder.createConvert(loc, type, val),300 addr);301 };302 const auto &mutableProperties = box.getMutableProperties();303 castAndStore(addr, mutableProperties.addr);304 for (auto [extent, extentVar] :305 llvm::zip(extents, mutableProperties.extents))306 castAndStore(extent, extentVar);307 if (!mutableProperties.lbounds.empty()) {308 if (lbounds.empty()) {309 auto one =310 builder.createIntegerConstant(loc, builder.getIndexType(), 1);311 for (auto lboundVar : mutableProperties.lbounds)312 castAndStore(one, lboundVar);313 } else {314 for (auto [lbound, lboundVar] :315 llvm::zip(lbounds, mutableProperties.lbounds))316 castAndStore(lbound, lboundVar);317 }318 }319 if (box.isCharacter())320 // llvm::zip account for the fact that the length only needs to be stored321 // when it is specified in the allocation and deferred in the322 // MutableBoxValue.323 for (auto [len, lenVar] :324 llvm::zip(lengths, mutableProperties.deferredParams))325 castAndStore(len, lenVar);326 else if (box.isDerivedWithLenParameters())327 TODO(loc, "update allocatable derived type length parameters");328 }329 fir::FirOpBuilder &builder;330 mlir::Location loc;331 fir::MutableBoxValue box;332 mlir::Value typeSourceBox;333 unsigned allocator;334};335 336} // namespace337 338mlir::Value fir::factory::createUnallocatedBox(339 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type boxType,340 mlir::ValueRange nonDeferredParams, mlir::Value typeSourceBox,341 unsigned allocator) {342 auto baseBoxType = mlir::cast<fir::BaseBoxType>(boxType);343 // Giving unallocated/disassociated status to assumed-rank POINTER/344 // ALLOCATABLE is not directly possible to a Fortran user. But the345 // compiler may need to create such temporary descriptor to deal with346 // cases like ENTRY or host association. In such case, all that mater347 // is that the base address is set to zero and the rank is set to348 // some defined value. Hence, a scalar descriptor is created and349 // cast to assumed-rank.350 const bool isAssumedRank = baseBoxType.isAssumedRank();351 if (isAssumedRank)352 baseBoxType = baseBoxType.getBoxTypeWithNewShape(/*rank=*/0);353 auto baseAddrType = baseBoxType.getBaseAddressType();354 auto type = fir::unwrapRefType(baseAddrType);355 auto eleTy = fir::unwrapSequenceType(type);356 if (auto recTy = mlir::dyn_cast<fir::RecordType>(eleTy))357 if (recTy.getNumLenParams() > 0)358 TODO(loc, "creating unallocated fir.box of derived type with length "359 "parameters");360 auto nullAddr = builder.createNullConstant(loc, baseAddrType);361 mlir::Value shape;362 if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(type)) {363 auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0);364 llvm::SmallVector<mlir::Value> extents(seqTy.getDimension(), zero);365 shape = builder.createShape(366 loc, fir::ArrayBoxValue{nullAddr, extents, /*lbounds=*/{}});367 }368 // Provide dummy length parameters if they are dynamic. If a length parameter369 // is deferred. It is set to zero here and will be set on allocation.370 llvm::SmallVector<mlir::Value> lenParams;371 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {372 if (charTy.getLen() == fir::CharacterType::unknownLen()) {373 if (!nonDeferredParams.empty()) {374 lenParams.push_back(nonDeferredParams[0]);375 } else {376 auto zero = builder.createIntegerConstant(377 loc, builder.getCharacterLengthType(), 0);378 lenParams.push_back(zero);379 }380 }381 }382 mlir::Value emptySlice;383 auto embox = fir::EmboxOp::create(builder, loc, baseBoxType, nullAddr, shape,384 emptySlice, lenParams, typeSourceBox);385 if (allocator != 0)386 embox.setAllocatorIdx(allocator);387 if (isAssumedRank)388 return builder.createConvert(loc, boxType, embox);389 return embox;390}391 392fir::MutableBoxValue fir::factory::createTempMutableBox(393 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type type,394 llvm::StringRef name, mlir::Value typeSourceBox, bool isPolymorphic) {395 mlir::Type boxType;396 if (typeSourceBox || isPolymorphic)397 boxType = fir::ClassType::get(fir::HeapType::get(type));398 else399 boxType = fir::BoxType::get(fir::HeapType::get(type));400 auto boxAddr = builder.createTemporary(loc, boxType, name);401 auto box =402 fir::MutableBoxValue(boxAddr, /*nonDeferredParams=*/mlir::ValueRange(),403 /*mutableProperties=*/{});404 MutablePropertyWriter{builder, loc, box, typeSourceBox}405 .setUnallocatedStatus();406 return box;407}408 409/// Helper to decide if a MutableBoxValue must be read to a BoxValue or410/// can be read to a reified box value.411static bool readToBoxValue(const fir::MutableBoxValue &box,412 bool mayBePolymorphic) {413 // If this is described by a set of local variables, the value414 // should not be tracked as a fir.box.415 if (box.isDescribedByVariables())416 return false;417 // Polymorphism might be a source of discontiguity, even on allocatables.418 // Track value as fir.box419 if ((box.isDerived() && mayBePolymorphic) || box.isUnlimitedPolymorphic())420 return true;421 if (box.hasAssumedRank())422 return true;423 // Intrinsic allocatables are contiguous, no need to track the value by424 // fir.box.425 if (box.isAllocatable() || box.rank() == 0)426 return false;427 // Pointers are known to be contiguous at compile time iff they have the428 // CONTIGUOUS attribute.429 return !fir::valueHasFirAttribute(box.getAddr(),430 fir::getContiguousAttrName());431}432 433fir::ExtendedValue434fir::factory::genMutableBoxRead(fir::FirOpBuilder &builder, mlir::Location loc,435 const fir::MutableBoxValue &box,436 bool mayBePolymorphic,437 bool preserveLowerBounds) {438 llvm::SmallVector<mlir::Value> lbounds;439 llvm::SmallVector<mlir::Value> extents;440 llvm::SmallVector<mlir::Value> lengths;441 if (readToBoxValue(box, mayBePolymorphic)) {442 auto reader = MutablePropertyReader(builder, loc, box);443 if (preserveLowerBounds && !box.hasAssumedRank())444 reader.getLowerBounds(lbounds);445 return fir::BoxValue{reader.getIrBox(), lbounds,446 box.nonDeferredLenParams()};447 }448 // Contiguous intrinsic type entity: all the data can be extracted from the449 // fir.box.450 auto addr =451 MutablePropertyReader(builder, loc, box).read(lbounds, extents, lengths);452 if (!preserveLowerBounds)453 lbounds.clear();454 auto rank = box.rank();455 if (box.isCharacter()) {456 auto len = lengths.empty() ? mlir::Value{} : lengths[0];457 if (rank)458 return fir::CharArrayBoxValue{addr, len, extents, lbounds};459 return fir::CharBoxValue{addr, len};460 }461 mlir::Value sourceBox;462 if (box.isPolymorphic())463 sourceBox = fir::LoadOp::create(builder, loc, box.getAddr());464 if (rank)465 return fir::ArrayBoxValue{addr, extents, lbounds, sourceBox};466 if (box.isPolymorphic())467 return fir::PolymorphicValue(addr, sourceBox);468 return addr;469}470 471mlir::Value472fir::factory::genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,473 mlir::Location loc,474 const fir::MutableBoxValue &box) {475 auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();476 return builder.genIsNotNullAddr(loc, addr);477}478 479mlir::Value fir::factory::genIsNotAllocatedOrAssociatedTest(480 fir::FirOpBuilder &builder, mlir::Location loc,481 const fir::MutableBoxValue &box) {482 auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();483 return builder.genIsNullAddr(loc, addr);484}485 486/// Call freemem. This does not check that the487/// address was allocated.488static void genFreemem(fir::FirOpBuilder &builder, mlir::Location loc,489 mlir::Value addr) {490 // A heap (ALLOCATABLE) object may have been converted to a ptr (POINTER),491 // so make sure the heap type is restored before deallocation.492 auto cast = builder.createConvert(493 loc, fir::HeapType::get(fir::dyn_cast_ptrEleTy(addr.getType())), addr);494 fir::FreeMemOp::create(builder, loc, cast);495}496 497void fir::factory::genFreememIfAllocated(fir::FirOpBuilder &builder,498 mlir::Location loc,499 const fir::MutableBoxValue &box) {500 auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();501 auto isAllocated = builder.genIsNotNullAddr(loc, addr);502 auto ifOp = fir::IfOp::create(builder, loc, isAllocated,503 /*withElseRegion=*/false);504 auto insPt = builder.saveInsertionPoint();505 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());506 ::genFreemem(builder, loc, addr);507 builder.restoreInsertionPoint(insPt);508}509 510//===----------------------------------------------------------------------===//511// MutableBoxValue writing interface implementation512//===----------------------------------------------------------------------===//513 514void fir::factory::associateMutableBox(fir::FirOpBuilder &builder,515 mlir::Location loc,516 const fir::MutableBoxValue &box,517 const fir::ExtendedValue &source,518 mlir::ValueRange lbounds) {519 MutablePropertyWriter writer(builder, loc, box);520 source.match(521 [&](const fir::PolymorphicValue &p) {522 mlir::Value sourceBox;523 if (auto *polyBox = source.getBoxOf<fir::PolymorphicValue>())524 sourceBox = polyBox->getSourceBox();525 writer.updateMutableBox(p.getAddr(), /*lbounds=*/{},526 /*extents=*/{},527 /*lengths=*/{}, sourceBox);528 },529 [&](const fir::UnboxedValue &addr) {530 writer.updateMutableBox(addr, /*lbounds=*/{},531 /*extents=*/{},532 /*lengths=*/{});533 },534 [&](const fir::CharBoxValue &ch) {535 writer.updateMutableBox(ch.getAddr(), /*lbounds=*/{},536 /*extents=*/{}, {ch.getLen()});537 },538 [&](const fir::ArrayBoxValue &arr) {539 writer.updateMutableBox(arr.getAddr(),540 lbounds.empty() ? arr.getLBounds() : lbounds,541 arr.getExtents(), /*lengths=*/{});542 },543 [&](const fir::CharArrayBoxValue &arr) {544 writer.updateMutableBox(arr.getAddr(),545 lbounds.empty() ? arr.getLBounds() : lbounds,546 arr.getExtents(), {arr.getLen()});547 },548 [&](const fir::BoxValue &arr) {549 // Rebox array fir.box to the pointer type and apply potential new lower550 // bounds.551 mlir::ValueRange newLbounds = lbounds.empty()552 ? mlir::ValueRange{arr.getLBounds()}553 : mlir::ValueRange{lbounds};554 if (box.hasAssumedRank()) {555 assert(arr.hasAssumedRank() &&556 "expect both arr and box to be assumed-rank");557 mlir::Value reboxed = fir::ReboxAssumedRankOp::create(558 builder, loc, box.getBoxTy(), arr.getAddr(),559 fir::LowerBoundModifierAttribute::Preserve);560 writer.updateWithIrBox(reboxed);561 } else if (box.isDescribedByVariables()) {562 // LHS is a contiguous pointer described by local variables. Open RHS563 // fir.box to update the LHS.564 auto rawAddr = fir::BoxAddrOp::create(builder, loc, arr.getMemTy(),565 arr.getAddr());566 auto extents = fir::factory::getExtents(loc, builder, source);567 llvm::SmallVector<mlir::Value> lenParams;568 if (arr.isCharacter()) {569 lenParams.emplace_back(570 fir::factory::readCharLen(builder, loc, source));571 } else if (arr.isDerivedWithLenParameters()) {572 TODO(loc, "pointer assignment to derived with length parameters");573 }574 writer.updateMutableBox(rawAddr, newLbounds, extents, lenParams);575 } else {576 mlir::Value shift;577 if (!newLbounds.empty()) {578 auto shiftType =579 fir::ShiftType::get(builder.getContext(), newLbounds.size());580 shift = fir::ShiftOp::create(builder, loc, shiftType, newLbounds);581 }582 auto reboxed =583 fir::ReboxOp::create(builder, loc, box.getBoxTy(), arr.getAddr(),584 shift, /*slice=*/mlir::Value());585 writer.updateWithIrBox(reboxed);586 }587 },588 [&](const fir::MutableBoxValue &) {589 // No point implementing this, if right-hand side is a590 // pointer/allocatable, the related MutableBoxValue has been read into591 // another ExtendedValue category.592 fir::emitFatalError(loc,593 "Cannot write MutableBox to another MutableBox");594 },595 [&](const fir::ProcBoxValue &) {596 TODO(loc, "procedure pointer assignment");597 });598}599 600void fir::factory::associateMutableBoxWithRemap(601 fir::FirOpBuilder &builder, mlir::Location loc,602 const fir::MutableBoxValue &box, const fir::ExtendedValue &source,603 mlir::ValueRange lbounds, mlir::ValueRange ubounds) {604 // Compute new extents605 llvm::SmallVector<mlir::Value> extents;606 mlir::Type idxTy = builder.getIndexType();607 mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);608 if (!lbounds.empty()) {609 auto one = builder.createIntegerConstant(loc, idxTy, 1);610 for (auto [lb, ub] : llvm::zip(lbounds, ubounds)) {611 612 mlir::Value lbi = builder.createConvert(loc, idxTy, lb);613 mlir::Value ubi = builder.createConvert(loc, idxTy, ub);614 extents.emplace_back(615 fir::factory::computeExtent(builder, loc, lbi, ubi, zero, one));616 }617 } else {618 // lbounds are default. Upper bounds and extents are the same.619 for (mlir::Value ub : ubounds) {620 mlir::Value cast = builder.createConvert(loc, idxTy, ub);621 extents.emplace_back(622 fir::factory::genMaxWithZero(builder, loc, cast, zero));623 }624 }625 const auto newRank = extents.size();626 auto cast = [&](mlir::Value addr) -> mlir::Value {627 // Cast base addr to new sequence type.628 auto ty = fir::dyn_cast_ptrEleTy(addr.getType());629 if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(ty)) {630 fir::SequenceType::Shape shape(newRank,631 fir::SequenceType::getUnknownExtent());632 ty = fir::SequenceType::get(shape, seqTy.getEleTy());633 }634 return builder.createConvert(loc, builder.getRefType(ty), addr);635 };636 MutablePropertyWriter writer(builder, loc, box);637 source.match(638 [&](const fir::PolymorphicValue &p) {639 writer.updateMutableBox(cast(p.getAddr()), lbounds, extents,640 /*lengths=*/{});641 },642 [&](const fir::UnboxedValue &addr) {643 writer.updateMutableBox(cast(addr), lbounds, extents,644 /*lengths=*/{});645 },646 [&](const fir::CharBoxValue &ch) {647 writer.updateMutableBox(cast(ch.getAddr()), lbounds, extents,648 {ch.getLen()});649 },650 [&](const fir::ArrayBoxValue &arr) {651 writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents,652 /*lengths=*/{});653 },654 [&](const fir::CharArrayBoxValue &arr) {655 writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents,656 {arr.getLen()});657 },658 [&](const fir::BoxValue &arr) {659 // Rebox right-hand side fir.box with a new shape and type.660 if (box.isDescribedByVariables()) {661 // LHS is a contiguous pointer described by local variables. Open RHS662 // fir.box to update the LHS.663 auto rawAddr = fir::BoxAddrOp::create(builder, loc, arr.getMemTy(),664 arr.getAddr());665 llvm::SmallVector<mlir::Value> lenParams;666 if (arr.isCharacter()) {667 lenParams.emplace_back(668 fir::factory::readCharLen(builder, loc, source));669 } else if (arr.isDerivedWithLenParameters()) {670 TODO(loc, "pointer assignment to derived with length parameters");671 }672 writer.updateMutableBox(rawAddr, lbounds, extents, lenParams);673 } else {674 auto shapeType =675 fir::ShapeShiftType::get(builder.getContext(), extents.size());676 llvm::SmallVector<mlir::Value> shapeArgs;677 auto idxTy = builder.getIndexType();678 for (auto [lbnd, ext] : llvm::zip(lbounds, extents)) {679 auto lb = builder.createConvert(loc, idxTy, lbnd);680 shapeArgs.push_back(lb);681 shapeArgs.push_back(ext);682 }683 auto shape =684 fir::ShapeShiftOp::create(builder, loc, shapeType, shapeArgs);685 auto reboxed =686 fir::ReboxOp::create(builder, loc, box.getBoxTy(), arr.getAddr(),687 shape, /*slice=*/mlir::Value());688 writer.updateWithIrBox(reboxed);689 }690 },691 [&](const fir::MutableBoxValue &) {692 // No point implementing this, if right-hand side is a pointer or693 // allocatable, the related MutableBoxValue has already been read into694 // another ExtendedValue category.695 fir::emitFatalError(loc,696 "Cannot write MutableBox to another MutableBox");697 },698 [&](const fir::ProcBoxValue &) {699 TODO(loc, "procedure pointer assignment");700 });701}702 703void fir::factory::disassociateMutableBox(fir::FirOpBuilder &builder,704 mlir::Location loc,705 const fir::MutableBoxValue &box,706 bool polymorphicSetType,707 unsigned allocator) {708 if (box.isPolymorphic() && polymorphicSetType) {709 // 7.3.2.3 point 7. The dynamic type of a disassociated pointer is the710 // same as its declared type.711 auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(box.getBoxTy());712 auto eleTy = fir::unwrapPassByRefType(boxTy.getEleTy());713 mlir::Type derivedType = fir::getDerivedType(eleTy);714 if (auto recTy = mlir::dyn_cast<fir::RecordType>(derivedType)) {715 fir::runtime::genNullifyDerivedType(builder, loc, box.getAddr(), recTy,716 box.rank());717 return;718 }719 }720 MutablePropertyWriter{builder, loc, box, {}, allocator}721 .setUnallocatedStatus();722}723 724static llvm::SmallVector<mlir::Value>725getNewLengths(fir::FirOpBuilder &builder, mlir::Location loc,726 const fir::MutableBoxValue &box, mlir::ValueRange lenParams) {727 llvm::SmallVector<mlir::Value> lengths;728 auto idxTy = builder.getIndexType();729 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(box.getEleTy())) {730 if (charTy.getLen() == fir::CharacterType::unknownLen()) {731 if (box.hasNonDeferredLenParams()) {732 lengths.emplace_back(733 builder.createConvert(loc, idxTy, box.nonDeferredLenParams()[0]));734 } else if (!lenParams.empty()) {735 mlir::Value len =736 fir::factory::genMaxWithZero(builder, loc, lenParams[0]);737 lengths.emplace_back(builder.createConvert(loc, idxTy, len));738 } else {739 fir::emitFatalError(740 loc, "could not deduce character lengths in character allocation");741 }742 }743 }744 return lengths;745}746 747static mlir::Value allocateAndInitNewStorage(fir::FirOpBuilder &builder,748 mlir::Location loc,749 const fir::MutableBoxValue &box,750 mlir::ValueRange extents,751 mlir::ValueRange lenParams,752 llvm::StringRef allocName) {753 auto lengths = getNewLengths(builder, loc, box, lenParams);754 auto newStorage = fir::AllocMemOp::create(builder, loc, box.getBaseTy(),755 allocName, lengths, extents);756 if (mlir::isa<fir::RecordType>(box.getEleTy())) {757 // TODO: skip runtime initialization if this is not required. Currently,758 // there is no way to know here if a derived type needs it or not. But the759 // information is available at compile time and could be reflected here760 // somehow.761 mlir::Value irBox =762 createNewFirBox(builder, loc, box, newStorage, {}, extents, lengths);763 fir::runtime::genDerivedTypeInitialize(builder, loc, irBox);764 }765 return newStorage;766}767 768void fir::factory::genInlinedAllocation(769 fir::FirOpBuilder &builder, mlir::Location loc,770 const fir::MutableBoxValue &box, mlir::ValueRange lbounds,771 mlir::ValueRange extents, mlir::ValueRange lenParams,772 llvm::StringRef allocName, bool mustBeHeap) {773 auto lengths = getNewLengths(builder, loc, box, lenParams);774 llvm::SmallVector<mlir::Value> safeExtents;775 for (mlir::Value extent : extents)776 safeExtents.push_back(fir::factory::genMaxWithZero(builder, loc, extent));777 auto heap = fir::AllocMemOp::create(builder, loc, box.getBaseTy(), allocName,778 lengths, safeExtents);779 MutablePropertyWriter{builder, loc, box}.updateMutableBox(780 heap, lbounds, safeExtents, lengths);781 if (mlir::isa<fir::RecordType>(box.getEleTy())) {782 // TODO: skip runtime initialization if this is not required. Currently,783 // there is no way to know here if a derived type needs it or not. But the784 // information is available at compile time and could be reflected here785 // somehow.786 mlir::Value irBox = fir::factory::getMutableIRBox(builder, loc, box);787 fir::runtime::genDerivedTypeInitialize(builder, loc, irBox);788 }789 790 heap->setAttr(fir::MustBeHeapAttr::getAttrName(),791 fir::MustBeHeapAttr::get(builder.getContext(), mustBeHeap));792}793 794mlir::Value fir::factory::genFreemem(fir::FirOpBuilder &builder,795 mlir::Location loc,796 const fir::MutableBoxValue &box) {797 auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();798 ::genFreemem(builder, loc, addr);799 MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus();800 return addr;801}802 803fir::factory::MutableBoxReallocation fir::factory::genReallocIfNeeded(804 fir::FirOpBuilder &builder, mlir::Location loc,805 const fir::MutableBoxValue &box, mlir::ValueRange shape,806 mlir::ValueRange lengthParams,807 fir::factory::ReallocStorageHandlerFunc storageHandler) {808 // Implement 10.2.1.3 point 3 logic when lhs is an array.809 auto reader = MutablePropertyReader(builder, loc, box);810 auto addr = reader.readBaseAddress();811 auto i1Type = builder.getI1Type();812 auto addrType = addr.getType();813 auto isAllocated = builder.genIsNotNullAddr(loc, addr);814 auto getExtValForStorage = [&](mlir::Value newAddr) -> fir::ExtendedValue {815 mlir::SmallVector<mlir::Value> extents;816 if (box.hasRank()) {817 if (shape.empty())818 extents = reader.readShape();819 else820 extents.append(shape.begin(), shape.end());821 }822 if (box.isCharacter()) {823 auto len = box.hasNonDeferredLenParams() ? reader.readCharacterLength()824 : lengthParams[0];825 if (box.hasRank())826 return fir::CharArrayBoxValue{newAddr, len, extents};827 return fir::CharBoxValue{newAddr, len};828 }829 if (box.isDerivedWithLenParameters())830 TODO(loc, "reallocation of derived type entities with length parameters");831 if (box.hasRank())832 return fir::ArrayBoxValue{newAddr, extents};833 return newAddr;834 };835 auto ifOp =836 builder837 .genIfOp(loc, {i1Type, addrType}, isAllocated,838 /*withElseRegion=*/true)839 .genThen([&]() {840 // The box is allocated. Check if it must be reallocated and841 // reallocate.842 auto mustReallocate = builder.createBool(loc, false);843 auto compareProperty = [&](mlir::Value previous,844 mlir::Value required) {845 auto castPrevious =846 builder.createConvert(loc, required.getType(), previous);847 auto cmp = mlir::arith::CmpIOp::create(848 builder, loc, mlir::arith::CmpIPredicate::ne, castPrevious,849 required);850 mustReallocate = mlir::arith::SelectOp::create(851 builder, loc, cmp, cmp, mustReallocate);852 };853 llvm::SmallVector<mlir::Value> previousExtents = reader.readShape();854 if (!shape.empty())855 for (auto [previousExtent, requested] :856 llvm::zip(previousExtents, shape))857 compareProperty(previousExtent, requested);858 859 if (box.isCharacter() && !box.hasNonDeferredLenParams()) {860 // When the allocatable length is not deferred, it must not be861 // reallocated in case of length mismatch, instead,862 // padding/trimming will occur in later assignment to it.863 assert(!lengthParams.empty() &&864 "must provide length parameters for character");865 compareProperty(reader.readCharacterLength(), lengthParams[0]);866 } else if (box.isDerivedWithLenParameters()) {867 TODO(loc, "automatic allocation of derived type allocatable with "868 "length parameters");869 }870 auto ifOp = builder871 .genIfOp(loc, {addrType}, mustReallocate,872 /*withElseRegion=*/true)873 .genThen([&]() {874 // If shape or length mismatch, allocate new875 // storage. When rhs is a scalar, keep the876 // previous shape877 auto extents =878 shape.empty()879 ? mlir::ValueRange(previousExtents)880 : shape;881 auto heap = allocateAndInitNewStorage(882 builder, loc, box, extents, lengthParams,883 ".auto.alloc");884 if (storageHandler)885 storageHandler(getExtValForStorage(heap));886 fir::ResultOp::create(builder, loc, heap);887 })888 .genElse([&]() {889 if (storageHandler)890 storageHandler(getExtValForStorage(addr));891 fir::ResultOp::create(builder, loc, addr);892 });893 ifOp.end();894 auto newAddr = ifOp.getResults()[0];895 fir::ResultOp::create(builder, loc,896 mlir::ValueRange{mustReallocate, newAddr});897 })898 .genElse([&]() {899 auto trueValue = builder.createBool(loc, true);900 // The box is not yet allocated, simply allocate it.901 if (shape.empty() && box.rank() != 0) {902 // See 10.2.1.3 p3.903 fir::runtime::genReportFatalUserError(904 builder, loc,905 "array left hand side must be allocated when the right hand "906 "side is a scalar");907 fir::ResultOp::create(builder, loc,908 mlir::ValueRange{trueValue, addr});909 } else {910 auto heap = allocateAndInitNewStorage(911 builder, loc, box, shape, lengthParams, ".auto.alloc");912 if (storageHandler)913 storageHandler(getExtValForStorage(heap));914 fir::ResultOp::create(builder, loc,915 mlir::ValueRange{trueValue, heap});916 }917 });918 ifOp.end();919 auto wasReallocated = ifOp.getResults()[0];920 auto newAddr = ifOp.getResults()[1];921 // Create an ExtentedValue for the new storage.922 auto newValue = getExtValForStorage(newAddr);923 return {newValue, addr, wasReallocated, isAllocated};924}925 926void fir::factory::finalizeRealloc(fir::FirOpBuilder &builder,927 mlir::Location loc,928 const fir::MutableBoxValue &box,929 mlir::ValueRange lbounds,930 bool takeLboundsIfRealloc,931 const MutableBoxReallocation &realloc) {932 builder.genIfThen(loc, realloc.wasReallocated)933 .genThen([&]() {934 auto reader = MutablePropertyReader(builder, loc, box);935 llvm::SmallVector<mlir::Value> previousLbounds;936 if (!takeLboundsIfRealloc && box.hasRank())937 reader.readShape(&previousLbounds);938 auto lbs =939 takeLboundsIfRealloc ? lbounds : mlir::ValueRange{previousLbounds};940 llvm::SmallVector<mlir::Value> lenParams;941 if (box.isCharacter())942 lenParams.push_back(fir::getLen(realloc.newValue));943 if (box.isDerivedWithLenParameters())944 TODO(loc,945 "reallocation of derived type entities with length parameters");946 auto lengths = getNewLengths(builder, loc, box, lenParams);947 auto heap = fir::getBase(realloc.newValue);948 auto extents = fir::factory::getExtents(loc, builder, realloc.newValue);949 builder.genIfThen(loc, realloc.oldAddressWasAllocated)950 .genThen([&]() { ::genFreemem(builder, loc, realloc.oldAddress); })951 .end();952 MutablePropertyWriter{builder, loc, box}.updateMutableBox(953 heap, lbs, extents, lengths);954 })955 .end();956}957 958//===----------------------------------------------------------------------===//959// MutableBoxValue syncing implementation960//===----------------------------------------------------------------------===//961 962/// Depending on the implementation, allocatable/pointer descriptor and the963/// MutableBoxValue need to be synced before and after calls passing the964/// descriptor. These calls will generate the syncing if needed or be no-op.965mlir::Value fir::factory::getMutableIRBox(fir::FirOpBuilder &builder,966 mlir::Location loc,967 const fir::MutableBoxValue &box) {968 MutablePropertyWriter{builder, loc, box}.syncIRBoxFromMutableProperties();969 return box.getAddr();970}971void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder,972 mlir::Location loc,973 const fir::MutableBoxValue &box) {974 MutablePropertyWriter{builder, loc, box}.syncMutablePropertiesFromIRBox();975}976 977mlir::Value fir::factory::genNullBoxStorage(fir::FirOpBuilder &builder,978 mlir::Location loc,979 mlir::Type boxTy) {980 mlir::Value boxStorage = builder.createTemporary(loc, boxTy);981 mlir::Value nullBox = fir::factory::createUnallocatedBox(982 builder, loc, boxTy, /*nonDeferredParams=*/{});983 fir::StoreOp::create(builder, loc, nullBox, boxStorage);984 return boxStorage;985}986 987mlir::Value fir::factory::getAndEstablishBoxStorage(988 fir::FirOpBuilder &builder, mlir::Location loc, fir::BaseBoxType boxTy,989 mlir::Value shape, llvm::ArrayRef<mlir::Value> typeParams,990 mlir::Value polymorphicMold) {991 mlir::Value boxStorage = builder.createTemporary(loc, boxTy);992 mlir::Value nullAddr =993 builder.createNullConstant(loc, boxTy.getBaseAddressType());994 mlir::Value box =995 fir::EmboxOp::create(builder, loc, boxTy, nullAddr, shape,996 /*emptySlice=*/mlir::Value{},997 fir::factory::elideLengthsAlreadyInType(998 boxTy.unwrapInnerType(), typeParams),999 polymorphicMold);1000 fir::StoreOp::create(builder, loc, box, boxStorage);1001 return boxStorage;1002}1003