1 | //===-- MutableBox.cpp -- MutableBox utilities ----------------------------===// |
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | // |
9 | // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ |
10 | // |
11 | //===----------------------------------------------------------------------===// |
12 | |
13 | #include "flang/Optimizer/Builder/MutableBox.h" |
14 | #include "flang/Optimizer/Builder/Character.h" |
15 | #include "flang/Optimizer/Builder/FIRBuilder.h" |
16 | #include "flang/Optimizer/Builder/Runtime/Derived.h" |
17 | #include "flang/Optimizer/Builder/Runtime/Stop.h" |
18 | #include "flang/Optimizer/Builder/Todo.h" |
19 | #include "flang/Optimizer/Dialect/FIRAttr.h" |
20 | #include "flang/Optimizer/Dialect/FIROps.h" |
21 | #include "flang/Optimizer/Dialect/FIROpsSupport.h" |
22 | #include "flang/Optimizer/Support/FatalError.h" |
23 | |
24 | /// Create a fir.box describing the new address, bounds, and length parameters |
25 | /// for a MutableBox \p box. |
26 | static mlir::Value |
27 | createNewFirBox(fir::FirOpBuilder &builder, mlir::Location loc, |
28 | const fir::MutableBoxValue &box, mlir::Value addr, |
29 | mlir::ValueRange lbounds, mlir::ValueRange extents, |
30 | mlir::ValueRange lengths, mlir::Value tdesc = {}) { |
31 | if (mlir::isa<fir::BaseBoxType>(addr.getType())) |
32 | // The entity is already boxed. |
33 | return builder.createConvert(loc, box.getBoxTy(), addr); |
34 | |
35 | mlir::Value shape; |
36 | if (!extents.empty()) { |
37 | if (lbounds.empty()) { |
38 | shape = builder.create<fir::ShapeOp>(loc, extents); |
39 | } else { |
40 | llvm::SmallVector<mlir::Value> shapeShiftBounds; |
41 | for (auto [lb, extent] : llvm::zip(lbounds, extents)) { |
42 | shapeShiftBounds.emplace_back(lb); |
43 | shapeShiftBounds.emplace_back(extent); |
44 | } |
45 | auto shapeShiftType = |
46 | fir::ShapeShiftType::get(builder.getContext(), extents.size()); |
47 | shape = builder.create<fir::ShapeShiftOp>(loc, shapeShiftType, |
48 | shapeShiftBounds); |
49 | } |
50 | } // Otherwise, this a scalar. Leave the shape empty. |
51 | |
52 | // Ignore lengths if already constant in the box type (this would trigger an |
53 | // error in the embox). |
54 | llvm::SmallVector<mlir::Value> cleanedLengths; |
55 | auto cleanedAddr = addr; |
56 | if (auto charTy = mlir::dyn_cast<fir::CharacterType>(box.getEleTy())) { |
57 | // Cast address to box type so that both input and output type have |
58 | // unknown or constant lengths. |
59 | auto bt = box.getBaseTy(); |
60 | auto addrTy = addr.getType(); |
61 | auto type = mlir::isa<fir::HeapType>(addrTy) ? fir::HeapType::get(bt) |
62 | : mlir::isa<fir::PointerType>(addrTy) |
63 | ? fir::PointerType::get(bt) |
64 | : builder.getRefType(bt); |
65 | cleanedAddr = builder.createConvert(loc, type, addr); |
66 | if (charTy.getLen() == fir::CharacterType::unknownLen()) |
67 | cleanedLengths.append(lengths.begin(), lengths.end()); |
68 | } else if (fir::isUnlimitedPolymorphicType(box.getBoxTy())) { |
69 | if (auto charTy = mlir::dyn_cast<fir::CharacterType>( |
70 | fir::dyn_cast_ptrEleTy(addr.getType()))) { |
71 | if (charTy.getLen() == fir::CharacterType::unknownLen()) |
72 | cleanedLengths.append(lengths.begin(), lengths.end()); |
73 | } |
74 | } else if (box.isDerivedWithLenParameters()) { |
75 | TODO(loc, "updating mutablebox of derived type with length parameters" ); |
76 | cleanedLengths = lengths; |
77 | } |
78 | mlir::Value emptySlice; |
79 | 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 | |
89 | namespace { |
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. |
102 | class MutablePropertyReader { |
103 | public: |
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 | |
192 | private: |
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. |
200 | class MutablePropertyWriter { |
201 | public: |
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 | |
278 | private: |
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 | |
337 | mlir::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 | |
391 | fir::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. |
410 | static 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 | |
432 | fir::ExtendedValue |
433 | fir::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 | |
470 | mlir::Value |
471 | fir::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 | |
478 | mlir::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. |
487 | static 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 | |
496 | void 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 | |
513 | void 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 | |
599 | void 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 | |
700 | void 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 | |
721 | static llvm::SmallVector<mlir::Value> |
722 | getNewLengths(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 | |
744 | static 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 | |
765 | void 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 | |
791 | mlir::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 | |
800 | fir::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 | |
922 | void 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. |
961 | mlir::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 | } |
967 | void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, |
968 | mlir::Location loc, |
969 | const fir::MutableBoxValue &box) { |
970 | MutablePropertyWriter{builder, loc, box}.syncMutablePropertiesFromIRBox(); |
971 | } |
972 | |
973 | mlir::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 | |
983 | mlir::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 | |