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

source code of flang/lib/Optimizer/Builder/MutableBox.cpp