From 0ddbaf654b69c8705c69267e2fcf9eca2a053d51 Mon Sep 17 00:00:00 2001 From: Arnamoy Bhattacharyya Date: Mon, 11 Apr 2022 12:25:52 -0400 Subject: [PATCH] [Flang][OpenMP] Add support for lastprivate clause lowering. --- flang/include/flang/Lower/AbstractConverter.h | 4 +- flang/lib/Lower/Bridge.cpp | 37 ++++++++-- flang/lib/Lower/OpenMP.cpp | 12 +++- ...omp-parallel-lastprivate-clause-scalar.f90 | 68 +++++++++++++++++++ 4 files changed, 112 insertions(+), 9 deletions(-) create mode 100644 flang/test/Lower/OpenMP/omp-parallel-lastprivate-clause-scalar.f90 diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 36a1e45ad918fa..6aa394cb72efc0 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -91,7 +91,9 @@ class AbstractConverter { virtual bool createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0; - virtual void copyHostAssociateVar(const Fortran::semantics::Symbol &sym) = 0; + virtual void copyHostAssociateVar(const Fortran::semantics::Symbol &sym, + bool firstPrivate = false, + bool lastPrivate = false) = 0; //===--------------------------------------------------------------------===// // Expressions diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index b9617484eb8a30..f537ac1cea4d59 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -467,8 +467,9 @@ class FirConverter : public Fortran::lower::AbstractConverter { return bindIfNewSymbol(sym, exv); } - void - copyHostAssociateVar(const Fortran::semantics::Symbol &sym) override final { + void copyHostAssociateVar(const Fortran::semantics::Symbol &sym, + bool firstPrivate, + bool lastPrivate) override final { // 1) Fetch the original copy of the variable. assert(sym.has() && "No host-association found"); @@ -477,25 +478,47 @@ class FirConverter : public Fortran::lower::AbstractConverter { fir::ExtendedValue hexv = getExtendedValue(hsb); // 2) Create a copy that will mask the original. - createHostAssociateVarClone(sym); + // Make sure you do not create multiple clones when a variable is + // both firstPrivate and lastPrivate, as in that case, a clone will + // already be created for you during the function call with firstPrivate. + if (!(firstPrivate && lastPrivate)) { + createHostAssociateVarClone(sym); + } + Fortran::lower::SymbolBox sb = lookupSymbol(sym); fir::ExtendedValue exv = getExtendedValue(sb); + if (lastPrivate) { + // Copy back to the original value right before exiting the block. + builder->setInsertionPoint( + getSymbolAddress(sym).getParentBlock()->getTerminator()); + } + + fir::ExtendedValue lhs, rhs; + + if (lastPrivate) { + lhs = hexv; + rhs = exv; + } else { + lhs = exv; + rhs = hexv; + } + // 3) Perform the assignment. 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, exv, hexv, localSymbols, + Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols, stmtCtx); stmtCtx.finalize(); } else if (hexv.getBoxOf()) { - fir::factory::CharacterExprHelper{*builder, loc}.createAssign(exv, hexv); + 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(hexv)); - builder->create(loc, loadVal, fir::getBase(exv)); + auto loadVal = builder->create(loc, fir::getBase(rhs)); + builder->create(loc, loadVal, fir::getBase(lhs)); } } diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp index 3cb4ad530b3606..8ec05690c0b27d 100644 --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -52,8 +52,13 @@ static void createPrivateVarSyms(Fortran::lower::AbstractConverter &converter, // variables) happen separately, for everything else privatize here. if (sym->test(Fortran::semantics::Symbol::Flag::OmpPreDetermined)) continue; + bool firstPrivate = false; if constexpr (std::is_same_v) { - converter.copyHostAssociateVar(*sym); + firstPrivate = true; + converter.copyHostAssociateVar(*sym, firstPrivate, /*lastPrivate*/ false); + } + if constexpr (std::is_same_v) { + converter.copyHostAssociateVar(*sym, firstPrivate, /*lastPrivate*/ true); } else { bool success = converter.createHostAssociateVarClone(*sym); (void)success; @@ -75,6 +80,10 @@ static void privatizeVars(Fortran::lower::AbstractConverter &converter, std::get_if( &clause.u)) { createPrivateVarSyms(converter, firstPrivateClause); + } else if (const auto &lastPrivateClause = + std::get_if( + &clause.u)) { + createPrivateVarSyms(converter, lastPrivateClause); } } firOpBuilder.restoreInsertionPoint(insPt); @@ -714,6 +723,7 @@ static void genOMP(Fortran::lower::AbstractConverter &converter, createBodyOfOp(wsLoopOp, converter, currentLocation, eval, &wsLoopOpClauseList, iv); + } static void diff --git a/flang/test/Lower/OpenMP/omp-parallel-lastprivate-clause-scalar.f90 b/flang/test/Lower/OpenMP/omp-parallel-lastprivate-clause-scalar.f90 new file mode 100644 index 00000000000000..c891c0cc43368e --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-lastprivate-clause-scalar.f90 @@ -0,0 +1,68 @@ +! This test checks lowering of `FIRSTPRIVATE` clause for scalar types. + +! RUN: bbc -fopenmp -emit-fir %s -o - | FileCheck %s --check-prefix=FIRDialect + +!FIRDialect: func @_QPlastprivate_character(%[[ARG1:.*]]: !fir.boxchar<1>{{.*}}) { +!FIRDialect-DAG: %[[ARG1_UNBOX:.*]]:2 = fir.unboxchar +!FIRDialect: omp.parallel { +!FIRDialect-DAG: %[[ARG1_PVT:.*]] = fir.alloca !fir.char<1,5> {bindc_name = "arg1", +! Check that we are accessing the clone inside the loop +!FIRDialect-DAG: %[[ARG1_PVT_REF:.*]] = fir.convert %[[ARG1_PVT]] : (!fir.ref>) -> !fir.ref + +! Check we are copying back the last iterated value back to the clone before exiting +!FIRDialect-DAG: %[[LOCAL_VAR:.*]] = fir.alloca i32 {adapt.valuebyref, pinned} +!FIRDialect-DAG: omp.wsloop (%[[INDX_WS:.*]]) : {{.*}} { +!FIRDialect-DAG: fir.store %[[INDX_WS]] to %[[LOCAL_VAR]] : !fir.ref +!FIRDialect-DAG: %[[ADDR:.*]] = fir.address_of(@_QQcl.63) : !fir.ref> + +! Testing string copy +!FIRDialect-DAG: %[[CVT:.*]] = fir.convert %[[ARG1_UNBOX]]#0 : (!fir.ref>) -> !fir.ref +!FIRDialect-DAG: %[[CVT1:.*]] = fir.convert %[[ARG1_PVT]] : (!fir.ref>) -> !fir.ref +!FIRDialect-DAG: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[CVT]], %[[CVT1]]{{.*}}) + +!FIRDialect: %[[THIRTY_TWO:.*]] = arith.constant 32 : i8 +!FIRDialect-DAG: %[[UNDEF:.*]] = fir.undefined !fir.char<1> +!FIRDialect-DAG: %[[INSERT:.*]] = fir.insert_value %[[UNDEF]], %[[THIRTY_TWO]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> +!FIRDialect-DAG: %[[ONE_3:.*]] = arith.constant 1 : index + +!FIRDialect: fir.do_loop %[[INDX_WS]] = {{.*}} { +!FIRDialect-DAG: %[[CVT_2:.*]] = fir.convert %[[ARG1_UNBOX]]#0 : (!fir.ref>) -> !fir.ref>> +!FIRDialect-DAG: %[[COORD:.*]] = fir.coordinate_of %[[CVT_2]], %[[INDX_WS]] : (!fir.ref>>, index) -> !fir.ref> +!FIRDialect-DAG: fir.store %[[INSERT]] to %[[COORD]] : !fir.ref> +!FIRDialect-DAG: } + + +subroutine lastprivate_character(arg1) + character(5) :: arg1 + +!$OMP PARALLEL +!$OMP DO LASTPRIVATE(arg1) +do n = 1, 5 + arg1(n:n) = 'c' + print *, arg1 +end do +!$OMP END DO +!$OMP END PARALLEL + +end subroutine + +!FIRDialect: func @_QPlastprivate_int(%[[ARG1:.*]]: !fir.ref {fir.bindc_name = "arg1"}) { +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: %[[CLONE:.*]] = fir.alloca i32 {bindc_name = "arg1" +!FIRDialect: omp.yield +!FIRDialect: %[[CLONE_LD:.*]] = fir.load %[[CLONE]] : !fir.ref +!FIRDialect-DAG: fir.store %[[CLONE_LD]] to %[[ARG1]] : !fir.ref +!FIRDialect-DAG: omp.terminator + +subroutine lastprivate_int(arg1) + integer :: arg1 +!$OMP PARALLEL +!$OMP DO LASTPRIVATE(arg1) +do n = 1, 5 + arg1 = 2 + print *, arg1 +end do +!$OMP END DO +!$OMP END PARALLEL +print *, arg1 +end subroutine