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