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

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