1 | //===-- PrivateReductionUtils.cpp -------------------------------*- C++ -*-===// |
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/Lower/Support/PrivateReductionUtils.h" |
14 | |
15 | #include "flang/Lower/AbstractConverter.h" |
16 | #include "flang/Lower/Allocatable.h" |
17 | #include "flang/Lower/ConvertVariable.h" |
18 | #include "flang/Optimizer/Builder/BoxValue.h" |
19 | #include "flang/Optimizer/Builder/Character.h" |
20 | #include "flang/Optimizer/Builder/FIRBuilder.h" |
21 | #include "flang/Optimizer/Builder/HLFIRTools.h" |
22 | #include "flang/Optimizer/Builder/Runtime/Derived.h" |
23 | #include "flang/Optimizer/Builder/Todo.h" |
24 | #include "flang/Optimizer/Dialect/FIROps.h" |
25 | #include "flang/Optimizer/Dialect/FIRType.h" |
26 | #include "flang/Optimizer/HLFIR/HLFIRDialect.h" |
27 | #include "flang/Optimizer/HLFIR/HLFIROps.h" |
28 | #include "flang/Optimizer/Support/FatalError.h" |
29 | #include "flang/Semantics/symbol.h" |
30 | #include "mlir/Dialect/OpenMP/OpenMPDialect.h" |
31 | #include "mlir/IR/Location.h" |
32 | |
33 | static bool hasFinalization(const Fortran::semantics::Symbol &sym) { |
34 | if (sym.has<Fortran::semantics::ObjectEntityDetails>()) |
35 | if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType()) |
36 | if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec = |
37 | declTypeSpec->AsDerived()) |
38 | return Fortran::semantics::IsFinalizable(*derivedTypeSpec); |
39 | return false; |
40 | } |
41 | |
42 | static void createCleanupRegion(Fortran::lower::AbstractConverter &converter, |
43 | mlir::Location loc, mlir::Type argType, |
44 | mlir::Region &cleanupRegion, |
45 | const Fortran::semantics::Symbol *sym, |
46 | bool isDoConcurrent) { |
47 | fir::FirOpBuilder &builder = converter.getFirOpBuilder(); |
48 | assert(cleanupRegion.empty()); |
49 | mlir::Block *block = builder.createBlock(&cleanupRegion, cleanupRegion.end(), |
50 | {argType}, {loc}); |
51 | builder.setInsertionPointToEnd(block); |
52 | |
53 | auto typeError = [loc]() { |
54 | fir::emitFatalError(loc, |
55 | "Attempt to create an omp cleanup region " |
56 | "for a type that wasn't allocated" , |
57 | /*genCrashDiag=*/true); |
58 | }; |
59 | |
60 | mlir::Type valTy = fir::unwrapRefType(argType); |
61 | const bool argIsVolatile = fir::isa_volatile_type(argType); |
62 | if (auto boxTy = mlir::dyn_cast_or_null<fir::BaseBoxType>(valTy)) { |
63 | // TODO: what about undoing init of unboxed derived types? |
64 | if (auto recTy = mlir::dyn_cast<fir::RecordType>( |
65 | fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(boxTy)))) { |
66 | mlir::Type eleTy = boxTy.getEleTy(); |
67 | if (mlir::isa<fir::PointerType, fir::HeapType>(eleTy)) { |
68 | mlir::Type mutableBoxTy = |
69 | fir::ReferenceType::get(fir::BoxType::get(eleTy), argIsVolatile); |
70 | mlir::Value converted = |
71 | builder.createConvert(loc, mutableBoxTy, block->getArgument(0)); |
72 | if (recTy.getNumLenParams() > 0) |
73 | TODO(loc, "Deallocate box with length parameters" ); |
74 | fir::MutableBoxValue mutableBox{converted, /*lenParameters=*/{}, |
75 | /*mutableProperties=*/{}}; |
76 | Fortran::lower::genDeallocateIfAllocated(converter, mutableBox, loc); |
77 | if (isDoConcurrent) |
78 | builder.create<fir::YieldOp>(loc); |
79 | else |
80 | builder.create<mlir::omp::YieldOp>(loc); |
81 | return; |
82 | } |
83 | } |
84 | |
85 | // TODO: just replace this whole body with |
86 | // Fortran::lower::genDeallocateIfAllocated (not done now to avoid test |
87 | // churn) |
88 | |
89 | mlir::Value arg = builder.loadIfRef(loc, block->getArgument(0)); |
90 | assert(mlir::isa<fir::BaseBoxType>(arg.getType())); |
91 | |
92 | // Deallocate box |
93 | // The FIR type system doesn't nesecarrily know that this is a mutable box |
94 | // if we allocated the thread local array on the heap to avoid looped stack |
95 | // allocations. |
96 | mlir::Value addr = |
97 | hlfir::genVariableRawAddress(loc, builder, hlfir::Entity{arg}); |
98 | mlir::Value isAllocated = builder.genIsNotNullAddr(loc, addr); |
99 | fir::IfOp ifOp = |
100 | builder.create<fir::IfOp>(loc, isAllocated, /*withElseRegion=*/false); |
101 | builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); |
102 | |
103 | mlir::Value cast = builder.createConvert( |
104 | loc, fir::HeapType::get(fir::dyn_cast_ptrEleTy(addr.getType())), addr); |
105 | builder.create<fir::FreeMemOp>(loc, cast); |
106 | |
107 | builder.setInsertionPointAfter(ifOp); |
108 | if (isDoConcurrent) |
109 | builder.create<fir::YieldOp>(loc); |
110 | else |
111 | builder.create<mlir::omp::YieldOp>(loc); |
112 | return; |
113 | } |
114 | |
115 | if (auto boxCharTy = mlir::dyn_cast<fir::BoxCharType>(argType)) { |
116 | auto [addr, len] = |
117 | fir::factory::CharacterExprHelper{builder, loc}.createUnboxChar( |
118 | block->getArgument(0)); |
119 | |
120 | // convert addr to a heap type so it can be used with fir::FreeMemOp |
121 | auto refTy = mlir::cast<fir::ReferenceType>(addr.getType()); |
122 | auto heapTy = fir::HeapType::get(refTy.getEleTy()); |
123 | addr = builder.createConvert(loc, heapTy, addr); |
124 | |
125 | builder.create<fir::FreeMemOp>(loc, addr); |
126 | if (isDoConcurrent) |
127 | builder.create<fir::YieldOp>(loc); |
128 | else |
129 | builder.create<mlir::omp::YieldOp>(loc); |
130 | |
131 | return; |
132 | } |
133 | |
134 | typeError(); |
135 | } |
136 | |
137 | fir::ShapeShiftOp Fortran::lower::getShapeShift( |
138 | fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value box, |
139 | bool cannotHaveNonDefaultLowerBounds, bool useDefaultLowerBounds) { |
140 | fir::SequenceType sequenceType = mlir::cast<fir::SequenceType>( |
141 | hlfir::getFortranElementOrSequenceType(box.getType())); |
142 | const unsigned rank = sequenceType.getDimension(); |
143 | |
144 | llvm::SmallVector<mlir::Value> lbAndExtents; |
145 | lbAndExtents.reserve(rank * 2); |
146 | mlir::Type idxTy = builder.getIndexType(); |
147 | |
148 | mlir::Value oneVal; |
149 | auto one = [&] { |
150 | if (!oneVal) |
151 | oneVal = builder.createIntegerConstant(loc, idxTy, 1); |
152 | return oneVal; |
153 | }; |
154 | |
155 | if ((cannotHaveNonDefaultLowerBounds || useDefaultLowerBounds) && |
156 | !sequenceType.hasDynamicExtents()) { |
157 | // We don't need fir::BoxDimsOp if all of the extents are statically known |
158 | // and we can assume default lower bounds. This helps avoids reads from the |
159 | // mold arg. |
160 | // We may also want to use default lower bounds to iterate through array |
161 | // elements without having to adjust each index. |
162 | for (int64_t extent : sequenceType.getShape()) { |
163 | assert(extent != sequenceType.getUnknownExtent()); |
164 | lbAndExtents.push_back(one()); |
165 | mlir::Value extentVal = builder.createIntegerConstant(loc, idxTy, extent); |
166 | lbAndExtents.push_back(extentVal); |
167 | } |
168 | } else { |
169 | for (unsigned i = 0; i < rank; ++i) { |
170 | // TODO: ideally we want to hoist box reads out of the critical section. |
171 | // We could do this by having box dimensions in block arguments like |
172 | // OpenACC does |
173 | mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i); |
174 | auto dimInfo = |
175 | builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim); |
176 | lbAndExtents.push_back(useDefaultLowerBounds ? one() |
177 | : dimInfo.getLowerBound()); |
178 | lbAndExtents.push_back(dimInfo.getExtent()); |
179 | } |
180 | } |
181 | |
182 | auto shapeShiftTy = fir::ShapeShiftType::get(builder.getContext(), rank); |
183 | auto shapeShift = |
184 | builder.create<fir::ShapeShiftOp>(loc, shapeShiftTy, lbAndExtents); |
185 | return shapeShift; |
186 | } |
187 | |
188 | // Initialize box newBox using moldBox. These should both have the same type and |
189 | // be boxes containing derived types e.g. |
190 | // fir.box<!fir.type<>> |
191 | // fir.box<!fir.heap<!fir.type<>> |
192 | // fir.box<!fir.heap<!fir.array<fir.type<>>> |
193 | // fir.class<...<!fir.type<>>> |
194 | // If the type doesn't match , this does nothing |
195 | static void initializeIfDerivedTypeBox(fir::FirOpBuilder &builder, |
196 | mlir::Location loc, mlir::Value newBox, |
197 | mlir::Value moldBox, bool hasInitializer, |
198 | bool isFirstPrivate) { |
199 | assert(moldBox.getType() == newBox.getType()); |
200 | fir::BoxType boxTy = mlir::dyn_cast<fir::BoxType>(newBox.getType()); |
201 | fir::ClassType classTy = mlir::dyn_cast<fir::ClassType>(newBox.getType()); |
202 | if (!boxTy && !classTy) |
203 | return; |
204 | |
205 | // remove pointer and array types in the middle |
206 | mlir::Type eleTy = boxTy ? boxTy.getElementType() : classTy.getEleTy(); |
207 | mlir::Type derivedTy = fir::unwrapRefType(eleTy); |
208 | if (auto array = mlir::dyn_cast<fir::SequenceType>(derivedTy)) |
209 | derivedTy = array.getElementType(); |
210 | |
211 | if (!fir::isa_derived(derivedTy)) |
212 | return; |
213 | |
214 | if (hasInitializer) |
215 | fir::runtime::genDerivedTypeInitialize(builder, loc, newBox); |
216 | |
217 | if (hlfir::mayHaveAllocatableComponent(derivedTy) && !isFirstPrivate) |
218 | fir::runtime::genDerivedTypeInitializeClone(builder, loc, newBox, moldBox); |
219 | } |
220 | |
221 | static void getLengthParameters(fir::FirOpBuilder &builder, mlir::Location loc, |
222 | mlir::Value moldArg, |
223 | llvm::SmallVectorImpl<mlir::Value> &lenParams) { |
224 | // We pass derived types unboxed and so are not self-contained entities. |
225 | // Assume that unboxed derived types won't need length paramters. |
226 | if (!hlfir::isFortranEntity(moldArg)) |
227 | return; |
228 | |
229 | hlfir::genLengthParameters(loc, builder, hlfir::Entity{moldArg}, lenParams); |
230 | if (lenParams.empty()) |
231 | return; |
232 | |
233 | // The verifier for EmboxOp doesn't allow length parameters when the the |
234 | // character already has static LEN. genLengthParameters may still return them |
235 | // in this case. |
236 | auto strTy = mlir::dyn_cast<fir::CharacterType>( |
237 | fir::getFortranElementType(moldArg.getType())); |
238 | |
239 | if (strTy && strTy.hasConstantLen()) |
240 | lenParams.resize(0); |
241 | } |
242 | |
243 | static bool |
244 | isDerivedTypeNeedingInitialization(const Fortran::semantics::Symbol &sym) { |
245 | // Fortran::lower::hasDefaultInitialization returns false for ALLOCATABLE, so |
246 | // re-implement here. |
247 | // ignorePointer=true because either the pointer points to the same target as |
248 | // the original variable, or it is uninitialized. |
249 | if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType()) |
250 | if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec = |
251 | declTypeSpec->AsDerived()) |
252 | return derivedTypeSpec->HasDefaultInitialization( |
253 | /*ignoreAllocatable=*/false, /*ignorePointer=*/true); |
254 | return false; |
255 | } |
256 | |
257 | static mlir::Value generateZeroShapeForRank(fir::FirOpBuilder &builder, |
258 | mlir::Location loc, |
259 | mlir::Value moldArg) { |
260 | mlir::Type moldType = fir::unwrapRefType(moldArg.getType()); |
261 | mlir::Type eleType = fir::dyn_cast_ptrOrBoxEleTy(moldType); |
262 | fir::SequenceType seqTy = |
263 | mlir::dyn_cast_if_present<fir::SequenceType>(eleType); |
264 | if (!seqTy) |
265 | return mlir::Value{}; |
266 | |
267 | unsigned rank = seqTy.getShape().size(); |
268 | mlir::Value zero = |
269 | builder.createIntegerConstant(loc, builder.getIndexType(), 0); |
270 | mlir::SmallVector<mlir::Value> dims; |
271 | dims.resize(rank, zero); |
272 | mlir::Type shapeTy = fir::ShapeType::get(builder.getContext(), rank); |
273 | return builder.create<fir::ShapeOp>(loc, shapeTy, dims); |
274 | } |
275 | |
276 | namespace { |
277 | using namespace Fortran::lower; |
278 | /// Class to store shared data so we don't have to maintain so many function |
279 | /// arguments |
280 | class PopulateInitAndCleanupRegionsHelper { |
281 | public: |
282 | PopulateInitAndCleanupRegionsHelper( |
283 | Fortran::lower::AbstractConverter &converter, mlir::Location loc, |
284 | mlir::Type argType, mlir::Value scalarInitValue, |
285 | mlir::Value allocatedPrivVarArg, mlir::Value moldArg, |
286 | mlir::Block *initBlock, mlir::Region &cleanupRegion, |
287 | DeclOperationKind kind, const Fortran::semantics::Symbol *sym, |
288 | bool cannotHaveLowerBounds, bool isDoConcurrent) |
289 | : converter{converter}, builder{converter.getFirOpBuilder()}, loc{loc}, |
290 | argType{argType}, scalarInitValue{scalarInitValue}, |
291 | allocatedPrivVarArg{allocatedPrivVarArg}, moldArg{moldArg}, |
292 | initBlock{initBlock}, cleanupRegion{cleanupRegion}, kind{kind}, |
293 | sym{sym}, cannotHaveNonDefaultLowerBounds{cannotHaveLowerBounds}, |
294 | isDoConcurrent{isDoConcurrent} { |
295 | valType = fir::unwrapRefType(argType); |
296 | } |
297 | |
298 | void populateByRefInitAndCleanupRegions(); |
299 | |
300 | private: |
301 | Fortran::lower::AbstractConverter &converter; |
302 | fir::FirOpBuilder &builder; |
303 | |
304 | mlir::Location loc; |
305 | |
306 | /// The type of the block arguments passed into the init and cleanup regions |
307 | mlir::Type argType; |
308 | |
309 | /// argType stripped of any references |
310 | mlir::Type valType; |
311 | |
312 | /// sclarInitValue: The value scalars should be initialized to (only |
313 | /// valid for reductions). |
314 | /// allocatedPrivVarArg: The allocation for the private |
315 | /// variable. |
316 | /// moldArg: The original variable. |
317 | /// loadedMoldArg: The original variable, loaded. Access via |
318 | /// getLoadedMoldArg(). |
319 | mlir::Value scalarInitValue, allocatedPrivVarArg, moldArg, loadedMoldArg; |
320 | |
321 | /// The first block in the init region. |
322 | mlir::Block *initBlock; |
323 | |
324 | /// The region to insert clanup code into. |
325 | mlir::Region &cleanupRegion; |
326 | |
327 | /// The kind of operation we are generating init/cleanup regions for. |
328 | DeclOperationKind kind; |
329 | |
330 | /// (optional) The symbol being privatized. |
331 | const Fortran::semantics::Symbol *sym; |
332 | |
333 | /// Any length parameters which have been fetched for the type |
334 | mlir::SmallVector<mlir::Value> lenParams; |
335 | |
336 | /// If the source variable being privatized definitely can't have non-default |
337 | /// lower bounds then we don't need to generate code to read them. |
338 | bool cannotHaveNonDefaultLowerBounds; |
339 | |
340 | bool isDoConcurrent; |
341 | |
342 | void createYield(mlir::Value ret) { |
343 | if (isDoConcurrent) |
344 | builder.create<fir::YieldOp>(loc, ret); |
345 | else |
346 | builder.create<mlir::omp::YieldOp>(loc, ret); |
347 | } |
348 | |
349 | void initTrivialType() { |
350 | builder.setInsertionPointToEnd(initBlock); |
351 | if (scalarInitValue) |
352 | builder.createStoreWithConvert(loc, scalarInitValue, allocatedPrivVarArg); |
353 | createYield(allocatedPrivVarArg); |
354 | } |
355 | |
356 | void initBoxedPrivatePointer(fir::BaseBoxType boxTy); |
357 | |
358 | /// e.g. !fir.box<!fir.heap<i32>>, !fir.box<!fir.type<....>>, |
359 | /// !fir.box<!fir.char<...>> |
360 | void initAndCleanupBoxedScalar(fir::BaseBoxType boxTy, |
361 | bool needsInitialization); |
362 | |
363 | void initAndCleanupBoxedArray(fir::BaseBoxType boxTy, |
364 | bool needsInitialization); |
365 | |
366 | void initAndCleanupBoxchar(fir::BoxCharType boxCharTy); |
367 | |
368 | void initAndCleanupUnboxedDerivedType(bool needsInitialization); |
369 | |
370 | fir::IfOp handleNullAllocatable(); |
371 | |
372 | // Do this lazily so that we don't load it when it is not used. |
373 | inline mlir::Value getLoadedMoldArg() { |
374 | if (loadedMoldArg) |
375 | return loadedMoldArg; |
376 | loadedMoldArg = builder.loadIfRef(loc, moldArg); |
377 | return loadedMoldArg; |
378 | } |
379 | }; |
380 | |
381 | } // namespace |
382 | |
383 | /// The initial state of a private pointer is undefined so we don't need to |
384 | /// match the mold argument (OpenMP 5.2 end of page 106). |
385 | void PopulateInitAndCleanupRegionsHelper::initBoxedPrivatePointer( |
386 | fir::BaseBoxType boxTy) { |
387 | assert(isPrivatization(kind)); |
388 | // we need a shape with the right rank so that the embox op is lowered |
389 | // to an llvm struct of the right type. This returns nullptr if the types |
390 | // aren't right. |
391 | mlir::Value shape = generateZeroShapeForRank(builder, loc, moldArg); |
392 | // Just incase, do initialize the box with a null value |
393 | mlir::Value null = builder.createNullConstant(loc, boxTy.getEleTy()); |
394 | mlir::Value nullBox; |
395 | nullBox = builder.create<fir::EmboxOp>(loc, boxTy, null, shape, |
396 | /*slice=*/mlir::Value{}, lenParams); |
397 | builder.create<fir::StoreOp>(loc, nullBox, allocatedPrivVarArg); |
398 | createYield(allocatedPrivVarArg); |
399 | } |
400 | /// Check if an allocatable box is unallocated. If so, initialize the boxAlloca |
401 | /// to be unallocated e.g. |
402 | /// %box_alloca = fir.alloca !fir.box<!fir.heap<...>> |
403 | /// %addr = fir.box_addr %box |
404 | /// if (%addr == 0) { |
405 | /// %nullbox = fir.embox %addr |
406 | /// fir.store %nullbox to %box_alloca |
407 | /// } else { |
408 | /// // ... |
409 | /// fir.store %something to %box_alloca |
410 | /// } |
411 | /// omp.yield %box_alloca |
412 | fir::IfOp PopulateInitAndCleanupRegionsHelper::handleNullAllocatable() { |
413 | mlir::Value addr = builder.create<fir::BoxAddrOp>(loc, getLoadedMoldArg()); |
414 | mlir::Value isNotAllocated = builder.genIsNullAddr(loc, addr); |
415 | fir::IfOp ifOp = builder.create<fir::IfOp>(loc, isNotAllocated, |
416 | /*withElseRegion=*/true); |
417 | builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); |
418 | // Just embox the null address and return. |
419 | // We have to give the embox a shape so that the LLVM box structure has the |
420 | // right rank. This returns an empty value if the types don't match. |
421 | mlir::Value shape = generateZeroShapeForRank(builder, loc, moldArg); |
422 | |
423 | mlir::Value nullBox = |
424 | builder.create<fir::EmboxOp>(loc, valType, addr, shape, |
425 | /*slice=*/mlir::Value{}, lenParams); |
426 | builder.create<fir::StoreOp>(loc, nullBox, allocatedPrivVarArg); |
427 | return ifOp; |
428 | } |
429 | |
430 | void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxedScalar( |
431 | fir::BaseBoxType boxTy, bool needsInitialization) { |
432 | bool isAllocatableOrPointer = |
433 | mlir::isa<fir::HeapType, fir::PointerType>(boxTy.getEleTy()); |
434 | mlir::Type innerTy = fir::unwrapRefType(boxTy.getEleTy()); |
435 | fir::IfOp ifUnallocated{nullptr}; |
436 | if (isAllocatableOrPointer) { |
437 | ifUnallocated = handleNullAllocatable(); |
438 | builder.setInsertionPointToStart(&ifUnallocated.getElseRegion().front()); |
439 | } |
440 | |
441 | mlir::Value valAlloc = builder.createHeapTemporary(loc, innerTy, /*name=*/{}, |
442 | /*shape=*/{}, lenParams); |
443 | if (scalarInitValue) |
444 | builder.createStoreWithConvert(loc, scalarInitValue, valAlloc); |
445 | mlir::Value box = builder.create<fir::EmboxOp>( |
446 | loc, valType, valAlloc, /*shape=*/mlir::Value{}, |
447 | /*slice=*/mlir::Value{}, lenParams); |
448 | initializeIfDerivedTypeBox( |
449 | builder, loc, box, getLoadedMoldArg(), needsInitialization, |
450 | /*isFirstPrivate=*/kind == DeclOperationKind::FirstPrivateOrLocalInit); |
451 | fir::StoreOp lastOp = |
452 | builder.create<fir::StoreOp>(loc, box, allocatedPrivVarArg); |
453 | |
454 | createCleanupRegion(converter, loc, argType, cleanupRegion, sym, |
455 | isDoConcurrent); |
456 | |
457 | if (ifUnallocated) |
458 | builder.setInsertionPointAfter(ifUnallocated); |
459 | else |
460 | builder.setInsertionPointAfter(lastOp); |
461 | |
462 | createYield(allocatedPrivVarArg); |
463 | } |
464 | |
465 | void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxedArray( |
466 | fir::BaseBoxType boxTy, bool needsInitialization) { |
467 | bool isAllocatableOrPointer = |
468 | mlir::isa<fir::HeapType, fir::PointerType>(boxTy.getEleTy()); |
469 | getLengthParameters(builder, loc, getLoadedMoldArg(), lenParams); |
470 | |
471 | fir::IfOp ifUnallocated{nullptr}; |
472 | if (isAllocatableOrPointer) { |
473 | ifUnallocated = handleNullAllocatable(); |
474 | builder.setInsertionPointToStart(&ifUnallocated.getElseRegion().front()); |
475 | } |
476 | |
477 | // Create the private copy from the initial fir.box: |
478 | hlfir::Entity source = hlfir::Entity{getLoadedMoldArg()}; |
479 | |
480 | // Special case for (possibly allocatable) arrays of polymorphic types |
481 | // e.g. !fir.class<!fir.heap<!fir.array<?x!fir.type<>>>> |
482 | if (source.isPolymorphic()) { |
483 | fir::ShapeShiftOp shape = |
484 | getShapeShift(builder, loc, source, cannotHaveNonDefaultLowerBounds); |
485 | mlir::Type arrayType = source.getElementOrSequenceType(); |
486 | mlir::Value allocatedArray = builder.create<fir::AllocMemOp>( |
487 | loc, arrayType, /*typeparams=*/mlir::ValueRange{}, shape.getExtents()); |
488 | mlir::Value firClass = builder.create<fir::EmboxOp>(loc, source.getType(), |
489 | allocatedArray, shape); |
490 | initializeIfDerivedTypeBox( |
491 | builder, loc, firClass, source, needsInitialization, |
492 | /*isFirstprivate=*/kind == DeclOperationKind::FirstPrivateOrLocalInit); |
493 | builder.create<fir::StoreOp>(loc, firClass, allocatedPrivVarArg); |
494 | if (ifUnallocated) |
495 | builder.setInsertionPointAfter(ifUnallocated); |
496 | createYield(allocatedPrivVarArg); |
497 | mlir::OpBuilder::InsertionGuard guard(builder); |
498 | createCleanupRegion(converter, loc, argType, cleanupRegion, sym, |
499 | isDoConcurrent); |
500 | return; |
501 | } |
502 | |
503 | // Allocating on the heap in case the whole reduction/privatization is nested |
504 | // inside of a loop |
505 | auto [temp, needsDealloc] = createTempFromMold(loc, builder, source); |
506 | // if needsDealloc isn't statically false, add cleanup region. Always |
507 | // do this for allocatable boxes because they might have been re-allocated |
508 | // in the body of the loop/parallel region |
509 | |
510 | std::optional<int64_t> cstNeedsDealloc = fir::getIntIfConstant(needsDealloc); |
511 | assert(cstNeedsDealloc.has_value() && |
512 | "createTempFromMold decides this statically" ); |
513 | if (cstNeedsDealloc.has_value() && *cstNeedsDealloc != false) { |
514 | mlir::OpBuilder::InsertionGuard guard(builder); |
515 | createCleanupRegion(converter, loc, argType, cleanupRegion, sym, |
516 | isDoConcurrent); |
517 | } else { |
518 | assert(!isAllocatableOrPointer && |
519 | "Pointer-like arrays must be heap allocated" ); |
520 | } |
521 | |
522 | // Put the temporary inside of a box: |
523 | // hlfir::genVariableBox doesn't handle non-default lower bounds |
524 | mlir::Value box; |
525 | fir::ShapeShiftOp shapeShift = getShapeShift(builder, loc, getLoadedMoldArg(), |
526 | cannotHaveNonDefaultLowerBounds); |
527 | mlir::Type boxType = getLoadedMoldArg().getType(); |
528 | if (mlir::isa<fir::BaseBoxType>(temp.getType())) |
529 | // the box created by the declare form createTempFromMold is missing |
530 | // lower bounds info |
531 | box = builder.create<fir::ReboxOp>(loc, boxType, temp, shapeShift, |
532 | /*shift=*/mlir::Value{}); |
533 | else |
534 | box = builder.create<fir::EmboxOp>( |
535 | loc, boxType, temp, shapeShift, |
536 | /*slice=*/mlir::Value{}, |
537 | /*typeParams=*/llvm::ArrayRef<mlir::Value>{}); |
538 | |
539 | if (scalarInitValue) |
540 | builder.create<hlfir::AssignOp>(loc, scalarInitValue, box); |
541 | |
542 | initializeIfDerivedTypeBox( |
543 | builder, loc, box, getLoadedMoldArg(), needsInitialization, |
544 | /*isFirstPrivate=*/kind == DeclOperationKind::FirstPrivateOrLocalInit); |
545 | |
546 | builder.create<fir::StoreOp>(loc, box, allocatedPrivVarArg); |
547 | if (ifUnallocated) |
548 | builder.setInsertionPointAfter(ifUnallocated); |
549 | createYield(allocatedPrivVarArg); |
550 | } |
551 | |
552 | void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxchar( |
553 | fir::BoxCharType boxCharTy) { |
554 | mlir::Type eleTy = boxCharTy.getEleTy(); |
555 | builder.setInsertionPointToStart(initBlock); |
556 | fir::factory::CharacterExprHelper charExprHelper{builder, loc}; |
557 | auto [addr, len] = charExprHelper.createUnboxChar(moldArg); |
558 | |
559 | // Using heap temporary so that |
560 | // 1) It is safe to use privatization inside of big loops. |
561 | // 2) The lifetime can outlive the current stack frame for delayed task |
562 | // execution. |
563 | // We can't always allocate a boxchar implicitly as the type of the |
564 | // omp.private because the allocation potentially needs the length |
565 | // parameters fetched above. |
566 | // TODO: this deviates from the intended design for delayed task |
567 | // execution. |
568 | mlir::Value privateAddr = builder.createHeapTemporary( |
569 | loc, eleTy, /*name=*/{}, /*shape=*/{}, /*lenParams=*/len); |
570 | mlir::Value boxChar = charExprHelper.createEmboxChar(privateAddr, len); |
571 | |
572 | createCleanupRegion(converter, loc, argType, cleanupRegion, sym, |
573 | isDoConcurrent); |
574 | |
575 | builder.setInsertionPointToEnd(initBlock); |
576 | createYield(boxChar); |
577 | } |
578 | |
579 | void PopulateInitAndCleanupRegionsHelper::initAndCleanupUnboxedDerivedType( |
580 | bool needsInitialization) { |
581 | builder.setInsertionPointToStart(initBlock); |
582 | mlir::Type boxedTy = fir::BoxType::get(valType); |
583 | mlir::Value newBox = |
584 | builder.create<fir::EmboxOp>(loc, boxedTy, allocatedPrivVarArg); |
585 | mlir::Value moldBox = builder.create<fir::EmboxOp>(loc, boxedTy, moldArg); |
586 | initializeIfDerivedTypeBox(builder, loc, newBox, moldBox, needsInitialization, |
587 | /*isFirstPrivate=*/kind == |
588 | DeclOperationKind::FirstPrivateOrLocalInit); |
589 | |
590 | if (sym && hasFinalization(*sym)) |
591 | createCleanupRegion(converter, loc, argType, cleanupRegion, sym, |
592 | isDoConcurrent); |
593 | |
594 | builder.setInsertionPointToEnd(initBlock); |
595 | createYield(allocatedPrivVarArg); |
596 | } |
597 | |
598 | /// This is the main driver deciding how to initialize the private variable. |
599 | void PopulateInitAndCleanupRegionsHelper::populateByRefInitAndCleanupRegions() { |
600 | if (isPrivatization(kind)) { |
601 | assert(sym && "Symbol information is required to privatize derived types" ); |
602 | assert(!scalarInitValue && "ScalarInitvalue is unused for privatization" ); |
603 | } |
604 | mlir::Type valTy = fir::unwrapRefType(argType); |
605 | |
606 | if (fir::isa_trivial(valTy)) { |
607 | initTrivialType(); |
608 | return; |
609 | } |
610 | |
611 | bool needsInitialization = |
612 | sym ? isDerivedTypeNeedingInitialization(sym->GetUltimate()) : false; |
613 | |
614 | if (auto boxTy = mlir::dyn_cast_or_null<fir::BaseBoxType>(valTy)) { |
615 | builder.setInsertionPointToEnd(initBlock); |
616 | |
617 | // TODO: don't do this unless it is needed |
618 | getLengthParameters(builder, loc, getLoadedMoldArg(), lenParams); |
619 | |
620 | if (isPrivatization(kind) && |
621 | mlir::isa<fir::PointerType>(boxTy.getEleTy())) { |
622 | initBoxedPrivatePointer(boxTy); |
623 | return; |
624 | } |
625 | |
626 | mlir::Type innerTy = fir::unwrapRefType(boxTy.getEleTy()); |
627 | bool isDerived = fir::isa_derived(innerTy); |
628 | bool isChar = fir::isa_char(innerTy); |
629 | if (fir::isa_trivial(innerTy) || isDerived || isChar) { |
630 | // boxed non-sequence value e.g. !fir.box<!fir.heap<i32>> |
631 | if ((isDerived || isChar) && (isReduction(kind) || scalarInitValue)) |
632 | TODO(loc, "Reduction of an unsupported boxed type" ); |
633 | initAndCleanupBoxedScalar(boxTy, needsInitialization); |
634 | return; |
635 | } |
636 | |
637 | innerTy = fir::extractSequenceType(boxTy); |
638 | if (!innerTy || !mlir::isa<fir::SequenceType>(innerTy)) |
639 | TODO(loc, "Unsupported boxed type for reduction/privatization" ); |
640 | initAndCleanupBoxedArray(boxTy, needsInitialization); |
641 | return; |
642 | } |
643 | |
644 | // Unboxed types: |
645 | if (auto boxCharTy = mlir::dyn_cast<fir::BoxCharType>(argType)) { |
646 | initAndCleanupBoxchar(boxCharTy); |
647 | return; |
648 | } |
649 | if (fir::isa_derived(valType)) { |
650 | initAndCleanupUnboxedDerivedType(needsInitialization); |
651 | return; |
652 | } |
653 | |
654 | TODO(loc, |
655 | "creating reduction/privatization init region for unsupported type" ); |
656 | } |
657 | |
658 | void Fortran::lower::populateByRefInitAndCleanupRegions( |
659 | Fortran::lower::AbstractConverter &converter, mlir::Location loc, |
660 | mlir::Type argType, mlir::Value scalarInitValue, mlir::Block *initBlock, |
661 | mlir::Value allocatedPrivVarArg, mlir::Value moldArg, |
662 | mlir::Region &cleanupRegion, DeclOperationKind kind, |
663 | const Fortran::semantics::Symbol *sym, bool cannotHaveLowerBounds, |
664 | bool isDoConcurrent) { |
665 | PopulateInitAndCleanupRegionsHelper helper( |
666 | converter, loc, argType, scalarInitValue, allocatedPrivVarArg, moldArg, |
667 | initBlock, cleanupRegion, kind, sym, cannotHaveLowerBounds, |
668 | isDoConcurrent); |
669 | helper.populateByRefInitAndCleanupRegions(); |
670 | |
671 | // Often we load moldArg to check something (e.g. length parameters, shape) |
672 | // but then those answers can be gotten statically without accessing the |
673 | // runtime value and so the only remaining use is a dead load. These loads can |
674 | // force us to insert additional barriers and so should be avoided where |
675 | // possible. |
676 | if (moldArg.hasOneUse()) { |
677 | mlir::Operation *user = *moldArg.getUsers().begin(); |
678 | if (auto load = mlir::dyn_cast<fir::LoadOp>(user)) |
679 | if (load.use_empty()) |
680 | load.erase(); |
681 | } |
682 | } |
683 | |