diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -101,6 +101,9 @@ virtual bool createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0; + virtual void + createHostAssociateVarCloneDealloc(const Fortran::semantics::Symbol &sym) = 0; + virtual void copyHostAssociateVar( const Fortran::semantics::Symbol &sym, mlir::OpBuilder::InsertPoint *copyAssignIP = nullptr) = 0; diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1158,7 +1158,7 @@ bool IsAllocatableOrPointerObject( const Expr &expr, FoldingContext &context) { const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)}; - return (sym && semantics::IsAllocatableOrPointer(*sym)) || + return (sym && semantics::IsAllocatableOrPointer(sym->GetUltimate())) || evaluate::IsObjectPointer(expr, context); } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -569,18 +569,23 @@ const auto *details = sym.detailsIf(); assert(details && "No host-association found"); const Fortran::semantics::Symbol &hsym = details->symbol(); + mlir::Type hSymType = genType(hsym); Fortran::lower::SymbolBox hsb = lookupSymbol(hsym); auto allocate = [&](llvm::ArrayRef shape, llvm::ArrayRef typeParams) -> mlir::Value { mlir::Value allocVal = builder->allocateLocal( - loc, symType, mangleName(sym), toStringRef(sym.GetUltimate().name()), + loc, + Fortran::semantics::IsAllocatableOrPointer(hsym.GetUltimate()) + ? hSymType + : symType, + mangleName(sym), toStringRef(sym.GetUltimate().name()), /*pinned=*/true, shape, typeParams, sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET)); return allocVal; }; - fir::ExtendedValue hexv = getExtendedValue(hsb); + fir::ExtendedValue hexv = symBoxToExtendedValue(hsb); fir::ExtendedValue exv = hexv.match( [&](const fir::BoxValue &box) -> fir::ExtendedValue { const Fortran::semantics::DeclTypeSpec *type = sym.GetType(); @@ -602,8 +607,7 @@ [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue { // Allocate storage for a pointer/allocatble descriptor. // No shape/lengths to be passed to the alloca. - return fir::MutableBoxValue(allocate({}, {}), - box.nonDeferredLenParams(), {}); + return fir::MutableBoxValue(allocate({}, {}), {}, {}); }, [&](const auto &) -> fir::ExtendedValue { mlir::Value temp = @@ -612,9 +616,84 @@ return fir::substBase(hexv, temp); }); + // Initialise cloned allocatable + hexv.match( + [&](const fir::MutableBoxValue &box) -> void { + // Do not process pointers + if (Fortran::semantics::IsPointer(sym.GetUltimate())) { + return; + } + // Allocate storage for a pointer/allocatble descriptor. + // No shape/lengths to be passed to the alloca. + const auto new_box = exv.getBoxOf(); + + // allocate if allocated + mlir::Value isAllocated = + fir::factory::genIsAllocatedOrAssociatedTest(*builder, loc, box); + auto if_builder = builder->genIfThenElse(loc, isAllocated); + if_builder.genThen([&]() { + std::string name = mangleName(sym) + ".alloc"; + if (auto seqTy = symType.dyn_cast()) { + fir::ExtendedValue read = fir::factory::genMutableBoxRead( + *builder, loc, box, /*mayBePolymorphic=*/false); + auto read_box = read.getBoxOf(); + fir::factory::genInlinedAllocation( + *builder, loc, *new_box, read_box->getLBounds(), + read_box->getExtents(), + /*lenParams=*/std::nullopt, name, + /*mustBeHeap=*/true); + } else { + fir::factory::genInlinedAllocation( + *builder, loc, *new_box, + new_box->getMutableProperties().lbounds, + new_box->getMutableProperties().extents, + /*lenParams=*/std::nullopt, name, + /*mustBeHeap=*/true); + } + }); + if_builder.genElse([&]() { + // nullify box + auto empty = fir::factory::createUnallocatedBox( + *builder, loc, new_box->getBoxTy(), + new_box->nonDeferredLenParams(), {}); + builder->create(loc, empty, new_box->getAddr()); + }); + if_builder.end(); + }, + [&](const auto &) -> void { + // Do nothing + }); + return bindIfNewSymbol(sym, exv); } + void createHostAssociateVarCloneDealloc( + const Fortran::semantics::Symbol &sym) override final { + mlir::Location loc = genLocation(sym.name()); + Fortran::lower::SymbolBox hsb = lookupSymbol(sym); + + fir::ExtendedValue hexv = symBoxToExtendedValue(hsb); + hexv.match( + [&](const fir::MutableBoxValue &new_box) -> void { + // Do not process pointers + if (Fortran::semantics::IsPointer(sym.GetUltimate())) { + return; + } + // deallocate allocated in createHostAssociateVarClone value + mlir::Value needs_dealloc = + fir::factory::genIsAllocatedOrAssociatedTest(*builder, loc, + new_box); + builder->genIfThen(loc, needs_dealloc) + .genThen([&]() { + Fortran::lower::genDeallocateBox(*this, new_box, loc); + }) + .end(); + }, + [&](const auto &) -> void { + // Do nothing + }); + } + void copyHostAssociateVar( const Fortran::semantics::Symbol &sym, mlir::OpBuilder::InsertPoint *copyAssignIP = nullptr) override final { @@ -624,14 +703,14 @@ const Fortran::semantics::Symbol &hsym = sym.GetUltimate(); Fortran::lower::SymbolBox hsb = lookupOneLevelUpSymbol(hsym); assert(hsb && "Host symbol box not found"); - fir::ExtendedValue hexv = getExtendedValue(hsb); + fir::ExtendedValue hexv = symBoxToExtendedValue(hsb); // 2) Fetch the copied one that will mask the original. Fortran::lower::SymbolBox sb = shallowLookupSymbol(sym); assert(sb && "Host-associated symbol box not found"); assert(hsb.getAddr() != sb.getAddr() && "Host and associated symbol boxes are the same"); - fir::ExtendedValue exv = getExtendedValue(sb); + fir::ExtendedValue exv = symBoxToExtendedValue(sb); // 3) Perform the assignment. mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint(); @@ -653,6 +732,7 @@ mlir::Location loc = genLocation(sym.name()); mlir::Type symType = genType(sym); + if (auto seqTy = symType.dyn_cast()) { Fortran::lower::StatementContext stmtCtx; Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols, @@ -660,16 +740,15 @@ stmtCtx.finalizeAndReset(); } else if (hexv.getBoxOf()) { fir::factory::CharacterExprHelper{*builder, loc}.createAssign(lhs, rhs); - } else if (hexv.getBoxOf()) { - TODO(loc, "firstprivatisation of allocatable variables"); } else { auto loadVal = builder->create(loc, fir::getBase(rhs)); builder->create(loc, loadVal, fir::getBase(lhs)); } if (copyAssignIP && copyAssignIP->isSet() && - sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) + sym.test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) { builder->restoreInsertionPoint(insPt); + } } //===--------------------------------------------------------------------===// @@ -918,15 +997,6 @@ return true; } - fir::ExtendedValue getExtendedValue(Fortran::lower::SymbolBox sb) { - fir::ExtendedValue exv = symBoxToExtendedValue(sb); - // Dereference pointers and allocatables. - if (const auto *box = exv.getBoxOf()) - return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(), - *box); - return exv; - } - /// Generate the address of loop variable \p sym. /// If \p sym is not mapped yet, allocate local storage for it. mlir::Value genLoopVariableAddress(mlir::Location loc, diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -99,6 +99,7 @@ void copyFirstPrivateSymbol(const Fortran::semantics::Symbol *sym); void copyLastPrivateSymbol(const Fortran::semantics::Symbol *sym, mlir::OpBuilder::InsertPoint *lastPrivIP); + void insertDeallocs(); public: DataSharingProcessor(Fortran::lower::AbstractConverter &converter, @@ -114,20 +115,14 @@ // construct, for looping constructs this is just before the Operation. The // split into two steps was performed basically to be able to call // privatisation for looping constructs before the operation is created since - // the bounds of the MLIR OpenMP operation can be privatised. Step2 performs - // the copying for lastprivates. Step2 requires knowledge of the MLIR - // operation to insert the last private update. - bool process(mlir::Operation *op); + // the bounds of the MLIR OpenMP operation can be privatised. + // Step2 performs the copying for lastprivates and requires knowledge of the + // MLIR operation to insert the last private update. Step2 adds + // dealocation code as well. void processStep1(); - bool processStep2(mlir::Operation *op); + void processStep2(mlir::Operation *op, bool is_loop); }; -bool DataSharingProcessor::process(mlir::Operation *op) { - processStep1(); - assert(op && "Current MLIR operation not set"); - return processStep2(op); -} - void DataSharingProcessor::processStep1() { collectSymbolsForPrivatization(); collectDefaultSymbols(); @@ -136,11 +131,29 @@ insertBarrier(); } -bool DataSharingProcessor::processStep2(mlir::Operation *op) { +void DataSharingProcessor::processStep2(mlir::Operation *op, bool is_loop) { insPt = firOpBuilder.saveInsertionPoint(); copyLastPrivatize(op); firOpBuilder.restoreInsertionPoint(insPt); - return hasLastPrivateOp; + + if (is_loop) { + // push deallocs out of the loop + firOpBuilder.setInsertionPointAfter(op); + insertDeallocs(); + } else { + // insert dummy instruction to mark the insertion position + mlir::Value undefMarker = firOpBuilder.create( + op->getLoc(), firOpBuilder.getIndexType()); + insertDeallocs(); + firOpBuilder.setInsertionPointAfter(undefMarker.getDefiningOp()); + } +} + +void DataSharingProcessor::insertDeallocs() { + for (auto sym : privatizedSymbols) + if (Fortran::semantics::IsAllocatable(sym->GetUltimate())) { + converter.createHostAssociateVarCloneDealloc(*sym); + } } void DataSharingProcessor::cloneSymbol(const Fortran::semantics::Symbol *sym) { @@ -694,26 +707,23 @@ } else { firOpBuilder.create(loc); } - // Reset the insert point to before the terminator. resetBeforeTerminator(firOpBuilder, storeOp, block); // Handle privatization. Do not privatize if this is the outer operation. if (clauses && !outerCombined) { - bool lastPrivateOp = false; + constexpr bool is_loop = std::is_same_v || + std::is_same_v; if (!dsp) { - dsp = new DataSharingProcessor(converter, *clauses, eval); - lastPrivateOp = dsp->process(op); - delete dsp; + DataSharingProcessor proc(converter, *clauses, eval); + proc.processStep1(); + proc.processStep2(op, is_loop); } else { - lastPrivateOp = dsp->processStep2(op); + dsp->processStep2(op, is_loop); } - // LastPrivatization, due to introduction of - // new control flow, changes the insertion point, - // thus restore it. - // TODO: Clean up later a bit to avoid this many sets and resets. - if (lastPrivateOp && !std::is_same_v) - resetBeforeTerminator(firOpBuilder, storeOp, block); + + if (storeOp) + firOpBuilder.setInsertionPointAfter(storeOp); } if constexpr (std::is_same_v) { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -1062,7 +1062,7 @@ if (const auto &pointerArg{arguments[0]}) { if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) { const Symbol *pointerSymbol{GetLastSymbol(*pointerExpr)}; - if (pointerSymbol && !IsPointer(*pointerSymbol)) { + if (pointerSymbol && !IsPointer(pointerSymbol->GetUltimate())) { evaluate::AttachDeclaration( context.messages().Say(pointerArg->sourceLocation(), "POINTER= argument of ASSOCIATED() must be a POINTER"_err_en_US), diff --git a/flang/test/Lower/OpenMP/parallel-private-clause.f90 b/flang/test/Lower/OpenMP/parallel-private-clause.f90 --- a/flang/test/Lower/OpenMP/parallel-private-clause.f90 +++ b/flang/test/Lower/OpenMP/parallel-private-clause.f90 @@ -106,20 +106,23 @@ !FIRDialect-DAG: {{.*}} = fir.alloca !fir.box>> {bindc_name = "x2", uniq_name = "{{.*}}Ex2"} !FIRDialect-DAG: {{.*}} = fir.alloca !fir.heap> {uniq_name = "{{.*}}Ex2.addr"} !FIRDialect-DAG: {{.*}} = fir.address_of(@{{.*}}Ex3) : !fir.ref>> -!FIRDialect-DAG: [[TMP9:%.*]] = fir.address_of(@{{.*}}Ex4) : !fir.ref>>> +!FIRDialect-DAG: [[TMP8:%.*]] = fir.address_of(@{{.*}}Ex4) : !fir.ref>>> !FIRDialect: omp.parallel { -!FIRDialect-DAG: [[TMP37:%.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "{{.*}}Ex"} -!FIRDialect-DAG: [[TMP40:%.*]] = fir.alloca !fir.array, {{.*}} {bindc_name = "x2", pinned, uniq_name = "{{.*}}Ex2"} -!FIRDialect-DAG: [[TMP41:%.*]] = fir.alloca i32 {bindc_name = "x3", pinned, uniq_name = "{{.*}}Ex3"} -!FIRDialect-DAG: [[TMP42:%.*]] = fir.load [[TMP9]] : !fir.ref>>> -!FIRDialect-DAG: [[TMP43:%.*]]:3 = fir.box_dims [[TMP42]], {{.*}} : (!fir.box>>, index) -> (index, index, index) -!FIRDialect-DAG: [[TMP44:%.*]] = fir.alloca !fir.array, [[TMP43]]#1 {bindc_name = "x4", pinned, uniq_name = "{{.*}}Ex4"} -!FIRDialect-DAG: [[TMP52:%.*]] = fir.embox [[TMP40]]({{.*}}) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box> -!FIRDialect-DAG: {{.*}} = fir.convert [[TMP52]] : (!fir.box>) -> !fir.box -!FIRDialect-DAG: [[TMP58:%.*]] = fir.shape_shift [[TMP43]]#0, [[TMP43]]#1 : (index, index) -> !fir.shapeshift<1> -!FIRDialect-DAG: [[TMP59:%.*]] = fir.embox [[TMP44]]([[TMP58]]) : (!fir.ref>, !fir.shapeshift<1>) -> !fir.box> -!FIRDialect-DAG: {{.*}} = fir.convert [[TMP59]] : (!fir.box>) -> !fir.box +!FIRDialect-DAG: [[TMP35:%.*]] = fir.alloca !fir.box> {bindc_name = "x", pinned, uniq_name = "{{.*}}Ex"} +!FIRDialect-DAG: [[TMP39:%.*]] = fir.alloca !fir.box>> {bindc_name = "x2", pinned, uniq_name = "{{.*}}Ex2"} +!FIRDialect-DAG: [[TMP45:%.*]] = fir.alloca !fir.box> {bindc_name = "x3", pinned, uniq_name = "{{.*}}Ex3"} + +!FIRDialect-DAG: [[TMP51:%.*]] = fir.load [[TMP8]] : !fir.ref>>> +!FIRDialect-DAG: [[TMP97:%.*]] = fir.load [[TMP8]] : !fir.ref>>> +!FIRDialect-DAG: [[TMP98:%.*]]:3 = fir.box_dims [[TMP97]], {{.*}} : (!fir.box>>, index) -> (index, index, index) +!FIRDialect-DAG: [[TMP50:%.*]] = fir.alloca !fir.box>> {bindc_name = "x4", pinned, uniq_name = "{{.*}}Ex4"} + +! FIRDialect-DAG: [[TMP101:%.*]] = fir.allocmem !fir.array, {{.*}} {fir.must_be_heap = true, uniq_name = "{{.*}}Ex4.alloc"} +! FIRDialect-DAG: [[TMP102:%.*]] = fir.shape_shift {{.*}}#0, {{.*}} : (index, index) -> !fir.shapeshift<1> +! FIRDialect-DAG: [[TMP103:%.*]] = fir.embox [[TMP101]]([[TMP102]]) : (!fir.heap>, !fir.shapeshift<1>) -> !fir.box>> +! FIRDialect-DAG: fir.store [[TMP103]] to [[TMP50]] : !fir.ref>>> + subroutine private_clause_allocatable() @@ -133,3 +136,245 @@ !$OMP END PARALLEL end subroutine + + +!FIRDialect: func @_QPprivate_clause_real_call_allocatable() { +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.box> {bindc_name = "x5", uniq_name = "{{.*}}Ex5"} +!FIRDialect-DAG: {{.*}} = fir.zero_bits !fir.heap +!FIRDialect-DAG: {{.*}} = fir.embox %1 : (!fir.heap) -> !fir.box> +!FIRDialect-DAG: fir.store %2 to %0 : !fir.ref>> +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: [[TMP203:%.*]] = fir.alloca !fir.box> {bindc_name = "x5", pinned, uniq_name = "{{.*}}Ex5"} + +!FIRDialect-DAG: fir.if %7 { + +!FIRDialect-DAG: fir.store %13 to [[TMP203]] : !fir.ref>> +!FIRDialect-DAG: } else { + +!FIRDialect-DAG: fir.store %13 to [[TMP203]] : !fir.ref>> +!FIRDialect-DAG: } +!FIRDialect-DAG: fir.call @_QFprivate_clause_real_call_allocatablePhelper_private_clause_real_call_allocatable([[TMP203]]) fastmath : (!fir.ref>>) -> () +!FIRDialect-DAG: %8 = fir.load [[TMP203]] : !fir.ref>> + +!FIRDialect-DAG: fir.if %11 { +!FIRDialect-DAG: %12 = fir.load [[TMP203]] : !fir.ref>> + +!FIRDialect-DAG: fir.store %15 to [[TMP203]] : !fir.ref>> +!FIRDialect-DAG: } +!FIRDialect-DAG: omp.terminator +!FIRDialect-DAG: } +!FIRDialect-DAG: return +!FIRDialect-DAG: } + + +subroutine private_clause_real_call_allocatable + real, allocatable :: x5 + !$omp parallel private(x5) + call helper_private_clause_real_call_allocatable(x5) + !$omp end parallel + contains + subroutine helper_private_clause_real_call_allocatable(x6) + real, allocatable :: x6 + print *, allocated(x6) + end subroutine +end subroutine + +!FIRDialect: func.func @_QPincrement_list_items(%arg0: !fir.ref>>}>>>> {fir.bindc_name = "head"}) { +!FIRDialect: {{%.*}} = fir.alloca !fir.box>>}>>> {bindc_name = "p", uniq_name = "_QFincrement_list_itemsEp"} +!FIRDialect: omp.parallel { +!FIRDialect: {{%.*}} = fir.alloca !fir.box>>}>>> {bindc_name = "p", pinned, uniq_name = "_QFincrement_list_itemsEp"} +!FIRDialect: omp.single { + +!FIRDialect: omp.terminator +!FIRDialect: omp.terminator +!FIRDialect: return + +subroutine increment_list_items (head) + type node + integer :: payload + type (node), pointer :: next + end type node + + type (node), pointer :: head + type (node), pointer :: p +!$omp parallel private(p) +!$omp single + p => head + do + p => p%next + if ( associated (p) .eqv. .false. ) exit + end do +!$omp end single +!$omp end parallel +end subroutine increment_list_items + +!FIRDialect: func.func @_QPparallel_pointer() { +!FIRDialect-DAG: [[PP0:%.*]] = fir.alloca !fir.box> {bindc_name = "y1", uniq_name = "{{.*}}Ey1"} +!FIRDialect-DAG: [[PP1:%.*]] = fir.alloca !fir.ptr {uniq_name = "{{.*}}Ey1.addr"} +!FIRDialect-DAG: [[PP2:%.*]] = fir.zero_bits !fir.ptr +!FIRDialect: fir.store [[PP2]] to [[PP1]] : !fir.ref> +!FIRDialect-DAG: [[PP3:%.*]] = fir.alloca !fir.box>> {bindc_name = "y2", uniq_name = "{{.*}}Ey2"} + +!FIRDialect: fir.store %6 to %3 : !fir.ref>>> +!FIRDialect-DAG: [[PP7:%.*]] = fir.alloca i32 {bindc_name = "z1", fir.target, uniq_name = "{{.*}}Ez1"} + +!FIRDialect-DAG: [[PP8:%.*]] = fir.alloca !fir.array<10xi32> {bindc_name = "z2", fir.target, uniq_name = "{{.*}}Ez2"} +!FIRDialect: omp.parallel { +!FIRDialect-DAG: [[PP9:%.*]] = fir.alloca !fir.box> {bindc_name = "y1", pinned, uniq_name = "{{.*}}Ey1"} +!FIRDialect-DAG: [[PP10:%.*]] = fir.alloca !fir.box>> {bindc_name = "y2", pinned, uniq_name = "{{.*}}Ey2"} +!FIRDialect-DAG: [[PP11:%.*]] = fir.embox [[PP7]] : (!fir.ref) -> !fir.box> +!FIRDialect: fir.store [[PP11]] to [[PP9]] : !fir.ref>> +!FIRDialect-DAG: [[PP12:%.*]] = fir.shape %c{{.*}} : (index) -> !fir.shape<1> +!FIRDialect-DAG: [[PP13:%.*]] = fir.embox [[PP8]]([[PP12]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box>> +!FIRDialect: fir.store %13 to [[PP10]] : !fir.ref>>> +!FIRDialect: omp.terminator +!FIRDialect: } +!FIRDialect: return +!FIRDialect: } + +subroutine parallel_pointer() + integer, pointer :: y1, y2(:) + integer, target :: z1, z2(10) + +!$omp parallel private(y1, y2) + y1=>z1 + y2=>z2 +!$omp end parallel +end subroutine parallel_pointer + + +!FIRDialect-LABEL: func @_QPsimple_loop_1() +subroutine simple_loop_1 + integer :: i + real, allocatable :: r; + ! FIRDialect: omp.parallel + !$OMP PARALLEL PRIVATE(r) + ! FIRDialect: %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned} + + ! FIRDialect: [[R:%.*]] = fir.alloca !fir.box> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"} + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + + ! FIRDialect: %[[WS_LB:.*]] = arith.constant 1 : i32 + ! FIRDialect: %[[WS_UB:.*]] = arith.constant 9 : i32 + ! FIRDialect: %[[WS_STEP:.*]] = arith.constant 1 : i32 + + ! FIRDialect: omp.wsloop for (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]]) + !$OMP DO + do i=1, 9 + ! FIRDialect: fir.store %[[I]] to %[[ALLOCA_IV:.*]] : !fir.ref + ! FIRDialect: %[[LOAD_IV:.*]] = fir.load %[[ALLOCA_IV]] : !fir.ref + ! FIRDialect: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref, i32) -> i1 + print*, i + end do + ! FIRDialect: omp.yield + ! FIRDialect: {{%.*}} = fir.load [[R]] : !fir.ref>> + ! FIRDialect: fir.if {{%.*}} { + ! FIRDialect: [[LD:%.*]] = fir.load [[R]] : !fir.ref>> + ! FIRDialect: [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box>) -> !fir.heap + ! FIRDialect: fir.freemem [[AD]] : !fir.heap + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + !$OMP END DO + ! FIRDialect: omp.terminator + !$OMP END PARALLEL +end subroutine + +!FIRDialect-LABEL: func @_QPsimple_loop_2() +subroutine simple_loop_2 + integer :: i + real, allocatable :: r; + ! FIRDialect: omp.parallel + !$OMP PARALLEL + ! FIRDialect: %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned} + + ! FIRDialect: [[R:%.*]] = fir.alloca !fir.box> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"} + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + + ! FIRDialect: %[[WS_LB:.*]] = arith.constant 1 : i32 + ! FIRDialect: %[[WS_UB:.*]] = arith.constant 9 : i32 + ! FIRDialect: %[[WS_STEP:.*]] = arith.constant 1 : i32 + + ! FIRDialect: omp.wsloop for (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]]) + !$OMP DO PRIVATE(r) + do i=1, 9 + ! FIRDialect: fir.store %[[I]] to %[[ALLOCA_IV:.*]] : !fir.ref + ! FIRDialect: %[[LOAD_IV:.*]] = fir.load %[[ALLOCA_IV]] : !fir.ref + ! FIRDialect: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref, i32) -> i1 + print*, i + end do + ! FIRDialect: omp.yield + ! FIRDialect: {{%.*}} = fir.load [[R]] : !fir.ref>> + ! FIRDialect: fir.if {{%.*}} { + ! FIRDialect: [[LD:%.*]] = fir.load [[R]] : !fir.ref>> + ! FIRDialect: [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box>) -> !fir.heap + ! FIRDialect: fir.freemem [[AD]] : !fir.heap + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + !$OMP END DO + ! FIRDialect: omp.terminator + !$OMP END PARALLEL +end subroutine + +!FIRDialect-LABEL: func @_QPsimple_loop_3() +subroutine simple_loop_3 + integer :: i + real, allocatable :: r; + ! FIRDialect: omp.parallel + ! FIRDialect: %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned} + + ! FIRDialect: [[R:%.*]] = fir.alloca !fir.box> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"} + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + + ! FIRDialect: %[[WS_LB:.*]] = arith.constant 1 : i32 + ! FIRDialect: %[[WS_UB:.*]] = arith.constant 9 : i32 + ! FIRDialect: %[[WS_STEP:.*]] = arith.constant 1 : i32 + + ! FIRDialect: omp.wsloop for (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]]) + !$OMP PARALLEL DO PRIVATE(r) + do i=1, 9 + ! FIRDialect: fir.store %[[I]] to %[[ALLOCA_IV:.*]] : !fir.ref + ! FIRDialect: %[[LOAD_IV:.*]] = fir.load %[[ALLOCA_IV]] : !fir.ref + ! FIRDialect: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref, i32) -> i1 + print*, i + end do + ! FIRDialect: omp.yield + ! FIRDialect: {{%.*}} = fir.load [[R]] : !fir.ref>> + ! FIRDialect: fir.if {{%.*}} { + ! FIRDialect: [[LD:%.*]] = fir.load [[R]] : !fir.ref>> + ! FIRDialect: [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box>) -> !fir.heap + ! FIRDialect: fir.freemem [[AD]] : !fir.heap + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + !$OMP END PARALLEL DO + ! FIRDialect: omp.terminator +end subroutine + +!CHECK-LABEL: func @_QPsimd_loop_1() +subroutine simd_loop_1 + integer :: i + real, allocatable :: r; + ! IRDialect: [[R:%.*]] = fir.alloca !fir.box> {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"} + ! IRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + ! IRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> + + ! FIRDialect: %[[LB:.*]] = arith.constant 1 : i32 + ! FIRDialect: %[[UB:.*]] = arith.constant 9 : i32 + ! FIRDialect: %[[STEP:.*]] = arith.constant 1 : i32 + + ! FIRDialect: omp.simdloop for (%[[I:.*]]) : i32 = (%[[LB]]) to (%[[UB]]) inclusive step (%[[STEP]]) { + !$OMP SIMD PRIVATE(r) + do i=1, 9 + ! FIRDialect: fir.store %[[I]] to %[[LOCAL:.*]] : !fir.ref + ! FIRDialect: %[[LOAD_IV:.*]] = fir.load %[[LOCAL]] : !fir.ref + ! FIRDialect: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref, i32) -> i1 + print*, i + end do + !$OMP END SIMD + ! FIRDialect: omp.yield + ! FIRDialect: {{%.*}} = fir.load [[R]] : !fir.ref>> + ! FIRDialect: fir.if {{%.*}} { + ! FIRDialect: [[LD:%.*]] = fir.load [[R]] : !fir.ref>> + ! FIRDialect: [[AD:%.*]] = fir.box_addr [[LD]] : (!fir.box>) -> !fir.heap + ! FIRDialect: fir.freemem [[AD]] : !fir.heap + ! FIRDialect: fir.store {{%.*}} to [[R]] : !fir.ref>> +end subroutine