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
33static 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
42static 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
137fir::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
195static 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
221static 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
243static bool
244isDerivedTypeNeedingInitialization(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
257static 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
276namespace {
277using namespace Fortran::lower;
278/// Class to store shared data so we don't have to maintain so many function
279/// arguments
280class PopulateInitAndCleanupRegionsHelper {
281public:
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
300private:
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).
385void 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
412fir::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
430void 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
465void 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
552void 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
579void 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.
599void 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
658void 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

source code of flang/lib/Lower/Support/PrivateReductionUtils.cpp