1212
1313#include " DataSharingProcessor.h"
1414
15+ #include " PrivateReductionUtils.h"
1516#include " Utils.h"
1617#include " flang/Lower/ConvertVariable.h"
1718#include " flang/Lower/PFTBuilder.h"
1819#include " flang/Lower/SymbolMap.h"
20+ #include " flang/Optimizer/Builder/BoxValue.h"
1921#include " flang/Optimizer/Builder/HLFIRTools.h"
2022#include " flang/Optimizer/Builder/Todo.h"
23+ #include " flang/Optimizer/HLFIR/HLFIRDialect.h"
2124#include " flang/Optimizer/HLFIR/HLFIROps.h"
25+ #include " flang/Semantics/attr.h"
2226#include " flang/Semantics/tools.h"
2327
2428namespace Fortran {
@@ -85,35 +89,65 @@ void DataSharingProcessor::insertDeallocs() {
8589 converter.createHostAssociateVarCloneDealloc (*sym);
8690 continue ;
8791 }
88-
89- lower::SymbolBox hsb = converter.lookupOneLevelUpSymbol (*sym);
90- assert (hsb && " Host symbol box not found" );
91- mlir::Type symType = hsb.getAddr ().getType ();
92- mlir::Location symLoc = hsb.getAddr ().getLoc ();
93- fir::ExtendedValue symExV = converter.getSymbolExtendedValue (*sym);
94- mlir::omp::PrivateClauseOp privatizer = symToPrivatizer.at (sym);
95-
96- lower::SymMapScope scope (symTable);
97- mlir::OpBuilder::InsertionGuard guard (firOpBuilder);
98-
99- mlir::Region &deallocRegion = privatizer.getDeallocRegion ();
100- fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder ();
101- mlir::Block *deallocEntryBlock = firOpBuilder.createBlock (
102- &deallocRegion, /* insertPt=*/ {}, symType, symLoc);
103-
104- firOpBuilder.setInsertionPointToEnd (deallocEntryBlock);
105- symTable.addSymbol (*sym,
106- fir::substBase (symExV, deallocRegion.getArgument (0 )));
107-
108- converter.createHostAssociateVarCloneDealloc (*sym);
109- firOpBuilder.create <mlir::omp::YieldOp>(hsb.getAddr ().getLoc ());
92+ // For delayed privatization deallocs are created by
93+ // populateByRefInitAndCleanupRegions
11094 }
11195}
11296
11397void DataSharingProcessor::cloneSymbol (const semantics::Symbol *sym) {
11498 bool isFirstPrivate = sym->test (semantics::Symbol::Flag::OmpFirstPrivate);
115- bool success = converter.createHostAssociateVarClone (
116- *sym, /* skipDefaultInit=*/ isFirstPrivate);
99+
100+ // If we are doing eager-privatization on a symbol created using delayed
101+ // privatization there could be incompatible types here e.g.
102+ // fir.ref<fir.box<fir.array<>>>
103+ bool success = [&]() -> bool {
104+ const auto *details =
105+ sym->detailsIf <Fortran::semantics::HostAssocDetails>();
106+ assert (details && " No host-association found" );
107+ const Fortran::semantics::Symbol &hsym = details->symbol ();
108+ mlir::Value addr = converter.getSymbolAddress (hsym);
109+
110+ if (auto refTy = mlir::dyn_cast<fir::ReferenceType>(addr.getType ())) {
111+ if (auto boxTy = mlir::dyn_cast<fir::BoxType>(refTy.getElementType ())) {
112+ if (auto arrayTy =
113+ mlir::dyn_cast<fir::SequenceType>(boxTy.getElementType ())) {
114+ // FirConverter/fir::ExtendedValue considers all references to boxes
115+ // as mutable boxes. Outside of OpenMP it doesn't make sense to have a
116+ // mutable box of an array. Work around this here by loading the
117+ // reference so it is a normal boxed array.
118+ fir::FirOpBuilder &builder = converter.getFirOpBuilder ();
119+ mlir::Location loc = converter.genLocation (hsym.name ());
120+ fir::ExtendedValue hexv = converter.getSymbolExtendedValue (hsym);
121+
122+ llvm::SmallVector<mlir::Value> extents =
123+ fir::factory::getExtents (loc, builder, hexv);
124+
125+ // TODO: uniqName, name
126+ mlir::Value allocVal =
127+ builder.allocateLocal (loc, arrayTy, /* uniqName=*/ " " ,
128+ /* name=*/ " " , extents, /* typeParams=*/ {},
129+ sym->GetUltimate ().attrs ().test (
130+ Fortran::semantics::Attr::TARGET));
131+ mlir::Value shape = builder.genShape (loc, extents);
132+ mlir::Value box = builder.createBox (loc, boxTy, allocVal, shape,
133+ nullptr , {}, nullptr );
134+
135+ // This can't be a CharArrayBoxValue because otherwise
136+ // boxTy.getElementType() would be a character type.
137+ // Assume the array element type isn't polymorphic because we are
138+ // privatizing.
139+ fir::ExtendedValue newExv = fir::ArrayBoxValue{box, extents};
140+
141+ converter.bindSymbol (*sym, newExv);
142+ return true ;
143+ }
144+ }
145+ }
146+
147+ // Normal case:
148+ return converter.createHostAssociateVarClone (
149+ *sym, /* skipDefaultInit=*/ isFirstPrivate);
150+ }();
117151 (void )success;
118152 assert (success && " Privatization failed due to existing binding" );
119153
@@ -132,7 +166,7 @@ void DataSharingProcessor::cloneSymbol(const semantics::Symbol *sym) {
132166
133167 if (needInitClone ()) {
134168 Fortran::lower::initializeCloneAtRuntime (converter, *sym, symTable);
135- callsInitClone = true ;
169+ mightHaveReadHostSym = true ;
136170 }
137171}
138172
@@ -184,7 +218,8 @@ bool DataSharingProcessor::needBarrier() {
184218 // Emit implicit barrier for linear clause. Maybe on somewhere else.
185219 for (const semantics::Symbol *sym : allPrivatizedSymbols) {
186220 if (sym->test (semantics::Symbol::Flag::OmpLastPrivate) &&
187- (sym->test (semantics::Symbol::Flag::OmpFirstPrivate) || callsInitClone))
221+ (sym->test (semantics::Symbol::Flag::OmpFirstPrivate) ||
222+ mightHaveReadHostSym))
188223 return true ;
189224 }
190225 return false ;
@@ -468,15 +503,47 @@ void DataSharingProcessor::doPrivatize(const semantics::Symbol *sym,
468503 lower::SymbolBox hsb = converter.lookupOneLevelUpSymbol (*sym);
469504 assert (hsb && " Host symbol box not found" );
470505
471- mlir::Type symType = hsb.getAddr ().getType ();
472506 mlir::Location symLoc = hsb.getAddr ().getLoc ();
473507 std::string privatizerName = sym->name ().ToString () + " .privatizer" ;
474508 bool isFirstPrivate = sym->test (semantics::Symbol::Flag::OmpFirstPrivate);
475509
510+ mlir::Value privVal = hsb.getAddr ();
511+ mlir::Type allocType = privVal.getType ();
512+ if (!mlir::isa<fir::PointerType>(privVal.getType ()))
513+ allocType = fir::unwrapRefType (privVal.getType ());
514+
515+ if (auto poly = mlir::dyn_cast<fir::ClassType>(allocType)) {
516+ if (!mlir::isa<fir::PointerType>(poly.getEleTy ()) && isFirstPrivate)
517+ TODO (symLoc, " create polymorphic host associated copy" );
518+ }
519+
520+ // fir.array<> cannot be converted to any single llvm type and fir helpers
521+ // are not available in openmp to llvmir translation so we cannot generate
522+ // an alloca for a fir.array type there. Get around this by boxing all
523+ // arrays.
524+ if (mlir::isa<fir::SequenceType>(allocType)) {
525+ hlfir::Entity entity{hsb.getAddr ()};
526+ entity = genVariableBox (symLoc, firOpBuilder, entity);
527+ privVal = entity.getBase ();
528+ allocType = privVal.getType ();
529+ }
530+
531+ if (mlir::isa<fir::BaseBoxType>(privVal.getType ())) {
532+ // Boxes should be passed by reference into nested regions:
533+ auto oldIP = firOpBuilder.saveInsertionPoint ();
534+ firOpBuilder.setInsertionPointToStart (firOpBuilder.getAllocaBlock ());
535+ auto alloca = firOpBuilder.create <fir::AllocaOp>(symLoc, privVal.getType ());
536+ firOpBuilder.restoreInsertionPoint (oldIP);
537+ firOpBuilder.create <fir::StoreOp>(symLoc, privVal, alloca);
538+ privVal = alloca;
539+ }
540+
541+ mlir::Type argType = privVal.getType ();
542+
476543 mlir::omp::PrivateClauseOp privatizerOp = [&]() {
477544 auto moduleOp = firOpBuilder.getModule ();
478545 auto uniquePrivatizerName = fir::getTypeAsString (
479- symType , converter.getKindMap (),
546+ allocType , converter.getKindMap (),
480547 converter.mangleName (*sym) +
481548 (isFirstPrivate ? " _firstprivate" : " _private" ));
482549
@@ -488,44 +555,40 @@ void DataSharingProcessor::doPrivatize(const semantics::Symbol *sym,
488555 mlir::OpBuilder::InsertionGuard guard (firOpBuilder);
489556 firOpBuilder.setInsertionPointToStart (moduleOp.getBody ());
490557 auto result = firOpBuilder.create <mlir::omp::PrivateClauseOp>(
491- symLoc, uniquePrivatizerName, symType ,
558+ symLoc, uniquePrivatizerName, allocType ,
492559 isFirstPrivate ? mlir::omp::DataSharingClauseType::FirstPrivate
493560 : mlir::omp::DataSharingClauseType::Private);
494561 fir::ExtendedValue symExV = converter.getSymbolExtendedValue (*sym);
495562 lower::SymMapScope outerScope (symTable);
496563
497- // Populate the `alloc` region.
498- {
499- mlir::Region &allocRegion = result.getAllocRegion ();
500- mlir::Block *allocEntryBlock = firOpBuilder.createBlock (
501- &allocRegion, /* insertPt=*/ {}, symType, symLoc);
502-
503- firOpBuilder.setInsertionPointToEnd (allocEntryBlock);
504-
505- fir::ExtendedValue localExV =
506- hlfir::translateToExtendedValue (
507- symLoc, firOpBuilder, hlfir::Entity{allocRegion.getArgument (0 )},
508- /* contiguousHint=*/
509- evaluate::IsSimplyContiguous (*sym, converter.getFoldingContext ()))
510- .first ;
511-
512- symTable.addSymbol (*sym, localExV);
513- lower::SymMapScope innerScope (symTable);
514- cloneSymbol (sym);
515- mlir::Value cloneAddr = symTable.shallowLookupSymbol (*sym).getAddr ();
516- mlir::Type cloneType = cloneAddr.getType ();
517-
518- // A `convert` op is required for variables that are storage associated
519- // via `equivalence`. The problem is that these variables are declared as
520- // `fir.ptr`s while their privatized storage is declared as `fir.ref`,
521- // therefore we convert to proper symbol type.
522- mlir::Value yieldedValue =
523- (symType == cloneType) ? cloneAddr
524- : firOpBuilder.createConvert (
525- cloneAddr.getLoc (), symType, cloneAddr);
526-
527- firOpBuilder.create <mlir::omp::YieldOp>(hsb.getAddr ().getLoc (),
528- yieldedValue);
564+ // Populate the `init` region.
565+ // We need to initialize in the following cases:
566+ // 1. The allocation was for a derived type which requires initialization
567+ // (this can be skipped if it will be initialized anyway by the copy
568+ // region, unless the derived type has allocatable components)
569+ // 2. The allocation was for any kind of box
570+ // 3. The allocation was for a boxed character
571+ const bool needsInitialization =
572+ (Fortran::lower::hasDefaultInitialization (sym->GetUltimate ()) &&
573+ (!isFirstPrivate || hlfir::mayHaveAllocatableComponent (allocType))) ||
574+ mlir::isa<fir::BaseBoxType>(allocType) ||
575+ mlir::isa<fir::BoxCharType>(allocType);
576+ if (needsInitialization) {
577+ mlir::Region &initRegion = result.getInitRegion ();
578+ mlir::Block *initBlock = firOpBuilder.createBlock (
579+ &initRegion, /* insertPt=*/ {}, {argType, argType}, {symLoc, symLoc});
580+
581+ populateByRefInitAndCleanupRegions (
582+ converter, symLoc, argType, /* scalarInitValue=*/ nullptr , initBlock,
583+ result.getInitPrivateArg (), result.getInitMoldArg (),
584+ result.getDeallocRegion (),
585+ isFirstPrivate ? DeclOperationKind::FirstPrivate
586+ : DeclOperationKind::Private,
587+ sym);
588+ // TODO: currently there are false positives from dead uses of the mold
589+ // arg
590+ if (!result.getInitMoldArg ().getUses ().empty ())
591+ mightHaveReadHostSym = true ;
529592 }
530593
531594 // Populate the `copy` region if this is a `firstprivate`.
@@ -534,7 +597,7 @@ void DataSharingProcessor::doPrivatize(const semantics::Symbol *sym,
534597 // First block argument corresponding to the original/host value while
535598 // second block argument corresponding to the privatized value.
536599 mlir::Block *copyEntryBlock = firOpBuilder.createBlock (
537- ©Region, /* insertPt=*/ {}, {symType, symType }, {symLoc, symLoc});
600+ ©Region, /* insertPt=*/ {}, {argType, argType }, {symLoc, symLoc});
538601 firOpBuilder.setInsertionPointToEnd (copyEntryBlock);
539602
540603 auto addSymbol = [&](unsigned argIdx, bool force = false ) {
@@ -565,7 +628,7 @@ void DataSharingProcessor::doPrivatize(const semantics::Symbol *sym,
565628
566629 if (clauseOps) {
567630 clauseOps->privateSyms .push_back (mlir::SymbolRefAttr::get (privatizerOp));
568- clauseOps->privateVars .push_back (hsb. getAddr () );
631+ clauseOps->privateVars .push_back (privVal );
569632 }
570633
571634 symToPrivatizer[sym] = privatizerOp;
0 commit comments