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