704 lines · cpp
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-exception6//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 fir::YieldOp::create(builder, loc);79 else80 mlir::omp::YieldOp::create(builder, loc);81 return;82 }83 }84 85 // TODO: just replace this whole body with86 // Fortran::lower::genDeallocateIfAllocated (not done now to avoid test87 // churn)88 89 mlir::Value arg = builder.loadIfRef(loc, block->getArgument(0));90 assert(mlir::isa<fir::BaseBoxType>(arg.getType()));91 92 // Deallocate box93 // The FIR type system doesn't nesecarrily know that this is a mutable box94 // if we allocated the thread local array on the heap to avoid looped stack95 // 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 fir::IfOp::create(builder, 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 fir::FreeMemOp::create(builder, loc, cast);106 107 builder.setInsertionPointAfter(ifOp);108 if (isDoConcurrent)109 fir::YieldOp::create(builder, loc);110 else111 mlir::omp::YieldOp::create(builder, 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::FreeMemOp121 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 fir::FreeMemOp::create(builder, loc, addr);126 if (isDoConcurrent)127 fir::YieldOp::create(builder, loc);128 else129 mlir::omp::YieldOp::create(builder, 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 known158 // and we can assume default lower bounds. This helps avoids reads from the159 // mold arg.160 // We may also want to use default lower bounds to iterate through array161 // 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 like172 // OpenACC does173 mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);174 auto dimInfo =175 fir::BoxDimsOp::create(builder, 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 fir::ShapeShiftOp::create(builder, loc, shapeShiftTy, lbAndExtents);185 return shapeShift;186}187 188// Initialize box newBox using moldBox. These should both have the same type and189// 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 nothing195static 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 middle206 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 the234 // character already has static LEN. genLengthParameters may still return them235 // 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 bool244isDerivedTypeNeedingInitialization(const Fortran::semantics::Symbol &sym) {245 // Fortran::lower::hasDefaultInitialization returns false for ALLOCATABLE, so246 // re-implement here.247 // ignorePointer=true because either the pointer points to the same target as248 // 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 fir::ShapeOp::create(builder, 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 function279/// arguments280class 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 regions307 mlir::Type argType;308 309 /// argType stripped of any references310 mlir::Type valType;311 312 /// sclarInitValue: The value scalars should be initialized to (only313 /// valid for reductions).314 /// allocatedPrivVarArg: The allocation for the private315 /// variable.316 /// moldArg: The original variable.317 /// loadedMoldArg: The original variable, loaded. Access via318 /// 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 type334 mlir::SmallVector<mlir::Value> lenParams;335 336 /// If the source variable being privatized definitely can't have non-default337 /// 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 fir::YieldOp::create(builder, loc, ret);345 else346 mlir::omp::YieldOp::create(builder, 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 bool shouldAllocateTempOnStack() const;381};382 383} // namespace384 385/// The initial state of a private pointer is undefined so we don't need to386/// match the mold argument (OpenMP 5.2 end of page 106).387void PopulateInitAndCleanupRegionsHelper::initBoxedPrivatePointer(388 fir::BaseBoxType boxTy) {389 assert(isPrivatization(kind));390 // we need a shape with the right rank so that the embox op is lowered391 // to an llvm struct of the right type. This returns nullptr if the types392 // aren't right.393 mlir::Value shape = generateZeroShapeForRank(builder, loc, moldArg);394 // Just incase, do initialize the box with a null value395 mlir::Value null = builder.createNullConstant(loc, boxTy.getEleTy());396 mlir::Value nullBox;397 nullBox = fir::EmboxOp::create(builder, loc, boxTy, null, shape,398 /*slice=*/mlir::Value{}, lenParams);399 fir::StoreOp::create(builder, loc, nullBox, allocatedPrivVarArg);400 createYield(allocatedPrivVarArg);401}402/// Check if an allocatable box is unallocated. If so, initialize the boxAlloca403/// to be unallocated e.g.404/// %box_alloca = fir.alloca !fir.box<!fir.heap<...>>405/// %addr = fir.box_addr %box406/// if (%addr == 0) {407/// %nullbox = fir.embox %addr408/// fir.store %nullbox to %box_alloca409/// } else {410/// // ...411/// fir.store %something to %box_alloca412/// }413/// omp.yield %box_alloca414fir::IfOp PopulateInitAndCleanupRegionsHelper::handleNullAllocatable() {415 mlir::Value addr = fir::BoxAddrOp::create(builder, loc, getLoadedMoldArg());416 mlir::Value isNotAllocated = builder.genIsNullAddr(loc, addr);417 fir::IfOp ifOp = fir::IfOp::create(builder, loc, isNotAllocated,418 /*withElseRegion=*/true);419 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());420 // Just embox the null address and return.421 // We have to give the embox a shape so that the LLVM box structure has the422 // right rank. This returns an empty value if the types don't match.423 mlir::Value shape = generateZeroShapeForRank(builder, loc, moldArg);424 425 mlir::Value nullBox =426 fir::EmboxOp::create(builder, loc, valType, addr, shape,427 /*slice=*/mlir::Value{}, lenParams);428 fir::StoreOp::create(builder, loc, nullBox, allocatedPrivVarArg);429 return ifOp;430}431 432void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxedScalar(433 fir::BaseBoxType boxTy, bool needsInitialization) {434 bool isAllocatableOrPointer =435 mlir::isa<fir::HeapType, fir::PointerType>(boxTy.getEleTy());436 mlir::Type innerTy = fir::unwrapRefType(boxTy.getEleTy());437 fir::IfOp ifUnallocated{nullptr};438 if (isAllocatableOrPointer) {439 ifUnallocated = handleNullAllocatable();440 builder.setInsertionPointToStart(&ifUnallocated.getElseRegion().front());441 }442 443 bool shouldAllocateOnStack = shouldAllocateTempOnStack();444 mlir::Value valAlloc =445 (shouldAllocateOnStack)446 ? builder.createTemporary(loc, innerTy, /*name=*/{},447 /*shape=*/{}, lenParams)448 : builder.createHeapTemporary(loc, innerTy, /*name=*/{},449 /*shape=*/{}, lenParams);450 451 if (scalarInitValue)452 builder.createStoreWithConvert(loc, scalarInitValue, valAlloc);453 mlir::Value box = fir::EmboxOp::create(builder, loc, valType, valAlloc,454 /*shape=*/mlir::Value{},455 /*slice=*/mlir::Value{}, lenParams);456 initializeIfDerivedTypeBox(457 builder, loc, box, getLoadedMoldArg(), needsInitialization,458 /*isFirstPrivate=*/kind == DeclOperationKind::FirstPrivateOrLocalInit);459 fir::StoreOp lastOp =460 fir::StoreOp::create(builder, loc, box, allocatedPrivVarArg);461 462 if (!shouldAllocateOnStack)463 createCleanupRegion(converter, loc, argType, cleanupRegion, sym,464 isDoConcurrent);465 466 if (ifUnallocated)467 builder.setInsertionPointAfter(ifUnallocated);468 else469 builder.setInsertionPointAfter(lastOp);470 471 createYield(allocatedPrivVarArg);472}473 474bool PopulateInitAndCleanupRegionsHelper::shouldAllocateTempOnStack() const {475 // On the GPU, always allocate on the stack since heap allocatins are very476 // expensive.477 auto offloadMod =478 llvm::dyn_cast<mlir::omp::OffloadModuleInterface>(*builder.getModule());479 return offloadMod && offloadMod.getIsGPU();480}481 482void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxedArray(483 fir::BaseBoxType boxTy, bool needsInitialization) {484 bool isAllocatableOrPointer =485 mlir::isa<fir::HeapType, fir::PointerType>(boxTy.getEleTy());486 getLengthParameters(builder, loc, getLoadedMoldArg(), lenParams);487 488 fir::IfOp ifUnallocated{nullptr};489 if (isAllocatableOrPointer) {490 ifUnallocated = handleNullAllocatable();491 builder.setInsertionPointToStart(&ifUnallocated.getElseRegion().front());492 }493 494 // Create the private copy from the initial fir.box:495 hlfir::Entity source = hlfir::Entity{getLoadedMoldArg()};496 497 // Special case for (possibly allocatable) arrays of polymorphic types498 // e.g. !fir.class<!fir.heap<!fir.array<?x!fir.type<>>>>499 if (source.isPolymorphic()) {500 fir::ShapeShiftOp shape =501 getShapeShift(builder, loc, source, cannotHaveNonDefaultLowerBounds);502 mlir::Type arrayType = source.getElementOrSequenceType();503 mlir::Value allocatedArray = fir::AllocMemOp::create(504 builder, loc, arrayType, /*typeparams=*/mlir::ValueRange{},505 shape.getExtents());506 mlir::Value firClass = fir::EmboxOp::create(builder, loc, source.getType(),507 allocatedArray, shape);508 initializeIfDerivedTypeBox(509 builder, loc, firClass, source, needsInitialization,510 /*isFirstprivate=*/kind == DeclOperationKind::FirstPrivateOrLocalInit);511 fir::StoreOp::create(builder, loc, firClass, allocatedPrivVarArg);512 if (ifUnallocated)513 builder.setInsertionPointAfter(ifUnallocated);514 createYield(allocatedPrivVarArg);515 mlir::OpBuilder::InsertionGuard guard(builder);516 createCleanupRegion(converter, loc, argType, cleanupRegion, sym,517 isDoConcurrent);518 return;519 }520 521 // Allocating on the heap in case the whole reduction/privatization is nested522 // inside of a loop523 auto temp = [&]() {524 if (shouldAllocateTempOnStack())525 return createStackTempFromMold(loc, builder, source);526 527 auto [temp, needsDealloc] = createTempFromMold(loc, builder, source);528 // if needsDealloc, add cleanup region. Always529 // do this for allocatable boxes because they might have been re-allocated530 // in the body of the loop/parallel region531 if (needsDealloc) {532 mlir::OpBuilder::InsertionGuard guard(builder);533 createCleanupRegion(converter, loc, argType, cleanupRegion, sym,534 isDoConcurrent);535 } else {536 assert(!isAllocatableOrPointer &&537 "Pointer-like arrays must be heap allocated");538 }539 return temp;540 }();541 542 // Put the temporary inside of a box:543 // hlfir::genVariableBox doesn't handle non-default lower bounds544 mlir::Value box;545 fir::ShapeShiftOp shapeShift = getShapeShift(builder, loc, getLoadedMoldArg(),546 cannotHaveNonDefaultLowerBounds);547 mlir::Type boxType = getLoadedMoldArg().getType();548 if (mlir::isa<fir::BaseBoxType>(temp.getType()))549 // the box created by the declare form createTempFromMold is missing550 // lower bounds info551 box = fir::ReboxOp::create(builder, loc, boxType, temp, shapeShift,552 /*shift=*/mlir::Value{});553 else554 box = fir::EmboxOp::create(builder, loc, boxType, temp, shapeShift,555 /*slice=*/mlir::Value{},556 /*typeParams=*/llvm::ArrayRef<mlir::Value>{});557 558 if (scalarInitValue)559 hlfir::AssignOp::create(builder, loc, scalarInitValue, box);560 561 initializeIfDerivedTypeBox(562 builder, loc, box, getLoadedMoldArg(), needsInitialization,563 /*isFirstPrivate=*/kind == DeclOperationKind::FirstPrivateOrLocalInit);564 565 fir::StoreOp::create(builder, loc, box, allocatedPrivVarArg);566 if (ifUnallocated)567 builder.setInsertionPointAfter(ifUnallocated);568 createYield(allocatedPrivVarArg);569}570 571void PopulateInitAndCleanupRegionsHelper::initAndCleanupBoxchar(572 fir::BoxCharType boxCharTy) {573 mlir::Type eleTy = boxCharTy.getEleTy();574 builder.setInsertionPointToStart(initBlock);575 fir::factory::CharacterExprHelper charExprHelper{builder, loc};576 auto [addr, len] = charExprHelper.createUnboxChar(moldArg);577 578 // Using heap temporary so that579 // 1) It is safe to use privatization inside of big loops.580 // 2) The lifetime can outlive the current stack frame for delayed task581 // execution.582 // We can't always allocate a boxchar implicitly as the type of the583 // omp.private because the allocation potentially needs the length584 // parameters fetched above.585 // TODO: this deviates from the intended design for delayed task586 // execution.587 mlir::Value privateAddr = builder.createHeapTemporary(588 loc, eleTy, /*name=*/{}, /*shape=*/{}, /*lenParams=*/len);589 mlir::Value boxChar = charExprHelper.createEmboxChar(privateAddr, len);590 591 createCleanupRegion(converter, loc, argType, cleanupRegion, sym,592 isDoConcurrent);593 594 builder.setInsertionPointToEnd(initBlock);595 createYield(boxChar);596}597 598void PopulateInitAndCleanupRegionsHelper::initAndCleanupUnboxedDerivedType(599 bool needsInitialization) {600 builder.setInsertionPointToStart(initBlock);601 mlir::Type boxedTy = fir::BoxType::get(valType);602 mlir::Value newBox =603 fir::EmboxOp::create(builder, loc, boxedTy, allocatedPrivVarArg);604 mlir::Value moldBox = fir::EmboxOp::create(builder, loc, boxedTy, moldArg);605 initializeIfDerivedTypeBox(builder, loc, newBox, moldBox, needsInitialization,606 /*isFirstPrivate=*/kind ==607 DeclOperationKind::FirstPrivateOrLocalInit);608 609 if (sym && hasFinalization(*sym))610 createCleanupRegion(converter, loc, argType, cleanupRegion, sym,611 isDoConcurrent);612 613 builder.setInsertionPointToEnd(initBlock);614 createYield(allocatedPrivVarArg);615}616 617/// This is the main driver deciding how to initialize the private variable.618void PopulateInitAndCleanupRegionsHelper::populateByRefInitAndCleanupRegions() {619 if (isPrivatization(kind)) {620 assert(sym && "Symbol information is required to privatize derived types");621 assert(!scalarInitValue && "ScalarInitvalue is unused for privatization");622 }623 if (hlfir::Entity{moldArg}.isAssumedRank())624 TODO(loc, "Privatization of assumed rank variable");625 mlir::Type valTy = fir::unwrapRefType(argType);626 627 if (fir::isa_trivial(valTy)) {628 initTrivialType();629 return;630 }631 632 bool needsInitialization =633 sym ? isDerivedTypeNeedingInitialization(sym->GetUltimate()) : false;634 635 if (auto boxTy = mlir::dyn_cast_or_null<fir::BaseBoxType>(valTy)) {636 builder.setInsertionPointToEnd(initBlock);637 638 // TODO: don't do this unless it is needed639 getLengthParameters(builder, loc, getLoadedMoldArg(), lenParams);640 641 if (isPrivatization(kind) &&642 mlir::isa<fir::PointerType>(boxTy.getEleTy())) {643 initBoxedPrivatePointer(boxTy);644 return;645 }646 647 mlir::Type innerTy = fir::unwrapRefType(boxTy.getEleTy());648 bool isDerived = fir::isa_derived(innerTy);649 bool isChar = fir::isa_char(innerTy);650 if (fir::isa_trivial(innerTy) || isDerived || isChar) {651 // boxed non-sequence value e.g. !fir.box<!fir.heap<i32>>652 if ((isDerived || isChar) && (isReduction(kind) || scalarInitValue))653 TODO(loc, "Reduction of an unsupported boxed type");654 initAndCleanupBoxedScalar(boxTy, needsInitialization);655 return;656 }657 658 innerTy = fir::extractSequenceType(boxTy);659 if (!innerTy || !mlir::isa<fir::SequenceType>(innerTy))660 TODO(loc, "Unsupported boxed type for reduction/privatization");661 initAndCleanupBoxedArray(boxTy, needsInitialization);662 return;663 }664 665 // Unboxed types:666 if (auto boxCharTy = mlir::dyn_cast<fir::BoxCharType>(argType)) {667 initAndCleanupBoxchar(boxCharTy);668 return;669 }670 if (fir::isa_derived(valType)) {671 initAndCleanupUnboxedDerivedType(needsInitialization);672 return;673 }674 675 TODO(loc,676 "creating reduction/privatization init region for unsupported type");677}678 679void Fortran::lower::populateByRefInitAndCleanupRegions(680 Fortran::lower::AbstractConverter &converter, mlir::Location loc,681 mlir::Type argType, mlir::Value scalarInitValue, mlir::Block *initBlock,682 mlir::Value allocatedPrivVarArg, mlir::Value moldArg,683 mlir::Region &cleanupRegion, DeclOperationKind kind,684 const Fortran::semantics::Symbol *sym, bool cannotHaveLowerBounds,685 bool isDoConcurrent) {686 PopulateInitAndCleanupRegionsHelper helper(687 converter, loc, argType, scalarInitValue, allocatedPrivVarArg, moldArg,688 initBlock, cleanupRegion, kind, sym, cannotHaveLowerBounds,689 isDoConcurrent);690 helper.populateByRefInitAndCleanupRegions();691 692 // Often we load moldArg to check something (e.g. length parameters, shape)693 // but then those answers can be gotten statically without accessing the694 // runtime value and so the only remaining use is a dead load. These loads can695 // force us to insert additional barriers and so should be avoided where696 // possible.697 if (moldArg.hasOneUse()) {698 mlir::Operation *user = *moldArg.getUsers().begin();699 if (auto load = mlir::dyn_cast<fir::LoadOp>(user))700 if (load.use_empty())701 load.erase();702 }703}704