diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 7187e1128ad04..3b3603376bf4a 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -92,6 +92,13 @@ class AbstractConverter { /// Get the code defined by a label virtual pft::Evaluation *lookupLabel(pft::Label label) = 0; + /// For a given symbol which is host-associated, create a clone using + /// parameters from the host-associated symbol. + virtual bool + createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0; + + virtual void copyHostAssociateVar(const Fortran::semantics::Symbol &sym) = 0; + //===--------------------------------------------------------------------===// // Expressions //===--------------------------------------------------------------------===// diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 8184030772591..bc14e6b74da51 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -368,6 +368,95 @@ class FirConverter : public Fortran::lower::AbstractConverter { llvm::None); } + bool createHostAssociateVarClone( + const Fortran::semantics::Symbol &sym) override final { + mlir::Location loc = genLocation(sym.name()); + mlir::Type symType = genType(sym); + const auto *details = sym.detailsIf(); + assert(details && "No host-association found"); + const Fortran::semantics::Symbol &hsym = details->symbol(); + 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()), + /*pinned=*/true, shape, typeParams, + sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET)); + return allocVal; + }; + + fir::ExtendedValue hexv = getExtendedValue(hsb); + fir::ExtendedValue exv = hexv.match( + [&](const fir::BoxValue &box) -> fir::ExtendedValue { + const Fortran::semantics::DeclTypeSpec *type = sym.GetType(); + if (type && type->IsPolymorphic()) + TODO(loc, "create polymorphic host associated copy"); + // Create a contiguous temp with the same shape and length as + // the original variable described by a fir.box. + llvm::SmallVector extents = + fir::factory::getExtents(*builder, loc, hexv); + if (box.isDerivedWithLengthParameters()) + TODO(loc, "get length parameters from derived type BoxValue"); + if (box.isCharacter()) { + mlir::Value len = fir::factory::readCharLen(*builder, loc, box); + mlir::Value temp = allocate(extents, {len}); + return fir::CharArrayBoxValue{temp, len, extents}; + } + return fir::ArrayBoxValue{allocate(extents, {}), extents}; + }, + [&](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(), {}); + }, + [&](const auto &) -> fir::ExtendedValue { + mlir::Value temp = + allocate(fir::factory::getExtents(*builder, loc, hexv), + fir::getTypeParams(hexv)); + return fir::substBase(hexv, temp); + }); + + return bindIfNewSymbol(sym, exv); + } + + void + copyHostAssociateVar(const Fortran::semantics::Symbol &sym) override final { + // 1) 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 = lookupSymbol(hsym); + fir::ExtendedValue hexv = getExtendedValue(hsb); + + // 2) Create a copy that will mask the original. + createHostAssociateVarClone(sym); + Fortran::lower::SymbolBox sb = lookupSymbol(sym); + fir::ExtendedValue exv = getExtendedValue(sb); + + // 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, + stmtCtx); + stmtCtx.finalize(); + } else if (hexv.getBoxOf()) { + fir::factory::CharacterExprHelper{*builder, loc}.createAssign(exv, hexv); + } 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)); + } + } + + //===--------------------------------------------------------------------===// + // Utility methods + //===--------------------------------------------------------------------===// + mlir::Location getCurrentLocation() override final { return toLocation(); } /// Generate a dummy location. diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp index ac868755a0d56..5a80e733c6e18 100644 --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -31,29 +31,90 @@ getDesignatorNameIfDataRef(const Fortran::parser::Designator &designator) { return dataRef ? std::get_if(&dataRef->u) : nullptr; } -static void genObjectList(const Fortran::parser::OmpObjectList &objectList, - Fortran::lower::AbstractConverter &converter, - SmallVectorImpl &operands) { - for (const auto &ompObject : objectList.v) { +template +static void createPrivateVarSyms(Fortran::lower::AbstractConverter &converter, + const T *clause) { + Fortran::semantics::Symbol *sym = nullptr; + const Fortran::parser::OmpObjectList &ompObjectList = clause->v; + for (const Fortran::parser::OmpObject &ompObject : ompObjectList.v) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::Designator &designator) { - if (const auto *name = getDesignatorNameIfDataRef(designator)) { - const auto variable = converter.getSymbolAddress(*name->symbol); - operands.push_back(variable); + if (const Fortran::parser::Name *name = + getDesignatorNameIfDataRef(designator)) { + sym = name->symbol; } }, - [&](const Fortran::parser::Name &name) { - const auto variable = converter.getSymbolAddress(*name.symbol); - operands.push_back(variable); - }}, + [&](const Fortran::parser::Name &name) { sym = name.symbol; }}, ompObject.u); + + // Privatization for symbols which are pre-determined (like loop index + // variables) happen separately, for everything else privatize here + if constexpr (std::is_same_v) { + converter.copyHostAssociateVar(*sym); + } else { + bool success = converter.createHostAssociateVarClone(*sym); + (void)success; + assert(success && "Privatization failed due to existing binding"); + } + } +} + +static void privatizeVars(Fortran::lower::AbstractConverter &converter, + const Fortran::parser::OmpClauseList &opClauseList) { + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + auto insPt = firOpBuilder.saveInsertionPoint(); + firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock()); + for (const Fortran::parser::OmpClause &clause : opClauseList.v) { + if (const auto &privateClause = + std::get_if(&clause.u)) { + createPrivateVarSyms(converter, privateClause); + } else if (const auto &firstPrivateClause = + std::get_if( + &clause.u)) { + createPrivateVarSyms(converter, firstPrivateClause); + } + } + firOpBuilder.restoreInsertionPoint(insPt); +} + +static void genObjectList(const Fortran::parser::OmpObjectList &objectList, + Fortran::lower::AbstractConverter &converter, + llvm::SmallVectorImpl &operands) { + auto addOperands = [&](Fortran::lower::SymbolRef sym) { + const mlir::Value variable = converter.getSymbolAddress(sym); + if (variable) { + operands.push_back(variable); + } else { + if (const auto *details = + sym->detailsIf()) { + operands.push_back(converter.getSymbolAddress(details->symbol())); + converter.copySymbolBinding(details->symbol(), sym); + } + } + }; + for (const Fortran::parser::OmpObject &ompObject : objectList.v) { + std::visit(Fortran::common::visitors{ + [&](const Fortran::parser::Designator &designator) { + if (const Fortran::parser::Name *name = + getDesignatorNameIfDataRef(designator)) { + addOperands(*name->symbol); + } + }, + [&](const Fortran::parser::Name &name) { + addOperands(*name.symbol); + }}, + ompObject.u); } } template -static void createBodyOfOp(Op &op, fir::FirOpBuilder &firOpBuilder, - mlir::Location &loc) { +static void +createBodyOfOp(Op &op, Fortran::lower::AbstractConverter &converter, + mlir::Location &loc, + const Fortran::parser::OmpClauseList *clauses = nullptr, + bool outerCombined = false) { + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); firOpBuilder.createBlock(&op.getRegion()); auto &block = op.getRegion().back(); firOpBuilder.setInsertionPointToStart(&block); @@ -61,6 +122,9 @@ static void createBodyOfOp(Op &op, fir::FirOpBuilder &firOpBuilder, firOpBuilder.create(loc); // Reset the insertion point to the start of the first block. firOpBuilder.setInsertionPointToStart(&block); + // Handle privatization. Do not privatize if this is the outer operation. + if (clauses && !outerCombined) + privatizeVars(converter, *clauses); } static void genOMP(Fortran::lower::AbstractConverter &converter, @@ -174,9 +238,9 @@ genOMP(Fortran::lower::AbstractConverter &converter, std::get(beginBlockDirective.t); const auto &endBlockDirective = std::get(blockConstruct.t); + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); - auto &firOpBuilder = converter.getFirOpBuilder(); - auto currentLocation = converter.getCurrentLocation(); Fortran::lower::StatementContext stmtCtx; llvm::ArrayRef argTy; mlir::Value ifClauseOperand, numThreadsClauseOperand; @@ -184,8 +248,9 @@ genOMP(Fortran::lower::AbstractConverter &converter, SmallVector allocateOperands, allocatorOperands; mlir::UnitAttr nowaitAttr; - for (const auto &clause : - std::get(beginBlockDirective.t).v) { + const auto &opClauseList = + std::get(beginBlockDirective.t); + for (const auto &clause : opClauseList.v) { if (const auto &ifClause = std::get_if(&clause.u)) { auto &expr = std::get(ifClause->v.t); @@ -222,9 +287,11 @@ genOMP(Fortran::lower::AbstractConverter &converter, &clause.u)) { genAllocateClause(converter, allocateClause->v, allocatorOperands, allocateOperands); - } else if (std::get_if(&clause.u)) { - // TODO: Handle private. This cannot be a hard TODO because testing for - // allocate clause requires private variables. + } else if (std::get_if(&clause.u) || + std::get_if( + &clause.u)) { + // Privatisation clauses are handled elsewhere. + continue; } else { TODO(currentLocation, "OpenMP Block construct clauses"); } @@ -242,15 +309,18 @@ genOMP(Fortran::lower::AbstractConverter &converter, currentLocation, argTy, ifClauseOperand, numThreadsClauseOperand, allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(), /*reductions=*/nullptr, procBindKindAttr); - createBodyOfOp(parallelOp, firOpBuilder, currentLocation); + createBodyOfOp(parallelOp, converter, currentLocation, + &opClauseList, /*isCombined=*/false); } else if (blockDirective.v == llvm::omp::OMPD_master) { auto masterOp = firOpBuilder.create(currentLocation, argTy); - createBodyOfOp(masterOp, firOpBuilder, currentLocation); + createBodyOfOp(masterOp, converter, currentLocation); } else if (blockDirective.v == llvm::omp::OMPD_single) { auto singleOp = firOpBuilder.create( currentLocation, allocateOperands, allocatorOperands, nowaitAttr); - createBodyOfOp(singleOp, firOpBuilder, currentLocation); + createBodyOfOp(singleOp, converter, currentLocation); + } else { + TODO(converter.getCurrentLocation(), "Unhandled block directive"); } } @@ -294,7 +364,7 @@ genOMP(Fortran::lower::AbstractConverter &converter, firOpBuilder.getContext(), global.sym_name())); } }(); - createBodyOfOp(criticalOp, firOpBuilder, currentLocation); + createBodyOfOp(criticalOp, converter, currentLocation); } static void @@ -306,7 +376,7 @@ genOMP(Fortran::lower::AbstractConverter &converter, auto currentLocation = converter.getCurrentLocation(); mlir::omp::SectionOp sectionOp = firOpBuilder.create(currentLocation); - createBodyOfOp(sectionOp, firOpBuilder, currentLocation); + createBodyOfOp(sectionOp, converter, currentLocation); } // TODO: Add support for reduction @@ -359,19 +429,19 @@ genOMP(Fortran::lower::AbstractConverter &converter, currentLocation, /*if_expr_var*/ nullptr, /*num_threads_var*/ nullptr, allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(), /*reductions=*/nullptr, /*proc_bind_val*/ nullptr); - createBodyOfOp(parallelOp, firOpBuilder, currentLocation); + createBodyOfOp(parallelOp, converter, currentLocation); auto sectionsOp = firOpBuilder.create( currentLocation, /*reduction_vars*/ ValueRange(), /*reductions=*/nullptr, /*allocate_vars*/ ValueRange(), /*allocators_vars*/ ValueRange(), /*nowait=*/nullptr); - createBodyOfOp(sectionsOp, firOpBuilder, currentLocation); + createBodyOfOp(sectionsOp, converter, currentLocation); // Sections Construct } else if (dir == llvm::omp::Directive::OMPD_sections) { auto sectionsOp = firOpBuilder.create( currentLocation, reductionVars, /*reductions = */ nullptr, allocateOperands, allocatorOperands, noWaitClauseOperand); - createBodyOfOp(sectionsOp, firOpBuilder, currentLocation); + createBodyOfOp(sectionsOp, converter, currentLocation); } } diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp index 83fe892d68e25..52760be28194d 100644 --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -196,10 +196,9 @@ mlir::Value fir::FirOpBuilder::allocateLocal( /// Get the block for adding Allocas. mlir::Block *fir::FirOpBuilder::getAllocaBlock() { - // auto iface = - // getRegion().getParentOfType(); - // return iface ? iface.getAllocaBlock() : getEntryBlock(); - return getEntryBlock(); + auto iface = + getRegion().getParentOfType(); + return iface ? iface.getAllocaBlock() : getEntryBlock(); } /// Create a temporary variable on the stack. Anonymous temporaries have no diff --git a/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause-scalar.f90 b/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause-scalar.f90 new file mode 100644 index 0000000000000..06be9e5e0501c --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-firstprivate-clause-scalar.f90 @@ -0,0 +1,186 @@ +! This test checks lowering of `FIRSTPRIVATE` clause for scalar types. + +! REQUIRES: shell +! RUN: bbc -fopenmp -emit-fir %s -o - | FileCheck %s --check-prefix=FIRDialect + +!FIRDialect: func @_QPfirstprivate_complex(%[[ARG1:.*]]: !fir.ref>{{.*}}, %[[ARG2:.*]]: !fir.ref>{{.*}}) { +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: %[[ARG1_PVT:.*]] = fir.alloca !fir.complex<4> {bindc_name = "arg1", pinned, uniq_name = "_QFfirstprivate_complexEarg1"} +!FIRDialect-DAG: %[[ARG1_VAL:.*]] = fir.load %arg0 : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG1_VAL]] to %[[ARG1_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG2_PVT:.*]] = fir.alloca !fir.complex<8> {bindc_name = "arg2", pinned, uniq_name = "_QFfirstprivate_complexEarg2"} +!FIRDialect-DAG: %[[ARG2_VAL:.*]] = fir.load %[[ARG2]] : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG2_VAL]] to %[[ARG2_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[LIST_IO:.*]] = fir.call @_FortranAioBeginExternalListOutput +!FIRDialect-DAG: %[[ARG1_PVT_VAL:.*]] = fir.load %[[ARG1_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG1_PVT_REAL:.*]] = fir.extract_value %[[ARG1_PVT_VAL]], [0 : index] : (!fir.complex<4>) -> f32 +!FIRDialect-DAG: %[[ARG1_PVT_IMAG:.*]] = fir.extract_value %[[ARG1_PVT_VAL]], [1 : index] : (!fir.complex<4>) -> f32 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputComplex32(%[[LIST_IO]], %[[ARG1_PVT_REAL]], %[[ARG1_PVT_IMAG]]) : (!fir.ref, f32, f32) -> i1 +!FIRDialect-DAG: %[[ARG2_PVT_VAL:.*]] = fir.load %[[ARG2_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG2_PVT_REAL:.*]] = fir.extract_value %[[ARG2_PVT_VAL]], [0 : index] : (!fir.complex<8>) -> f64 +!FIRDialect-DAG: %[[ARG2_PVT_IMAG:.*]] = fir.extract_value %[[ARG2_PVT_VAL]], [1 : index] : (!fir.complex<8>) -> f64 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputComplex64(%[[LIST_IO]], %[[ARG2_PVT_REAL]], %[[ARG2_PVT_IMAG]]) : (!fir.ref, f64, f64) -> i1 +!FIRDialect-DAG: omp.terminator +!FIRDialect-DAG: } + +subroutine firstprivate_complex(arg1, arg2) + complex(4) :: arg1 + complex(8) :: arg2 + +!$OMP PARALLEL FIRSTPRIVATE(arg1, arg2) + print *, arg1, arg2 +!$OMP END PARALLEL + +end subroutine + +!FIRDialect: func @_QPfirstprivate_integer(%[[ARG1:.*]]: !fir.ref{{.*}}, %[[ARG2:.*]]: !fir.ref{{.*}}, %[[ARG3:.*]]: !fir.ref{{.*}}, %[[ARG4:.*]]: !fir.ref{{.*}}, %[[ARG5:.*]]: !fir.ref{{.*}}, %[[ARG6:.*]]: !fir.ref{{.*}}) { +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: %[[ARG1_PVT:.*]] = fir.alloca i32 {bindc_name = "arg1", pinned, uniq_name = "_QFfirstprivate_integerEarg1"} +!FIRDialect-DAG: %[[ARG1_VAL:.*]] = fir.load %[[ARG1]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG1_VAL]] to %[[ARG1_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG2_PVT:.*]] = fir.alloca i8 {bindc_name = "arg2", pinned, uniq_name = "_QFfirstprivate_integerEarg2"} +!FIRDialect-DAG: %[[ARG2_VAL:.*]] = fir.load %[[ARG2]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG2_VAL]] to %[[ARG2_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG3_PVT:.*]] = fir.alloca i16 {bindc_name = "arg3", pinned, uniq_name = "_QFfirstprivate_integerEarg3"} +!FIRDialect-DAG: %[[ARG3_VAL:.*]] = fir.load %[[ARG3]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG3_VAL]] to %[[ARG3_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG4_PVT:.*]] = fir.alloca i32 {bindc_name = "arg4", pinned, uniq_name = "_QFfirstprivate_integerEarg4"} +!FIRDialect-DAG: %[[ARG4_VAL:.*]] = fir.load %[[ARG4]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG4_VAL]] to %[[ARG4_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG5_PVT:.*]] = fir.alloca i64 {bindc_name = "arg5", pinned, uniq_name = "_QFfirstprivate_integerEarg5"} +!FIRDialect-DAG: %[[ARG5_VAL:.*]] = fir.load %[[ARG5]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG5_VAL]] to %[[ARG5_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG6_PVT:.*]] = fir.alloca i128 {bindc_name = "arg6", pinned, uniq_name = "_QFfirstprivate_integerEarg6"} +!FIRDialect-DAG: %[[ARG6_VAL:.*]] = fir.load %[[ARG6]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG6_VAL]] to %[[ARG6_PVT]] : !fir.ref +!FIRDialect-DAG: %[[LIST_IO:.*]] = fir.call @_FortranAioBeginExternalListOutput +!FIRDialect-DAG: %[[ARG1_PVT_VAL:.*]] = fir.load %[[ARG1_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputInteger32(%[[LIST_IO]], %[[ARG1_PVT_VAL]]) : (!fir.ref, i32) -> i1 +!FIRDialect-DAG: %[[ARG2_PVT_VAL:.*]] = fir.load %[[ARG2_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputInteger8(%[[LIST_IO]], %[[ARG2_PVT_VAL]]) : (!fir.ref, i8) -> i1 +!FIRDialect-DAG: %[[ARG3_PVT_VAL:.*]] = fir.load %[[ARG3_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputInteger16(%[[LIST_IO]], %[[ARG3_PVT_VAL]]) : (!fir.ref, i16) -> i1 +!FIRDialect-DAG: %[[ARG4_PVT_VAL:.*]] = fir.load %[[ARG4_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputInteger32(%[[LIST_IO]], %[[ARG4_PVT_VAL]]) : (!fir.ref, i32) -> i1 +!FIRDialect-DAG: %[[ARG5_PVT_VAL:.*]] = fir.load %[[ARG5_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputInteger64(%[[LIST_IO]], %[[ARG5_PVT_VAL]]) : (!fir.ref, i64) -> i1 +!FIRDialect-DAG: %[[ARG6_PVT_VAL:.*]] = fir.load %[[ARG6_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputInteger128(%[[LIST_IO]], %[[ARG6_PVT_VAL]]) : (!fir.ref, i128) -> i1 +!FIRDialect-DAG: omp.terminator +!FIRDialect-DAG: } + +subroutine firstprivate_integer(arg1, arg2, arg3, arg4, arg5, arg6) + integer :: arg1 + integer(kind=1) :: arg2 + integer(kind=2) :: arg3 + integer(kind=4) :: arg4 + integer(kind=8) :: arg5 + integer(kind=16) :: arg6 + +!$OMP PARALLEL FIRSTPRIVATE(arg1, arg2, arg3, arg4, arg5, arg6) + print *, arg1, arg2, arg3, arg4, arg5, arg6 +!$OMP END PARALLEL + +end subroutine + +!FIRDialect: func @_QPfirstprivate_logical(%[[ARG1:.*]]: !fir.ref>{{.*}}, %[[ARG2:.*]]: !fir.ref>{{.*}}, %[[ARG3:.*]]: !fir.ref>{{.*}}, %[[ARG4:.*]]: !fir.ref>{{.*}}, %[[ARG5:.*]]: !fir.ref>{{.*}}) { +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: %[[ARG1_PVT:.*]] = fir.alloca !fir.logical<4> {bindc_name = "arg1", pinned, uniq_name = "_QFfirstprivate_logicalEarg1"} +!FIRDialect-DAG: %[[ARG1_VAL:.*]] = fir.load %[[ARG1]] : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG1_VAL]] to %[[ARG1_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG2_PVT:.*]] = fir.alloca !fir.logical<1> {bindc_name = "arg2", pinned, uniq_name = "_QFfirstprivate_logicalEarg2"} +!FIRDialect-DAG: %[[ARG2_VAL:.*]] = fir.load %[[ARG2]] : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG2_VAL]] to %[[ARG2_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG3_PVT:.*]] = fir.alloca !fir.logical<2> {bindc_name = "arg3", pinned, uniq_name = "_QFfirstprivate_logicalEarg3"} +!FIRDialect-DAG: %[[ARG3_VAL:.*]] = fir.load %[[ARG3]] : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG3_VAL]] to %[[ARG3_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG4_PVT:.*]] = fir.alloca !fir.logical<4> {bindc_name = "arg4", pinned, uniq_name = "_QFfirstprivate_logicalEarg4"} +!FIRDialect-DAG: %[[ARG4_VAL:.*]] = fir.load %[[ARG4]] : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG4_VAL]] to %[[ARG4_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG5_PVT:.*]] = fir.alloca !fir.logical<8> {bindc_name = "arg5", pinned, uniq_name = "_QFfirstprivate_logicalEarg5"} +!FIRDialect-DAG: %[[ARG5_VAL:.*]] = fir.load %[[ARG5]] : !fir.ref> +!FIRDialect-DAG: fir.store %[[ARG5_VAL]] to %[[ARG5_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[LIST_IO:.*]] = fir.call @_FortranAioBeginExternalListOutput +!FIRDialect-DAG: %[[ARG1_PVT_VAL:.*]] = fir.load %[[ARG1_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG1_PVT_CVT:.*]] = fir.convert %[[ARG1_PVT_VAL]] : (!fir.logical<4>) -> i1 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputLogical(%[[LIST_IO]], %[[ARG1_PVT_CVT]]) : (!fir.ref, i1) -> i1 +!FIRDialect-DAG: %[[ARG2_PVT_VAL:.*]] = fir.load %[[ARG2_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG2_PVT_CVT:.*]] = fir.convert %[[ARG2_PVT_VAL]] : (!fir.logical<1>) -> i1 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputLogical(%[[LIST_IO]], %[[ARG2_PVT_CVT]]) : (!fir.ref, i1) -> i1 +!FIRDialect-DAG: %[[ARG3_PVT_VAL:.*]] = fir.load %[[ARG3_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG3_PVT_CVT:.*]] = fir.convert %[[ARG3_PVT_VAL]] : (!fir.logical<2>) -> i1 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputLogical(%[[LIST_IO]], %[[ARG3_PVT_CVT]]) : (!fir.ref, i1) -> i1 +!FIRDialect-DAG: %[[ARG4_PVT_VAL:.*]] = fir.load %[[ARG4_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG4_PVT_CVT:.*]] = fir.convert %[[ARG4_PVT_VAL]] : (!fir.logical<4>) -> i1 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputLogical(%[[LIST_IO]], %[[ARG4_PVT_CVT]]) : (!fir.ref, i1) -> i1 +!FIRDialect-DAG: %[[ARG5_PVT_VAL:.*]] = fir.load %[[ARG5_PVT]] : !fir.ref> +!FIRDialect-DAG: %[[ARG5_PVT_CVT:.*]] = fir.convert %[[ARG5_PVT_VAL]] : (!fir.logical<8>) -> i1 +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputLogical(%[[LIST_IO]], %[[ARG5_PVT_CVT]]) : (!fir.ref, i1) -> i1 +!FIRDialect-DAG: omp.terminator +!FIRDialect-DAG: } + +subroutine firstprivate_logical(arg1, arg2, arg3, arg4, arg5) + logical :: arg1 + logical(kind=1) :: arg2 + logical(kind=2) :: arg3 + logical(kind=4) :: arg4 + logical(kind=8) :: arg5 + +!$OMP PARALLEL FIRSTPRIVATE(arg1, arg2, arg3, arg4, arg5) + print *, arg1, arg2, arg3, arg4, arg5 +!$OMP END PARALLEL + +end subroutine + +!FIRDialect-DAG: func @_QPfirstprivate_real(%[[ARG1:.*]]: !fir.ref{{.*}}, %[[ARG2:.*]]: !fir.ref{{.*}}, %[[ARG3:.*]]: !fir.ref{{.*}}, %[[ARG4:.*]]: !fir.ref{{.*}}, %[[ARG5:.*]]: !fir.ref{{.*}}, %[[ARG6:.*]]: !fir.ref{{.*}}) { +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: %[[ARG1_PVT:.*]] = fir.alloca f32 {bindc_name = "arg1", pinned, uniq_name = "_QFfirstprivate_realEarg1"} +!FIRDialect-DAG: %[[ARG1_VAL:.*]] = fir.load %[[ARG1]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG1_VAL]] to %[[ARG1_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG2_PVT:.*]] = fir.alloca f16 {bindc_name = "arg2", pinned, uniq_name = "_QFfirstprivate_realEarg2"} +!FIRDialect-DAG: %[[ARG2_VAL:.*]] = fir.load %[[ARG2]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG2_VAL]] to %[[ARG2_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG3_PVT:.*]] = fir.alloca f32 {bindc_name = "arg3", pinned, uniq_name = "_QFfirstprivate_realEarg3"} +!FIRDialect-DAG: %[[ARG3_VAL:.*]] = fir.load %[[ARG3]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG3_VAL]] to %[[ARG3_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG4_PVT:.*]] = fir.alloca f64 {bindc_name = "arg4", pinned, uniq_name = "_QFfirstprivate_realEarg4"} +!FIRDialect-DAG: %[[ARG4_VAL:.*]] = fir.load %[[ARG4]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG4_VAL]] to %[[ARG4_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG5_PVT:.*]] = fir.alloca f80 {bindc_name = "arg5", pinned, uniq_name = "_QFfirstprivate_realEarg5"} +!FIRDialect-DAG: %[[ARG5_VAL:.*]] = fir.load %[[ARG5]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG5_VAL]] to %[[ARG5_PVT]] : !fir.ref +!FIRDialect-DAG: %[[ARG6_PVT:.*]] = fir.alloca f128 {bindc_name = "arg6", pinned, uniq_name = "_QFfirstprivate_realEarg6"} +!FIRDialect-DAG: %[[ARG6_VAL:.*]] = fir.load %[[ARG6]] : !fir.ref +!FIRDialect-DAG: fir.store %[[ARG6_VAL]] to %[[ARG6_PVT]] : !fir.ref +!FIRDialect-DAG: %[[LIST_IO:.*]] = fir.call @_FortranAioBeginExternalListOutput +!FIRDialect-DAG: %[[ARG1_PVT_VAL:.*]] = fir.load %[[ARG1_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputReal32(%[[LIST_IO]], %[[ARG1_PVT_VAL]]) : (!fir.ref, f32) -> i1 +!FIRDialect-DAG: %[[ARG2_PVT_VAL:.*]] = fir.embox %[[ARG2_PVT]] : (!fir.ref) -> !fir.box +!FIRDialect-DAG: %[[ARG2_PVT_CVT:.*]] = fir.convert %[[ARG2_PVT_VAL]] : (!fir.box) -> !fir.box +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%[[LIST_IO]], %[[ARG2_PVT_CVT]]) : (!fir.ref, !fir.box) -> i1 +!FIRDialect-DAG: %[[ARG3_PVT_VAL:.*]] = fir.load %[[ARG3_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputReal32(%[[LIST_IO]], %[[ARG3_PVT_VAL]]) : (!fir.ref, f32) -> i1 +!FIRDialect-DAG: %[[ARG4_PVT_VAL:.*]] = fir.load %[[ARG4_PVT]] : !fir.ref +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputReal64(%[[LIST_IO]], %[[ARG4_PVT_VAL]]) : (!fir.ref, f64) -> i1 +!FIRDialect-DAG: %[[ARG5_PVT_VAL:.*]] = fir.embox %[[ARG5_PVT]] : (!fir.ref) -> !fir.box +!FIRDialect-DAG: %[[ARG5_PVT_CVT:.*]] = fir.convert %[[ARG5_PVT_VAL]] : (!fir.box) -> !fir.box +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%[[LIST_IO]], %[[ARG5_PVT_CVT]]) : (!fir.ref, !fir.box) -> i1 +!FIRDialect-DAG: %[[ARG6_PVT_VAL:.*]] = fir.embox %[[ARG6_PVT]] : (!fir.ref) -> !fir.box +!FIRDialect-DAG: %[[ARG6_PVT_CVT:.*]] = fir.convert %[[ARG6_PVT_VAL]] : (!fir.box) -> !fir.box +!FIRDialect-DAG: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%[[LIST_IO]], %[[ARG6_PVT_CVT]]) : (!fir.ref, !fir.box) -> i1 +!FIRDialect-DAG: omp.terminator +!FIRDialect-DAG: } + +subroutine firstprivate_real(arg1, arg2, arg3, arg4, arg5, arg6) + real :: arg1 + real(kind=2) :: arg2 + real(kind=4) :: arg3 + real(kind=8) :: arg4 + real(kind=10) :: arg5 + real(kind=16) :: arg6 + +!$OMP PARALLEL FIRSTPRIVATE(arg1, arg2, arg3, arg4, arg5, arg6) + print *, arg1, arg2, arg3, arg4, arg5, arg6 +!$OMP END PARALLEL + +end subroutine diff --git a/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 b/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 new file mode 100644 index 0000000000000..b13e27e58d0d1 --- /dev/null +++ b/flang/test/Lower/OpenMP/omp-parallel-private-clause.f90 @@ -0,0 +1,135 @@ +! This test checks lowering of OpenMP parallel Directive with +! `PRIVATE` clause present. + +! REQUIRES: shell +! RUN: bbc -fopenmp -emit-fir %s -o - | \ +! RUN: FileCheck %s --check-prefix=FIRDialect + +!FIRDialect: func @_QPprivate_clause(%[[ARG1:.*]]: !fir.ref{{.*}}, %[[ARG2:.*]]: !fir.ref>{{.*}}, %[[ARG3:.*]]: !fir.boxchar<1>{{.*}}, %[[ARG4:.*]]: !fir.boxchar<1>{{.*}}) { +!FIRDialect-DAG: %[[ALPHA:.*]] = fir.alloca i32 {{{.*}}, uniq_name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[ALPHA_ARRAY:.*]] = fir.alloca !fir.array<10xi32> {{{.*}}, uniq_name = "{{.*}}Ealpha_array"} +!FIRDialect-DAG: %[[BETA:.*]] = fir.alloca !fir.char<1,5> {{{.*}}, uniq_name = "{{.*}}Ebeta"} +!FIRDialect-DAG: %[[BETA_ARRAY:.*]] = fir.alloca !fir.array<10x!fir.char<1,5>> {{{.*}}, uniq_name = "{{.*}}Ebeta_array"} + +!FIRDialect-DAG: omp.parallel { +!FIRDialect-DAG: %[[ALPHA_PRIVATE:.*]] = fir.alloca i32 {{{.*}}, pinned, uniq_name = "{{.*}}Ealpha"} +!FIRDialect-DAG: %[[ALPHA_ARRAY_PRIVATE:.*]] = fir.alloca !fir.array<10xi32> {{{.*}}, pinned, uniq_name = "{{.*}}Ealpha_array"} +!FIRDialect-DAG: %[[BETA_PRIVATE:.*]] = fir.alloca !fir.char<1,5> {{{.*}}, pinned, uniq_name = "{{.*}}Ebeta"} +!FIRDialect-DAG: %[[BETA_ARRAY_PRIVATE:.*]] = fir.alloca !fir.array<10x!fir.char<1,5>> {{{.*}}, pinned, uniq_name = "{{.*}}Ebeta_array"} +!FIRDialect-DAG: %[[ARG1_PRIVATE:.*]] = fir.alloca i32 {{{.*}}, pinned, uniq_name = "{{.*}}Earg1"} +!FIRDialect-DAG: %[[ARG2_ARRAY_PRIVATE:.*]] = fir.alloca !fir.array<10xi32> {{{.*}}, pinned, uniq_name = "{{.*}}Earg2"} +!FIRDialect-DAG: %[[ARG3_PRIVATE:.*]] = fir.alloca !fir.char<1,5> {{{.*}}, pinned, uniq_name = "{{.*}}Earg3"} +!FIRDialect-DAG: %[[ARG4_ARRAY_PRIVATE:.*]] = fir.alloca !fir.array<10x!fir.char<1,5>> {{{.*}}, pinned, uniq_name = "{{.*}}Earg4"} +!FIRDialect: omp.terminator +!FIRDialect: } + +subroutine private_clause(arg1, arg2, arg3, arg4) + + integer :: arg1, arg2(10) + integer :: alpha, alpha_array(10) + character(5) :: arg3, arg4(10) + character(5) :: beta, beta_array(10) + +!$OMP PARALLEL PRIVATE(alpha, alpha_array, beta, beta_array, arg1, arg2, arg3, arg4) + alpha = 1 + alpha_array = 4 + beta = "hi" + beta_array = "hi" + arg1 = 2 + arg2 = 3 + arg3 = "world" + arg4 = "world" +!$OMP END PARALLEL + +end subroutine + +!FIRDialect: func @_QPprivate_clause_scalar() { +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.complex<4> {bindc_name = "c", uniq_name = "{{.*}}Ec"} +!FIRDialect-DAG: {{.*}} = fir.alloca i8 {bindc_name = "i1", uniq_name = "{{.*}}Ei1"} +!FIRDialect-DAG: {{.*}} = fir.alloca i128 {bindc_name = "i16", uniq_name = "{{.*}}Ei16"} +!FIRDialect-DAG: {{.*}} = fir.alloca i16 {bindc_name = "i2", uniq_name = "{{.*}}Ei2"} +!FIRDialect-DAG: {{.*}} = fir.alloca i32 {bindc_name = "i4", uniq_name = "{{.*}}Ei4"} +!FIRDialect-DAG: {{.*}} = fir.alloca i64 {bindc_name = "i8", uniq_name = "{{.*}}Ei8"} +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.logical<4> {bindc_name = "l", uniq_name = "{{.*}}El"} +!FIRDialect-DAG: {{.*}} = fir.alloca f32 {bindc_name = "r", uniq_name = "{{.*}}Er"} + +!FIRDialect: omp.parallel { +!FIRDialect-DAG: {{.*}} = fir.alloca i8 {bindc_name = "i1", pinned, uniq_name = "{{.*}}Ei1"} +!FIRDialect-DAG: {{.*}} = fir.alloca i16 {bindc_name = "i2", pinned, uniq_name = "{{.*}}Ei2"} +!FIRDialect-DAG: {{.*}} = fir.alloca i32 {bindc_name = "i4", pinned, uniq_name = "{{.*}}Ei4"} +!FIRDialect-DAG: {{.*}} = fir.alloca i64 {bindc_name = "i8", pinned, uniq_name = "{{.*}}Ei8"} +!FIRDialect-DAG: {{.*}} = fir.alloca i128 {bindc_name = "i16", pinned, uniq_name = "{{.*}}Ei16"} +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.complex<4> {bindc_name = "c", pinned, uniq_name = "{{.*}}Ec"} +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.logical<4> {bindc_name = "l", pinned, uniq_name = "{{.*}}El"} +!FIRDialect-DAG: {{.*}} = fir.alloca f32 {bindc_name = "r", pinned, uniq_name = "{{.*}}Er"} + +subroutine private_clause_scalar() + + integer(kind=1) :: i1 + integer(kind=2) :: i2 + integer(kind=4) :: i4 + integer(kind=8) :: i8 + integer(kind=16) :: i16 + complex :: c + logical :: l + real :: r + +!$OMP PARALLEL PRIVATE(i1, i2, i4, i8, i16, c, l, r) + print *, i1, i2, i4, i8, i16, c, l, r +!$OMP END PARALLEL + +end subroutine + +!FIRDialect: func @_QPprivate_clause_derived_type() { +!FIRDialect: {{.*}} = fir.alloca !fir.type<{{.*}}{t_i:i32,t_arr:!fir.array<5xi32>}> {bindc_name = "t", uniq_name = "{{.*}}Et"} + +!FIRDialect: omp.parallel { +!FIRDialect: {{.*}} = fir.alloca !fir.type<{{.*}}{t_i:i32,t_arr:!fir.array<5xi32>}> {bindc_name = "t", pinned, uniq_name = "{{.*}}Et"} + +subroutine private_clause_derived_type() + + type my_type + integer :: t_i + integer :: t_arr(5) + end type my_type + type(my_type) :: t + +!$OMP PARALLEL PRIVATE(t) + print *, t%t_i +!$OMP END PARALLEL + +end subroutine + +!FIRDialect: func @_QPprivate_clause_allocatable() { +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.box> {bindc_name = "x", uniq_name = "{{.*}}Ex"} +!FIRDialect-DAG: {{.*}} = fir.alloca !fir.heap {uniq_name = "{{.*}}Ex.addr"} +!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: 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 + +subroutine private_clause_allocatable() + + integer, allocatable :: x, x2(:) + integer, allocatable, save :: x3, x4(:) + + print *, x, x2, x3, x4 + +!$OMP PARALLEL PRIVATE(x, x2, x3, x4) + print *, x, x2, x3, x4 +!$OMP END PARALLEL + +end subroutine