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,15 @@ virtual bool createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0; + virtual fir::ExtendedValue + fetchOriginalSymbol(const Fortran::semantics::Symbol &sym) = 0; + virtual fir::ExtendedValue + fetchCopiedSymbol(const Fortran::semantics::Symbol &sym) = 0; + virtual fir::ExtendedValue + copyOriginalSymbol(const Fortran::semantics::Symbol &sym) = 0; + virtual void performAssignment(const Fortran::semantics::Symbol &sym, + fir::ExtendedValue hexv, + fir::ExtendedValue exv) = 0; virtual void copyHostAssociateVar(const Fortran::semantics::Symbol &sym) = 0; /// Collect the set of ultimate symbols of symbols with \p flag in \p eval 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 @@ -475,24 +475,45 @@ return bindIfNewSymbol(sym, exv); } - void - copyHostAssociateVar(const Fortran::semantics::Symbol &sym) override final { - // 1) Fetch the original copy of the variable. + fir::ExtendedValue + fetchOriginalSymbol(const Fortran::semantics::Symbol &sym) override final { + // Fetch the original copy of the variable. assert(sym.has() && "No host-association found"); 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); + return hexv; + } - // 2) Fetch the copied one that will mask the original. + fir::ExtendedValue + fetchCopiedSymbol(const Fortran::semantics::Symbol &sym) override final { + // Fetch the copied symbol that will mask the original symbol + const Fortran::semantics::Symbol &hsym = sym.GetUltimate(); + Fortran::lower::SymbolBox hsb = lookupOneLevelUpSymbol(hsym); 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); + return exv; + } + + fir::ExtendedValue + copyOriginalSymbol(const Fortran::semantics::Symbol &sym) override final { + // Create a copied symbol that will mask the original. + createHostAssociateVarClone(sym); + Fortran::lower::SymbolBox sb = lookupSymbol(sym); + fir::ExtendedValue exv = getExtendedValue(sb); + return exv; + } - // 3) Perform the assignment. + void performAssignment(const Fortran::semantics::Symbol &sym, + fir::ExtendedValue hexv, + fir::ExtendedValue exv) override final { + // Perform the assignment. Create a load operation for `hexv` and store the + // loaded value into `exv` builder->setInsertionPointAfter(fir::getBase(exv).getDefiningOp()); mlir::Location loc = getCurrentLocation(); mlir::Type symType = genType(sym); @@ -511,6 +532,13 @@ } } + void + copyHostAssociateVar(const Fortran::semantics::Symbol &sym) override final { + fir::ExtendedValue hexv = fetchOriginalSymbol(sym); + fir::ExtendedValue exv = fetchCopiedSymbol(sym); + performAssignment(sym, hexv, exv); + } + //===--------------------------------------------------------------------===// // Utility methods //===--------------------------------------------------------------------===// 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 @@ -78,24 +78,91 @@ } } +static void genDefaultClause( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OmpDefaultClause::Type &ompDefaultClauseType) { + llvm::SetVector symbols; + if (ompDefaultClauseType == Fortran::parser::OmpDefaultClause::Type::Private) + converter.collectSymbolSet( + eval, symbols, Fortran::semantics::Symbol::Flag::OmpPrivate, false); + else if (ompDefaultClauseType == + Fortran::parser::OmpDefaultClause::Type::Firstprivate) + converter.collectSymbolSet( + eval, symbols, Fortran::semantics::Symbol::Flag::OmpFirstPrivate, + false); + else + return; + for (const Fortran::semantics::Symbol *sym : symbols) { + // Privatization for symbols which are pre-determined (like loop index + // variables) happen separately, for everything else privatize here. + if (sym->test(Fortran::semantics::Symbol::Flag::OmpPreDetermined)) + continue; + if (ompDefaultClauseType == + Fortran::parser::OmpDefaultClause::Type::Private) { + bool success = converter.createHostAssociateVarClone(*sym); + (void)success; + assert(success && "Privatization failed due to existing binding"); + } else if (ompDefaultClauseType == + Fortran::parser::OmpDefaultClause::Type::Firstprivate) { + fir::ExtendedValue hexv = converter.fetchOriginalSymbol(*sym); + // Create a copy that will mask the original symbol + fir::ExtendedValue exv = converter.copyOriginalSymbol(*sym); + converter.performAssignment(*sym, hexv, exv); + // converter.copyHostAssociateVar(*sym); + } + } +} + static void privatizeVars(Fortran::lower::AbstractConverter &converter, - const Fortran::parser::OmpClauseList &opClauseList) { + const Fortran::parser::OmpClauseList &opClauseList, + Fortran::lower::pft::Evaluation &eval) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + Fortran::parser::OmpDefaultClause::Type ompDefaultClauseType = + Fortran::parser::OmpDefaultClause::Type::Shared; auto insPt = firOpBuilder.saveInsertionPoint(); firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock()); bool hasFirstPrivateOp = false; + for (const Fortran::parser::OmpClause &clause : opClauseList.v) { + if (const auto &defaultClause = + std::get_if(&clause.u)) { + const auto &ompDefaultClause{defaultClause->v}; + ompDefaultClauseType = ompDefaultClause.v; + } + } + for (const Fortran::parser::OmpClause &clause : opClauseList.v) { if (const auto &privateClause = std::get_if(&clause.u)) { - createPrivateVarSyms(converter, privateClause); + if (ompDefaultClauseType != + Fortran::parser::OmpDefaultClause::Type:: + Private) // if default clause is 'private', symbols with + // OmpPrivate flag shall be dealt with while dealing with + // default clause; hence skip privatization here. + createPrivateVarSyms(converter, privateClause); } else if (const auto &firstPrivateClause = std::get_if( &clause.u)) { - createPrivateVarSyms(converter, firstPrivateClause); + if (ompDefaultClauseType != + Fortran::parser::OmpDefaultClause::Type:: + Firstprivate) // if default clause is 'firstprivate', symbols with + // OmpFirstPrivate flag shall be dealt with while + // dealing with default clause; hence skip + // privatization here + createPrivateVarSyms(converter, firstPrivateClause); hasFirstPrivateOp = true; } } - if (hasFirstPrivateOp) + genDefaultClause(converter, eval, ompDefaultClauseType); + + if (hasFirstPrivateOp || + (!hasFirstPrivateOp && + ompDefaultClauseType == + Fortran::parser::OmpDefaultClause::Type::Firstprivate)) + // If a separate `firstprivate()` clause is detected, insert a + // `omp.barrier`. If a separate `firstprivate()` clause is absent but + // default-clause is + // firstprivate, insert a `omp.barrier` nevertheless firOpBuilder.create(converter.getCurrentLocation()); firOpBuilder.restoreInsertionPoint(insPt); } @@ -376,7 +443,7 @@ // Handle privatization. Do not privatize if this is the outer operation. if (clauses && !outerCombined) - privatizeVars(converter, *clauses); + privatizeVars(converter, *clauses, eval); if (std::is_same_v) { threadPrivatizeVars(converter, eval); @@ -614,6 +681,10 @@ } else if (std::get_if(&clause.u)) { // Nothing needs to be done for threads clause. continue; + } else if (std::get_if(&clause.u)) { + continue; + } else if (std::get_if(&clause.u)) { + continue; } else if (const auto &finalClause = std::get_if(&clause.u)) { mlir::Value finalVal = fir::getBase(converter.genExprValue( diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -1490,6 +1490,21 @@ } } } + if (GetContext().defaultDSA == semantics::Symbol::Flag::OmpPrivate && + !HasDataSharingAttributeObject(*name.symbol)) { + name.symbol = DeclarePrivateAccessEntity( + *name.symbol, semantics::Symbol::Flag::OmpPrivate, currScope()); + AddToContextObjectWithDSA( + *name.symbol, semantics::Symbol::Flag::OmpPrivate); + } else if (GetContext().defaultDSA == + semantics::Symbol::Flag::OmpFirstPrivate && + !HasDataSharingAttributeObject(*name.symbol)) { + name.symbol = DeclarePrivateAccessEntity( + *name.symbol, semantics::Symbol::Flag::OmpFirstPrivate, currScope()); + AddToContextObjectWithDSA( + *name.symbol, semantics::Symbol::Flag::OmpPrivate); + } + } // within OpenMP construct } @@ -1590,6 +1605,8 @@ CheckMultipleAppearances(*name, *symbol, ompFlag); } if (privateDataSharingAttributeFlags.test(ompFlag)) { + AddDataSharingAttributeObject( + common::Reference(*symbol)); CheckObjectInNamelist(*name, *symbol, ompFlag); } diff --git a/flang/test/Lower/OpenMP/default-clause.f90 b/flang/test/Lower/OpenMP/default-clause.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/default-clause.f90 @@ -0,0 +1,102 @@ +! This test checks lowering of OpenMP parallel directive +! with `DEFAULT` clause present. + +! RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s +! RUN: bbc -fopenmp -emit-fir %s -o - | FileCheck %s + + +!CHECK: func @_QQmain() { +!CHECK: %[[W:.*]] = fir.alloca i32 {bindc_name = "w", uniq_name = "_QFEw"} +!CHECK: %[[X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFEx"} +!CHECK: %[[Y:.*]] = fir.alloca i32 {bindc_name = "y", uniq_name = "_QFEy"} +!CHECK: %[[Z:.*]] = fir.alloca i32 {bindc_name = "z", uniq_name = "_QFEz"} +!CHECK: omp.parallel { +!CHECK: %[[PRIVATE_X:.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "_QFEx"} +!CHECK: %{{.*}} = fir.load %[[X]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[PRIVATE_X]] : !fir.ref +!CHECK: %[[PRIVATE_Y:.*]] = fir.alloca i32 {bindc_name = "y", pinned, uniq_name = "_QFEy"} +!CHECK: %[[PRIVATE_W:.*]] = fir.alloca i32 {bindc_name = "w", pinned, uniq_name = "_QFEw"} +!CHECK: omp.barrier +!CHECK: %{{.*}} = arith.constant 2 : i32 +!CHECK: %{{.*}} = fir.load %[[PRIVATE_Y]] : !fir.ref +!CHECK: %{{.*}} = arith.muli %{{.*}}, %{{.*}} : i32 +!CHECK: fir.store %{{.*}} to %[[PRIVATE_X]] : !fir.ref +!CHECK: %{{.*}} = fir.load %[[PRIVATE_W]] : !fir.ref +!CHECK: %{{.*}} = arith.constant 45 : i32 +!CHECK: %{{.*}} = arith.addi %{{.*}}, %{{.*}} : i32 +!CHECK: fir.store %{{.*}} to %[[Z]] : !fir.ref +!CHECK: omp.terminator +!CHECK: } + +program default_clause_lowering + integer :: x, y, z, w + + !$omp parallel default(private) firstprivate(x) shared(z) + x = y * 2 + z = w + 45 + !$omp end parallel + +!CHECK: omp.parallel { +!CHECK: %{{.*}} = fir.load %[[Y]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[X]] : !fir.ref +!CHECK: omp.terminator +!CHECK: } + + !$omp parallel default(shared) + x = y + !$omp end parallel + +!CHECK: omp.parallel { +!CHECK: %[[PRIVATE_X:.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "_QFEx"} +!CHECK: %[[PRIVATE_Y:.*]] = fir.alloca i32 {bindc_name = "y", pinned, uniq_name = "_QFEy"} +!CHECK: %{{.*}} = fir.load %[[PRIVATE_Y]] : !fir.ref +!CHECK: fir.store {{.*}} to %[[PRIVATE_X]] : !fir.ref +!CHECK: omp.terminator +!CHECK: } + + !$omp parallel default(none) private(x, y) + x = y + !$omp end parallel + +!CHECK: omp.parallel { +!CHECK: %[[PRIVATE_Y:.*]] = fir.alloca i32 {bindc_name = "y", pinned, uniq_name = "_QFEy"} +!CHECK: %{{.*}} = fir.load %[[Y]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[PRIVATE_Y]] : !fir.ref +!CHECK: %[[PRIVATE_X:.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "_QFEx"} +!CHECK: %{{.*}} = fir.load %[[X]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[PRIVATE_X]] : !fir.ref +!CHECK: omp.barrier +!CHECK: %{{.*}} = fir.load %[[PRIVATE_Y]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[PRIVATE_X]] : !fir.ref +!CHECK: omp.terminator +!CHECK: } + + !$omp parallel default(firstprivate) firstprivate(y) + x = y + !$omp end parallel + +!CHECK: omp.parallel { +!CHECK: %[[PRIVATE_X:.*]] = fir.alloca i32 {bindc_name = "x", pinned, uniq_name = "_QFEx"} +!CHECK: %[[PRIVATE_Y:.*]] = fir.alloca i32 {bindc_name = "y", pinned, uniq_name = "_QFEy"} +!CHECK: %{{.*}} = fir.load %[[Y]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[PRIVATE_Y]] : !fir.ref +!CHECK: %[[PRIVATE_W:.*]] = fir.alloca i32 {bindc_name = "w", pinned, uniq_name = "_QFEw"} +!CHECK: %{{.*}} = fir.load %[[W]] : !fir.ref +!CHECK: fir.store %{{.*}} to %[[PRIVATE_W]] : !fir.ref +!CHECK: omp.barrier +!CHECK: %{{.*}} = arith.constant 2 : i32 +!CHECK: %{{.*}} = fir.load %[[PRIVATE_Y]] : !fir.ref +!CHECK: %{{.*}} = arith.muli %{{.*}}, %{{.*}} : i32 +!CHECK: fir.store %{{.*}} to %[[PRIVATE_X]] : !fir.ref +!CHECK: %{{.*}} = fir.load %[[PRIVATE_W]] : !fir.ref +!CHECK: %{{.*}} = arith.constant 45 : i32 +!CHECK: %{{.*}} = arith.addi %{{.*}}, %{{.*}} : i32 +!CHECK: fir.store %{{.*}} to %[[Z]] : !fir.ref +!CHECK: omp.terminator +!CHECK: } + + !$omp parallel default(firstprivate) private(x) shared(z) + x = y * 2 + z = w + 45 + !$omp end parallel +end program default_clause_lowering diff --git a/flang/test/Semantics/OpenMP/omp-default-clause.f90 b/flang/test/Semantics/OpenMP/omp-default-clause.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/OpenMP/omp-default-clause.f90 @@ -0,0 +1,48 @@ +! This test checks symbols in an OpenMP block that has a `default` +! data-sharing clause defined. + +!RUN: %python %S/../test_symbols.py %s %flang_fc1 -fopenmp + +!DEF: /default_clause_lowering MainProgram +program default_clause_lowering + !DEF: /default_clause_lowering/x ObjectEntity INTEGER(4) + !DEF: /default_clause_lowering/y ObjectEntity INTEGER(4) + !DEF: /default_clause_lowering/z ObjectEntity INTEGER(4) + !DEF: /default_clause_lowering/w ObjectEntity INTEGER(4) + integer x, y, z, w + !$omp parallel default(private) firstprivate(x) shared(z) + !DEF: /default_clause_lowering/Block1/x (OmpFirstPrivate) HostAssoc INTEGER(4) + !DEF: /default_clause_lowering/Block1/y (OmpPrivate) HostAssoc INTEGER(4) + x = y * 2 + !REF: /default_clause_lowering/z + !DEF: /default_clause_lowering/Block1/w (OmpPrivate) HostAssoc INTEGER(4) + z = w + 45 + !$omp end parallel + + !$omp parallel default(shared) + !REF: /default_clause_lowering/x + !REF: /default_clause_lowering/y + x = y + !$omp end parallel + + !$omp parallel default(none) private(x, y) + !DEF: /default_clause_lowering/Block3/x (OmpPrivate) HostAssoc INTEGER(4) + !DEF: /default_clause_lowering/Block3/y (OmpPrivate) HostAssoc INTEGER(4) + x = y + !$omp end parallel + + !$omp parallel default(firstprivate) firstprivate(y) + !DEF: /default_clause_lowering/Block4/x (OmpFirstPrivate) HostAssoc INTEGER(4) + !DEF: /default_clause_lowering/Block4/y (OmpFirstPrivate) HostAssoc INTEGER(4) + x = y + !$omp end parallel + + !$omp parallel default(firstprivate) private(x) shared(z) + !DEF: /default_clause_lowering/Block5/x (OmpPrivate) HostAssoc INTEGER(4) + !DEF: /default_clause_lowering/Block5/y (OmpFirstPrivate) HostAssoc INTEGER(4) + x = y * 2 + !REF: /default_clause_lowering/z + !DEF: /default_clause_lowering/Block5/w (OmpFirstPrivate) HostAssoc INTEGER(4) + z = w + 45 + !$omp end parallel +end program default_clause_lowering