diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 75784f4e5a72b..cbe108194dd21 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2287,9 +2287,11 @@ class FirConverter : public Fortran::lower::AbstractConverter { void genFIR(const Fortran::parser::OpenACCConstruct &acc) { mlir::OpBuilder::InsertPoint insertPt = builder->saveInsertionPoint(); + localSymbols.pushScope(); genOpenACCConstruct(*this, bridge.getSemanticsContext(), getEval(), acc); for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations()) genFIR(e); + localSymbols.popScope(); builder->restoreInsertionPoint(insertPt); } diff --git a/flang/lib/Lower/DirectivesCommon.h b/flang/lib/Lower/DirectivesCommon.h new file mode 100644 index 0000000000000..35825a20b4cf9 --- /dev/null +++ b/flang/lib/Lower/DirectivesCommon.h @@ -0,0 +1,593 @@ +//===-- Lower/DirectivesCommon.h --------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// +/// +/// A location to place directive utilities shared across multiple lowering +/// files, e.g. utilities shared in OpenMP and OpenACC. The header file can +/// be used for both declarations and templated/inline implementations. +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_DIRECTIVES_COMMON_H +#define FORTRAN_LOWER_DIRECTIVES_COMMON_H + +#include "flang/Common/idioms.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/ConvertExpr.h" +#include "flang/Lower/ConvertVariable.h" +#include "flang/Lower/OpenACC.h" +#include "flang/Lower/OpenMP.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/StatementContext.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/Todo.h" +#include "flang/Optimizer/HLFIR/HLFIROps.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/openmp-directive-sets.h" +#include "flang/Semantics/tools.h" +#include "mlir/Dialect/OpenACC/OpenACC.h" +#include "mlir/Dialect/OpenMP/OpenMPDialect.h" +#include "mlir/Dialect/SCF/IR/SCF.h" +#include "llvm/Frontend/OpenMP/OMPConstants.h" +#include + +namespace Fortran { +namespace lower { + +/// Checks if the assignment statement has a single variable on the RHS. +static inline bool checkForSingleVariableOnRHS( + const Fortran::parser::AssignmentStmt &assignmentStmt) { + const Fortran::parser::Expr &expr{ + std::get(assignmentStmt.t)}; + const Fortran::common::Indirection *designator = + std::get_if>( + &expr.u); + const Fortran::parser::Name *name = + designator + ? Fortran::semantics::getDesignatorNameIfDataRef(designator->value()) + : nullptr; + return name != nullptr; +} + +/// Checks if the symbol on the LHS of the assignment statement is present in +/// the RHS expression. +static inline bool +checkForSymbolMatch(const Fortran::parser::AssignmentStmt &assignmentStmt) { + const auto &var{std::get(assignmentStmt.t)}; + const auto &expr{std::get(assignmentStmt.t)}; + const auto *e{Fortran::semantics::GetExpr(expr)}; + const auto *v{Fortran::semantics::GetExpr(var)}; + auto varSyms{Fortran::evaluate::GetSymbolVector(*v)}; + const Fortran::semantics::Symbol &varSymbol{*varSyms.front()}; + for (const Fortran::semantics::Symbol &symbol : + Fortran::evaluate::GetSymbolVector(*e)) + if (varSymbol == symbol) + return true; + return false; +} + +/// Populates \p hint and \p memoryOrder with appropriate clause information +/// if present on atomic construct. +static inline void genOmpAtomicHintAndMemoryOrderClauses( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::OmpAtomicClauseList &clauseList, + mlir::IntegerAttr &hint, + mlir::omp::ClauseMemoryOrderKindAttr &memoryOrder) { + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + for (const Fortran::parser::OmpAtomicClause &clause : clauseList.v) { + if (const auto *ompClause = + std::get_if(&clause.u)) { + if (const auto *hintClause = + std::get_if(&ompClause->u)) { + const auto *expr = Fortran::semantics::GetExpr(hintClause->v); + uint64_t hintExprValue = *Fortran::evaluate::ToInt64(*expr); + hint = firOpBuilder.getI64IntegerAttr(hintExprValue); + } + } else if (const auto *ompMemoryOrderClause = + std::get_if( + &clause.u)) { + if (std::get_if( + &ompMemoryOrderClause->v.u)) { + memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( + firOpBuilder.getContext(), + mlir::omp::ClauseMemoryOrderKind::Acquire); + } else if (std::get_if( + &ompMemoryOrderClause->v.u)) { + memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( + firOpBuilder.getContext(), + mlir::omp::ClauseMemoryOrderKind::Relaxed); + } else if (std::get_if( + &ompMemoryOrderClause->v.u)) { + memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( + firOpBuilder.getContext(), + mlir::omp::ClauseMemoryOrderKind::Seq_cst); + } else if (std::get_if( + &ompMemoryOrderClause->v.u)) { + memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( + firOpBuilder.getContext(), + mlir::omp::ClauseMemoryOrderKind::Release); + } + } + } +} + +/// Used to generate atomic.read operation which is created in existing +/// location set by builder. +template +static inline void genOmpAccAtomicCaptureStatement( + Fortran::lower::AbstractConverter &converter, mlir::Value fromAddress, + mlir::Value toAddress, + [[maybe_unused]] const AtomicListT *leftHandClauseList, + [[maybe_unused]] const AtomicListT *rightHandClauseList, + mlir::Type elementType) { + // Generate `atomic.read` operation for atomic assigment statements + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + + if constexpr (std::is_same()) { + // If no hint clause is specified, the effect is as if + // hint(omp_sync_hint_none) had been specified. + mlir::IntegerAttr hint = nullptr; + + mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; + if (leftHandClauseList) + genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, + hint, memoryOrder); + if (rightHandClauseList) + genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, + hint, memoryOrder); + firOpBuilder.create( + currentLocation, fromAddress, toAddress, + mlir::TypeAttr::get(elementType), hint, memoryOrder); + } else { + firOpBuilder.create( + currentLocation, fromAddress, toAddress, + mlir::TypeAttr::get(elementType)); + } +} + +/// Used to generate atomic.write operation which is created in existing +/// location set by builder. +template +static inline void genOmpAccAtomicWriteStatement( + Fortran::lower::AbstractConverter &converter, mlir::Value lhsAddr, + mlir::Value rhsExpr, [[maybe_unused]] const AtomicListT *leftHandClauseList, + [[maybe_unused]] const AtomicListT *rightHandClauseList, + mlir::Value *evaluatedExprValue = nullptr) { + // Generate `atomic.write` operation for atomic assignment statements + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + + if constexpr (std::is_same()) { + // If no hint clause is specified, the effect is as if + // hint(omp_sync_hint_none) had been specified. + mlir::IntegerAttr hint = nullptr; + mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; + if (leftHandClauseList) + genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, + hint, memoryOrder); + if (rightHandClauseList) + genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, + hint, memoryOrder); + firOpBuilder.create(currentLocation, lhsAddr, + rhsExpr, hint, memoryOrder); + } else { + firOpBuilder.create(currentLocation, lhsAddr, + rhsExpr); + } +} + +/// Used to generate atomic.update operation which is created in existing +/// location set by builder. +template +static inline void genOmpAccAtomicUpdateStatement( + Fortran::lower::AbstractConverter &converter, mlir::Value lhsAddr, + mlir::Type varType, const Fortran::parser::Variable &assignmentStmtVariable, + const Fortran::parser::Expr &assignmentStmtExpr, + [[maybe_unused]] const AtomicListT *leftHandClauseList, + [[maybe_unused]] const AtomicListT *rightHandClauseList) { + // Generate `omp.atomic.update` operation for atomic assignment statements + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + + const auto *varDesignator = + std::get_if>( + &assignmentStmtVariable.u); + assert(varDesignator && "Variable designator for atomic update assignment " + "statement does not exist"); + const Fortran::parser::Name *name = + Fortran::semantics::getDesignatorNameIfDataRef(varDesignator->value()); + if (!name) + TODO(converter.getCurrentLocation(), + "Array references as atomic update variable"); + assert(name && name->symbol && + "No symbol attached to atomic update variable"); + if (Fortran::semantics::IsAllocatableOrPointer(name->symbol->GetUltimate())) + converter.bindSymbol(*name->symbol, lhsAddr); + + // Lowering is in two steps : + // subroutine sb + // integer :: a, b + // !$omp atomic update + // a = a + b + // end subroutine + // + // 1. Lower to scf.execute_region_op + // + // func.func @_QPsb() { + // %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"} + // %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"} + // %2 = scf.execute_region -> i32 { + // %3 = fir.load %0 : !fir.ref + // %4 = fir.load %1 : !fir.ref + // %5 = arith.addi %3, %4 : i32 + // scf.yield %5 : i32 + // } + // return + // } + auto tempOp = + firOpBuilder.create(currentLocation, varType); + firOpBuilder.createBlock(&tempOp.getRegion()); + mlir::Block &block = tempOp.getRegion().back(); + firOpBuilder.setInsertionPointToEnd(&block); + Fortran::lower::StatementContext stmtCtx; + mlir::Value rhsExpr = fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(assignmentStmtExpr), stmtCtx)); + mlir::Value convertResult = + firOpBuilder.createConvert(currentLocation, varType, rhsExpr); + // Insert the terminator: YieldOp. + firOpBuilder.create(currentLocation, convertResult); + firOpBuilder.setInsertionPointToStart(&block); + + // 2. Create the omp.atomic.update Operation using the Operations in the + // temporary scf.execute_region Operation. + // + // func.func @_QPsb() { + // %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"} + // %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"} + // %2 = fir.load %1 : !fir.ref + // omp.atomic.update %0 : !fir.ref { + // ^bb0(%arg0: i32): + // %3 = fir.load %1 : !fir.ref + // %4 = arith.addi %arg0, %3 : i32 + // omp.yield(%3 : i32) + // } + // return + // } + mlir::Value updateVar = converter.getSymbolAddress(*name->symbol); + if (auto decl = updateVar.getDefiningOp()) + updateVar = decl.getBase(); + + firOpBuilder.setInsertionPointAfter(tempOp); + + mlir::Operation *atomicUpdateOp = nullptr; + if constexpr (std::is_same()) { + // If no hint clause is specified, the effect is as if + // hint(omp_sync_hint_none) had been specified. + mlir::IntegerAttr hint = nullptr; + mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; + if (leftHandClauseList) + genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, + hint, memoryOrder); + if (rightHandClauseList) + genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, + hint, memoryOrder); + atomicUpdateOp = firOpBuilder.create( + currentLocation, updateVar, hint, memoryOrder); + } else { + atomicUpdateOp = firOpBuilder.create( + currentLocation, updateVar); + } + + llvm::SmallVector varTys = {varType}; + llvm::SmallVector locs = {currentLocation}; + firOpBuilder.createBlock(&atomicUpdateOp->getRegion(0), {}, varTys, locs); + mlir::Value val = + fir::getBase(atomicUpdateOp->getRegion(0).front().getArgument(0)); + + llvm::SmallVector ops; + for (mlir::Operation &op : tempOp.getRegion().getOps()) + ops.push_back(&op); + + // SCF Yield is converted to OMP Yield. All other operations are copied + for (mlir::Operation *op : ops) { + if (auto y = mlir::dyn_cast(op)) { + firOpBuilder.setInsertionPointToEnd( + &atomicUpdateOp->getRegion(0).front()); + if constexpr (std::is_same()) { + firOpBuilder.create(currentLocation, + y.getResults()); + } else { + firOpBuilder.create(currentLocation, + y.getResults()); + } + op->erase(); + } else { + op->remove(); + atomicUpdateOp->getRegion(0).front().push_back(op); + } + } + + // Remove the load and replace all uses of load with the block argument + for (mlir::Operation &op : atomicUpdateOp->getRegion(0).getOps()) { + fir::LoadOp y = mlir::dyn_cast(&op); + if (y && y.getMemref() == updateVar) + y.getRes().replaceAllUsesWith(val); + } + + tempOp.erase(); +} + +/// Processes an atomic construct with write clause. +template +void genOmpAccAtomicWrite(Fortran::lower::AbstractConverter &converter, + const AtomicT &atomicWrite) { + const AtomicListT *rightHandClauseList = nullptr; + const AtomicListT *leftHandClauseList = nullptr; + if constexpr (std::is_same()) { + // Get the address of atomic read operands. + rightHandClauseList = &std::get<2>(atomicWrite.t); + leftHandClauseList = &std::get<0>(atomicWrite.t); + } + + const Fortran::parser::AssignmentStmt &stmt = + std::get>( + atomicWrite.t) + .statement; + const Fortran::evaluate::Assignment &assign = *stmt.typedAssignment->v; + Fortran::lower::StatementContext stmtCtx; + // Get the value and address of atomic write operands. + mlir::Value rhsExpr = + fir::getBase(converter.genExprValue(assign.rhs, stmtCtx)); + mlir::Value lhsAddr = + fir::getBase(converter.genExprAddr(assign.lhs, stmtCtx)); + genOmpAccAtomicWriteStatement(converter, lhsAddr, rhsExpr, leftHandClauseList, + rightHandClauseList); +} + +/// Processes an atomic construct with read clause. +template +void genOmpAccAtomicRead(Fortran::lower::AbstractConverter &converter, + const AtomicT &atomicRead) { + const AtomicListT *rightHandClauseList = nullptr; + const AtomicListT *leftHandClauseList = nullptr; + if constexpr (std::is_same()) { + // Get the address of atomic read operands. + rightHandClauseList = &std::get<2>(atomicRead.t); + leftHandClauseList = &std::get<0>(atomicRead.t); + } + + const auto &assignmentStmtExpr = std::get( + std::get>( + atomicRead.t) + .statement.t); + const auto &assignmentStmtVariable = std::get( + std::get>( + atomicRead.t) + .statement.t); + + Fortran::lower::StatementContext stmtCtx; + const Fortran::semantics::SomeExpr &fromExpr = + *Fortran::semantics::GetExpr(assignmentStmtExpr); + mlir::Type elementType = converter.genType(fromExpr); + mlir::Value fromAddress = + fir::getBase(converter.genExprAddr(fromExpr, stmtCtx)); + mlir::Value toAddress = fir::getBase(converter.genExprAddr( + *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)); + genOmpAccAtomicCaptureStatement(converter, fromAddress, toAddress, + leftHandClauseList, rightHandClauseList, + elementType); +} + +/// Processes an atomic construct with update clause. +template +void genOmpAccAtomicUpdate(Fortran::lower::AbstractConverter &converter, + const AtomicT &atomicUpdate) { + const AtomicListT *rightHandClauseList = nullptr; + const AtomicListT *leftHandClauseList = nullptr; + if constexpr (std::is_same()) { + // Get the address of atomic read operands. + rightHandClauseList = &std::get<2>(atomicUpdate.t); + leftHandClauseList = &std::get<0>(atomicUpdate.t); + } + + const auto &assignmentStmtExpr = std::get( + std::get>( + atomicUpdate.t) + .statement.t); + const auto &assignmentStmtVariable = std::get( + std::get>( + atomicUpdate.t) + .statement.t); + + Fortran::lower::StatementContext stmtCtx; + mlir::Value lhsAddr = fir::getBase(converter.genExprAddr( + *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)); + mlir::Type varType = + fir::getBase( + converter.genExprValue( + *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)) + .getType(); + genOmpAccAtomicUpdateStatement( + converter, lhsAddr, varType, assignmentStmtVariable, assignmentStmtExpr, + leftHandClauseList, rightHandClauseList); +} + +/// Processes an atomic construct with no clause - which implies update clause. +template +void genOmpAtomic(Fortran::lower::AbstractConverter &converter, + const AtomicT &atomicConstruct) { + const AtomicListT &atomicClauseList = + std::get(atomicConstruct.t); + const auto &assignmentStmtExpr = std::get( + std::get>( + atomicConstruct.t) + .statement.t); + const auto &assignmentStmtVariable = std::get( + std::get>( + atomicConstruct.t) + .statement.t); + Fortran::lower::StatementContext stmtCtx; + mlir::Value lhsAddr = fir::getBase(converter.genExprAddr( + *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)); + mlir::Type varType = + fir::getBase( + converter.genExprValue( + *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)) + .getType(); + // If atomic-clause is not present on the construct, the behaviour is as if + // the update clause is specified (for both OpenMP and OpenACC). + genOmpAccAtomicUpdateStatement( + converter, lhsAddr, varType, assignmentStmtVariable, assignmentStmtExpr, + &atomicClauseList, nullptr); +} + +/// Processes an atomic construct with capture clause. +template +void genOmpAccAtomicCapture(Fortran::lower::AbstractConverter &converter, + const AtomicT &atomicCapture) { + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + + const Fortran::parser::AssignmentStmt &stmt1 = + std::get(atomicCapture.t).v.statement; + const auto &stmt1Var{std::get(stmt1.t)}; + const auto &stmt1Expr{std::get(stmt1.t)}; + const Fortran::parser::AssignmentStmt &stmt2 = + std::get(atomicCapture.t).v.statement; + const auto &stmt2Var{std::get(stmt2.t)}; + const auto &stmt2Expr{std::get(stmt2.t)}; + + // Pre-evaluate expressions to be used in the various operations inside + // `atomic.capture` since it is not desirable to have anything other than + // a `atomic.read`, `atomic.write`, or `atomic.update` operation + // inside `atomic.capture` + Fortran::lower::StatementContext stmtCtx; + mlir::Value stmt1LHSArg, stmt1RHSArg, stmt2LHSArg, stmt2RHSArg; + mlir::Type elementType; + // LHS evaluations are common to all combinations of `atomic.capture` + stmt1LHSArg = fir::getBase( + converter.genExprAddr(*Fortran::semantics::GetExpr(stmt1Var), stmtCtx)); + stmt2LHSArg = fir::getBase( + converter.genExprAddr(*Fortran::semantics::GetExpr(stmt2Var), stmtCtx)); + + // Operation specific RHS evaluations + if (checkForSingleVariableOnRHS(stmt1)) { + // Atomic capture construct is of the form [capture-stmt, update-stmt] or + // of the form [capture-stmt, write-stmt] + stmt1RHSArg = fir::getBase(converter.genExprAddr( + *Fortran::semantics::GetExpr(stmt1Expr), stmtCtx)); + stmt2RHSArg = fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(stmt2Expr), stmtCtx)); + + } else { + // Atomic capture construct is of the form [update-stmt, capture-stmt] + stmt1RHSArg = fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(stmt1Expr), stmtCtx)); + stmt2RHSArg = fir::getBase(converter.genExprAddr( + *Fortran::semantics::GetExpr(stmt2Expr), stmtCtx)); + } + // Type information used in generation of `atomic.update` operation + mlir::Type stmt1VarType = + fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(stmt1Var), stmtCtx)) + .getType(); + mlir::Type stmt2VarType = + fir::getBase(converter.genExprValue( + *Fortran::semantics::GetExpr(stmt2Var), stmtCtx)) + .getType(); + + mlir::Operation *atomicCaptureOp = nullptr; + if constexpr (std::is_same()) { + mlir::IntegerAttr hint = nullptr; + mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; + const AtomicListT &rightHandClauseList = std::get<2>(atomicCapture.t); + const AtomicListT &leftHandClauseList = std::get<0>(atomicCapture.t); + genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint, + memoryOrder); + genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint, + memoryOrder); + atomicCaptureOp = firOpBuilder.create( + currentLocation, hint, memoryOrder); + } else { + atomicCaptureOp = + firOpBuilder.create(currentLocation); + } + + firOpBuilder.createBlock(&(atomicCaptureOp->getRegion(0))); + mlir::Block &block = atomicCaptureOp->getRegion(0).back(); + firOpBuilder.setInsertionPointToStart(&block); + if (checkForSingleVariableOnRHS(stmt1)) { + if (checkForSymbolMatch(stmt2)) { + // Atomic capture construct is of the form [capture-stmt, update-stmt] + const Fortran::semantics::SomeExpr &fromExpr = + *Fortran::semantics::GetExpr(stmt1Expr); + elementType = converter.genType(fromExpr); + genOmpAccAtomicCaptureStatement( + converter, stmt1RHSArg, stmt1LHSArg, + /*leftHandClauseList=*/nullptr, + /*rightHandClauseList=*/nullptr, elementType); + genOmpAccAtomicUpdateStatement( + converter, stmt1RHSArg, stmt2VarType, stmt2Var, stmt2Expr, + /*leftHandClauseList=*/nullptr, + /*rightHandClauseList=*/nullptr); + } else { + // Atomic capture construct is of the form [capture-stmt, write-stmt] + const Fortran::semantics::SomeExpr &fromExpr = + *Fortran::semantics::GetExpr(stmt1Expr); + elementType = converter.genType(fromExpr); + genOmpAccAtomicCaptureStatement( + converter, stmt1RHSArg, stmt1LHSArg, + /*leftHandClauseList=*/nullptr, + /*rightHandClauseList=*/nullptr, elementType); + genOmpAccAtomicWriteStatement( + converter, stmt1RHSArg, stmt2RHSArg, + /*leftHandClauseList=*/nullptr, + /*rightHandClauseList=*/nullptr); + } + } else { + // Atomic capture construct is of the form [update-stmt, capture-stmt] + firOpBuilder.setInsertionPointToEnd(&block); + const Fortran::semantics::SomeExpr &fromExpr = + *Fortran::semantics::GetExpr(stmt2Expr); + elementType = converter.genType(fromExpr); + genOmpAccAtomicCaptureStatement( + converter, stmt1LHSArg, stmt2LHSArg, + /*leftHandClauseList=*/nullptr, + /*rightHandClauseList=*/nullptr, elementType); + firOpBuilder.setInsertionPointToStart(&block); + genOmpAccAtomicUpdateStatement( + converter, stmt1LHSArg, stmt1VarType, stmt1Var, stmt1Expr, + /*leftHandClauseList=*/nullptr, + /*rightHandClauseList=*/nullptr); + } + firOpBuilder.setInsertionPointToEnd(&block); + if constexpr (std::is_same()) { + firOpBuilder.create(currentLocation); + } else { + firOpBuilder.create(currentLocation); + } + firOpBuilder.setInsertionPointToStart(&block); +} + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_DIRECTIVES_COMMON_H \ No newline at end of file diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp index a59a71ff8d8ae..732765c4def59 100644 --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -11,6 +11,7 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/OpenACC.h" +#include "DirectivesCommon.h" #include "flang/Common/idioms.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/ConvertType.h" @@ -3096,6 +3097,34 @@ void Fortran::lower::finalizeOpenACCRoutineAttachment( accRoutineInfos.clear(); } +static void +genACC(Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::AccAtomicRead &atomicRead) { + Fortran::lower::genOmpAccAtomicRead(converter, atomicRead); + }, + [&](const Fortran::parser::AccAtomicWrite &atomicWrite) { + Fortran::lower::genOmpAccAtomicWrite< + Fortran::parser::AccAtomicWrite, void>(converter, atomicWrite); + }, + [&](const Fortran::parser::AccAtomicUpdate &atomicUpdate) { + Fortran::lower::genOmpAccAtomicUpdate< + Fortran::parser::AccAtomicUpdate, void>(converter, + atomicUpdate); + }, + [&](const Fortran::parser::AccAtomicCapture &atomicCapture) { + Fortran::lower::genOmpAccAtomicCapture< + Fortran::parser::AccAtomicCapture, void>(converter, + atomicCapture); + }, + }, + atomicConstruct.u); +} + static void genACC(Fortran::lower::AbstractConverter &converter, Fortran::semantics::SemanticsContext &semanticsContext, @@ -3160,8 +3189,7 @@ void Fortran::lower::genOpenACCConstruct( genACC(converter, waitConstruct); }, [&](const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) { - TODO(converter.genLocation(atomicConstruct.source), - "OpenACC Atomic construct not lowered yet!"); + genACC(converter, eval, atomicConstruct); }, }, accConstruct.u); diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp index aef9352e70ea3..e4532c5e9ed89 100644 --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -11,6 +11,7 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/OpenMP.h" +#include "DirectivesCommon.h" #include "flang/Common/idioms.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/ConvertExpr.h" @@ -2952,499 +2953,39 @@ genOMP(Fortran::lower::AbstractConverter &converter, allocatorOperands, nowaitClauseOperand); } -static bool checkForSingleVariableOnRHS( - const Fortran::parser::AssignmentStmt &assignmentStmt) { - // Check if the assignment statement has a single variable on the RHS - const Fortran::parser::Expr &expr{ - std::get(assignmentStmt.t)}; - const Fortran::common::Indirection *designator = - std::get_if>( - &expr.u); - const Fortran::parser::Name *name = - designator - ? Fortran::semantics::getDesignatorNameIfDataRef(designator->value()) - : nullptr; - return name != nullptr; -} - -static bool -checkForSymbolMatch(const Fortran::parser::AssignmentStmt &assignmentStmt) { - // Check if the symbol on the LHS of the assignment statement is present in - // the RHS expression - const auto &var{std::get(assignmentStmt.t)}; - const auto &expr{std::get(assignmentStmt.t)}; - const auto *e{Fortran::semantics::GetExpr(expr)}; - const auto *v{Fortran::semantics::GetExpr(var)}; - auto varSyms{Fortran::evaluate::GetSymbolVector(*v)}; - const Fortran::semantics::Symbol &varSymbol{*varSyms.front()}; - for (const Fortran::semantics::Symbol &symbol : - Fortran::evaluate::GetSymbolVector(*e)) - if (varSymbol == symbol) - return true; - return false; -} - -static void genOmpAtomicHintAndMemoryOrderClauses( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::OmpAtomicClauseList &clauseList, - mlir::IntegerAttr &hint, - mlir::omp::ClauseMemoryOrderKindAttr &memoryOrder) { - fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); - for (const Fortran::parser::OmpAtomicClause &clause : clauseList.v) { - if (const auto *ompClause = - std::get_if(&clause.u)) { - if (const auto *hintClause = - std::get_if(&ompClause->u)) { - const auto *expr = Fortran::semantics::GetExpr(hintClause->v); - uint64_t hintExprValue = *Fortran::evaluate::ToInt64(*expr); - hint = firOpBuilder.getI64IntegerAttr(hintExprValue); - } - } else if (const auto *ompMemoryOrderClause = - std::get_if( - &clause.u)) { - if (std::get_if( - &ompMemoryOrderClause->v.u)) { - memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( - firOpBuilder.getContext(), - mlir::omp::ClauseMemoryOrderKind::Acquire); - } else if (std::get_if( - &ompMemoryOrderClause->v.u)) { - memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( - firOpBuilder.getContext(), - mlir::omp::ClauseMemoryOrderKind::Relaxed); - } else if (std::get_if( - &ompMemoryOrderClause->v.u)) { - memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( - firOpBuilder.getContext(), - mlir::omp::ClauseMemoryOrderKind::Seq_cst); - } else if (std::get_if( - &ompMemoryOrderClause->v.u)) { - memoryOrder = mlir::omp::ClauseMemoryOrderKindAttr::get( - firOpBuilder.getContext(), - mlir::omp::ClauseMemoryOrderKind::Release); - } - } - } -} - -static void genOmpAtomicCaptureStatement( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, mlir::Value fromAddress, - mlir::Value toAddress, - const Fortran::parser::OmpAtomicClauseList *leftHandClauseList, - const Fortran::parser::OmpAtomicClauseList *rightHandClauseList, - mlir::Type elementType) { - // Generate `omp.atomic.read` operation for atomic assigment statements - fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); - mlir::Location currentLocation = converter.getCurrentLocation(); - - // If no hint clause is specified, the effect is as if - // hint(omp_sync_hint_none) had been specified. - mlir::IntegerAttr hint = nullptr; - - mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; - if (leftHandClauseList) - genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, hint, - memoryOrder); - if (rightHandClauseList) - genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, hint, - memoryOrder); - firOpBuilder.create( - currentLocation, fromAddress, toAddress, mlir::TypeAttr::get(elementType), - hint, memoryOrder); -} - -static void genOmpAtomicWriteStatement( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, mlir::Value lhsAddr, - mlir::Value rhsExpr, - const Fortran::parser::OmpAtomicClauseList *leftHandClauseList, - const Fortran::parser::OmpAtomicClauseList *rightHandClauseList, - mlir::Value *evaluatedExprValue = nullptr) { - // Generate `omp.atomic.write` operation for atomic assignment statements - fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); - mlir::Location currentLocation = converter.getCurrentLocation(); - // If no hint clause is specified, the effect is as if - // hint(omp_sync_hint_none) had been specified. - mlir::IntegerAttr hint = nullptr; - mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; - if (leftHandClauseList) - genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, hint, - memoryOrder); - if (rightHandClauseList) - genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, hint, - memoryOrder); - firOpBuilder.create(currentLocation, lhsAddr, - rhsExpr, hint, memoryOrder); -} - -static void genOmpAtomicUpdateStatement( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, mlir::Value lhsAddr, - mlir::Type varType, const Fortran::parser::Variable &assignmentStmtVariable, - const Fortran::parser::Expr &assignmentStmtExpr, - const Fortran::parser::OmpAtomicClauseList *leftHandClauseList, - const Fortran::parser::OmpAtomicClauseList *rightHandClauseList) { - // Generate `omp.atomic.update` operation for atomic assignment statements - fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); - mlir::Location currentLocation = converter.getCurrentLocation(); - - // If no hint clause is specified, the effect is as if - // hint(omp_sync_hint_none) had been specified. - mlir::IntegerAttr hint = nullptr; - mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; - if (leftHandClauseList) - genOmpAtomicHintAndMemoryOrderClauses(converter, *leftHandClauseList, hint, - memoryOrder); - if (rightHandClauseList) - genOmpAtomicHintAndMemoryOrderClauses(converter, *rightHandClauseList, hint, - memoryOrder); - const auto *varDesignator = - std::get_if>( - &assignmentStmtVariable.u); - assert(varDesignator && "Variable designator for atomic update assignment " - "statement does not exist"); - const Fortran::parser::Name *name = - Fortran::semantics::getDesignatorNameIfDataRef(varDesignator->value()); - if (!name) - TODO(converter.getCurrentLocation(), - "Array references as atomic update variable"); - assert(name && name->symbol && - "No symbol attached to atomic update variable"); - if (Fortran::semantics::IsAllocatableOrPointer(name->symbol->GetUltimate())) - converter.bindSymbol(*name->symbol, lhsAddr); - - // Lowering is in two steps : - // subroutine sb - // integer :: a, b - // !$omp atomic update - // a = a + b - // end subroutine - // - // 1. Lower to scf.execute_region_op - // - // func.func @_QPsb() { - // %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"} - // %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"} - // %2 = scf.execute_region -> i32 { - // %3 = fir.load %0 : !fir.ref - // %4 = fir.load %1 : !fir.ref - // %5 = arith.addi %3, %4 : i32 - // scf.yield %5 : i32 - // } - // return - // } - auto tempOp = - firOpBuilder.create(currentLocation, varType); - firOpBuilder.createBlock(&tempOp.getRegion()); - mlir::Block &block = tempOp.getRegion().back(); - firOpBuilder.setInsertionPointToEnd(&block); - Fortran::lower::StatementContext stmtCtx; - mlir::Value rhsExpr = fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(assignmentStmtExpr), stmtCtx)); - mlir::Value convertResult = - firOpBuilder.createConvert(currentLocation, varType, rhsExpr); - // Insert the terminator: YieldOp. - firOpBuilder.create(currentLocation, convertResult); - firOpBuilder.setInsertionPointToStart(&block); - - // 2. Create the omp.atomic.update Operation using the Operations in the - // temporary scf.execute_region Operation. - // - // func.func @_QPsb() { - // %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"} - // %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"} - // %2 = fir.load %1 : !fir.ref - // omp.atomic.update %0 : !fir.ref { - // ^bb0(%arg0: i32): - // %3 = fir.load %1 : !fir.ref - // %4 = arith.addi %arg0, %3 : i32 - // omp.yield(%3 : i32) - // } - // return - // } - mlir::Value updateVar = converter.getSymbolAddress(*name->symbol); - if (auto decl = updateVar.getDefiningOp()) - updateVar = decl.getBase(); - - firOpBuilder.setInsertionPointAfter(tempOp); - auto atomicUpdateOp = firOpBuilder.create( - currentLocation, updateVar, hint, memoryOrder); - - llvm::SmallVector varTys = {varType}; - llvm::SmallVector locs = {currentLocation}; - firOpBuilder.createBlock(&atomicUpdateOp.getRegion(), {}, varTys, locs); - mlir::Value val = - fir::getBase(atomicUpdateOp.getRegion().front().getArgument(0)); - - llvm::SmallVector ops; - for (mlir::Operation &op : tempOp.getRegion().getOps()) - ops.push_back(&op); - - // SCF Yield is converted to OMP Yield. All other operations are copied - for (mlir::Operation *op : ops) { - if (auto y = mlir::dyn_cast(op)) { - firOpBuilder.setInsertionPointToEnd(&atomicUpdateOp.getRegion().front()); - firOpBuilder.create(currentLocation, y.getResults()); - op->erase(); - } else { - op->remove(); - atomicUpdateOp.getRegion().front().push_back(op); - } - } - - // Remove the load and replace all uses of load with the block argument - for (mlir::Operation &op : atomicUpdateOp.getRegion().getOps()) { - fir::LoadOp y = mlir::dyn_cast(&op); - if (y && y.getMemref() == updateVar) - y.getRes().replaceAllUsesWith(val); - } - - tempOp.erase(); -} - -static void -genOmpAtomicWrite(Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OmpAtomicWrite &atomicWrite) { - // Get the value and address of atomic write operands. - const Fortran::parser::OmpAtomicClauseList &rightHandClauseList = - std::get<2>(atomicWrite.t); - const Fortran::parser::OmpAtomicClauseList &leftHandClauseList = - std::get<0>(atomicWrite.t); - const Fortran::parser::AssignmentStmt &stmt = - std::get<3>(atomicWrite.t).statement; - const Fortran::evaluate::Assignment &assign = *stmt.typedAssignment->v; - Fortran::lower::StatementContext stmtCtx; - // Get the value and address of atomic write operands. - mlir::Value rhsExpr = - fir::getBase(converter.genExprValue(assign.rhs, stmtCtx)); - mlir::Value lhsAddr = - fir::getBase(converter.genExprAddr(assign.lhs, stmtCtx)); - genOmpAtomicWriteStatement(converter, eval, lhsAddr, rhsExpr, - &leftHandClauseList, &rightHandClauseList); -} - -static void genOmpAtomicRead(Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OmpAtomicRead &atomicRead) { - // Get the address of atomic read operands. - const Fortran::parser::OmpAtomicClauseList &rightHandClauseList = - std::get<2>(atomicRead.t); - const Fortran::parser::OmpAtomicClauseList &leftHandClauseList = - std::get<0>(atomicRead.t); - const auto &assignmentStmtExpr = - std::get(std::get<3>(atomicRead.t).statement.t); - const auto &assignmentStmtVariable = std::get( - std::get<3>(atomicRead.t).statement.t); - - Fortran::lower::StatementContext stmtCtx; - const Fortran::semantics::SomeExpr &fromExpr = - *Fortran::semantics::GetExpr(assignmentStmtExpr); - mlir::Type elementType = converter.genType(fromExpr); - mlir::Value fromAddress = - fir::getBase(converter.genExprAddr(fromExpr, stmtCtx)); - mlir::Value toAddress = fir::getBase(converter.genExprAddr( - *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)); - genOmpAtomicCaptureStatement(converter, eval, fromAddress, toAddress, - &leftHandClauseList, &rightHandClauseList, - elementType); -} - -static void -genOmpAtomicUpdate(Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OmpAtomicUpdate &atomicUpdate) { - const Fortran::parser::OmpAtomicClauseList &rightHandClauseList = - std::get<2>(atomicUpdate.t); - const Fortran::parser::OmpAtomicClauseList &leftHandClauseList = - std::get<0>(atomicUpdate.t); - const auto &assignmentStmtExpr = - std::get(std::get<3>(atomicUpdate.t).statement.t); - const auto &assignmentStmtVariable = std::get( - std::get<3>(atomicUpdate.t).statement.t); - - Fortran::lower::StatementContext stmtCtx; - mlir::Value lhsAddr = fir::getBase(converter.genExprAddr( - *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)); - mlir::Type varType = - fir::getBase( - converter.genExprValue( - *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)) - .getType(); - genOmpAtomicUpdateStatement(converter, eval, lhsAddr, varType, - assignmentStmtVariable, assignmentStmtExpr, - &leftHandClauseList, &rightHandClauseList); -} - -static void genOmpAtomic(Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OmpAtomic &atomicConstruct) { - const Fortran::parser::OmpAtomicClauseList &atomicClauseList = - std::get(atomicConstruct.t); - const auto &assignmentStmtExpr = std::get( - std::get>( - atomicConstruct.t) - .statement.t); - const auto &assignmentStmtVariable = std::get( - std::get>( - atomicConstruct.t) - .statement.t); - Fortran::lower::StatementContext stmtCtx; - mlir::Value lhsAddr = fir::getBase(converter.genExprAddr( - *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)); - mlir::Type varType = - fir::getBase( - converter.genExprValue( - *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx)) - .getType(); - // If atomic-clause is not present on the construct, the behaviour is as if - // the update clause is specified - genOmpAtomicUpdateStatement(converter, eval, lhsAddr, varType, - assignmentStmtVariable, assignmentStmtExpr, - &atomicClauseList, nullptr); -} - -static void -genOmpAtomicCapture(Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &eval, - const Fortran::parser::OmpAtomicCapture &atomicCapture) { - fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); - mlir::Location currentLocation = converter.getCurrentLocation(); - - mlir::IntegerAttr hint = nullptr; - mlir::omp::ClauseMemoryOrderKindAttr memoryOrder = nullptr; - const Fortran::parser::OmpAtomicClauseList &rightHandClauseList = - std::get<2>(atomicCapture.t); - const Fortran::parser::OmpAtomicClauseList &leftHandClauseList = - std::get<0>(atomicCapture.t); - genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint, - memoryOrder); - genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint, - memoryOrder); - - const Fortran::parser::AssignmentStmt &stmt1 = - std::get<3>(atomicCapture.t).v.statement; - const auto &stmt1Var{std::get(stmt1.t)}; - const auto &stmt1Expr{std::get(stmt1.t)}; - const Fortran::parser::AssignmentStmt &stmt2 = - std::get<4>(atomicCapture.t).v.statement; - const auto &stmt2Var{std::get(stmt2.t)}; - const auto &stmt2Expr{std::get(stmt2.t)}; - - // Pre-evaluate expressions to be used in the various operations inside - // `omp.atomic.capture` since it is not desirable to have anything other than - // a `omp.atomic.read`, `omp.atomic.write`, or `omp.atomic.update` operation - // inside `omp.atomic.capture` - Fortran::lower::StatementContext stmtCtx; - mlir::Value stmt1LHSArg, stmt1RHSArg, stmt2LHSArg, stmt2RHSArg; - mlir::Type elementType; - // LHS evaluations are common to all combinations of `omp.atomic.capture` - stmt1LHSArg = fir::getBase( - converter.genExprAddr(*Fortran::semantics::GetExpr(stmt1Var), stmtCtx)); - stmt2LHSArg = fir::getBase( - converter.genExprAddr(*Fortran::semantics::GetExpr(stmt2Var), stmtCtx)); - - // Operation specific RHS evaluations - if (checkForSingleVariableOnRHS(stmt1)) { - // Atomic capture construct is of the form [capture-stmt, update-stmt] or - // of the form [capture-stmt, write-stmt] - stmt1RHSArg = fir::getBase(converter.genExprAddr( - *Fortran::semantics::GetExpr(stmt1Expr), stmtCtx)); - stmt2RHSArg = fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(stmt2Expr), stmtCtx)); - - } else { - // Atomic capture construct is of the form [update-stmt, capture-stmt] - stmt1RHSArg = fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(stmt1Expr), stmtCtx)); - stmt2RHSArg = fir::getBase(converter.genExprAddr( - *Fortran::semantics::GetExpr(stmt2Expr), stmtCtx)); - } - // Type information used in generation of `omp.atomic.update` operation - mlir::Type stmt1VarType = - fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(stmt1Var), stmtCtx)) - .getType(); - mlir::Type stmt2VarType = - fir::getBase(converter.genExprValue( - *Fortran::semantics::GetExpr(stmt2Var), stmtCtx)) - .getType(); - - auto atomicCaptureOp = firOpBuilder.create( - currentLocation, hint, memoryOrder); - firOpBuilder.createBlock(&atomicCaptureOp.getRegion()); - mlir::Block &block = atomicCaptureOp.getRegion().back(); - firOpBuilder.setInsertionPointToStart(&block); - if (checkForSingleVariableOnRHS(stmt1)) { - if (checkForSymbolMatch(stmt2)) { - // Atomic capture construct is of the form [capture-stmt, update-stmt] - const Fortran::semantics::SomeExpr &fromExpr = - *Fortran::semantics::GetExpr(stmt1Expr); - elementType = converter.genType(fromExpr); - genOmpAtomicCaptureStatement(converter, eval, stmt1RHSArg, stmt1LHSArg, - /*leftHandClauseList=*/nullptr, - /*rightHandClauseList=*/nullptr, - elementType); - genOmpAtomicUpdateStatement(converter, eval, stmt1RHSArg, stmt2VarType, - stmt2Var, stmt2Expr, - /*leftHandClauseList=*/nullptr, - /*rightHandClauseList=*/nullptr); - } else { - // Atomic capture construct is of the form [capture-stmt, write-stmt] - const Fortran::semantics::SomeExpr &fromExpr = - *Fortran::semantics::GetExpr(stmt1Expr); - elementType = converter.genType(fromExpr); - genOmpAtomicCaptureStatement(converter, eval, stmt1RHSArg, stmt1LHSArg, - /*leftHandClauseList=*/nullptr, - /*rightHandClauseList=*/nullptr, - elementType); - genOmpAtomicWriteStatement(converter, eval, stmt1RHSArg, stmt2RHSArg, - /*leftHandClauseList=*/nullptr, - /*rightHandClauseList=*/nullptr); - } - } else { - // Atomic capture construct is of the form [update-stmt, capture-stmt] - firOpBuilder.setInsertionPointToEnd(&block); - const Fortran::semantics::SomeExpr &fromExpr = - *Fortran::semantics::GetExpr(stmt2Expr); - elementType = converter.genType(fromExpr); - genOmpAtomicCaptureStatement(converter, eval, stmt1LHSArg, stmt2LHSArg, - /*leftHandClauseList=*/nullptr, - /*rightHandClauseList=*/nullptr, elementType); - firOpBuilder.setInsertionPointToStart(&block); - genOmpAtomicUpdateStatement(converter, eval, stmt1LHSArg, stmt1VarType, - stmt1Var, stmt1Expr, - /*leftHandClauseList=*/nullptr, - /*rightHandClauseList=*/nullptr); - } - firOpBuilder.setInsertionPointToEnd(&block); - firOpBuilder.create(currentLocation); - firOpBuilder.setInsertionPointToStart(&block); -} - static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) { - std::visit(Fortran::common::visitors{ - [&](const Fortran::parser::OmpAtomicRead &atomicRead) { - genOmpAtomicRead(converter, eval, atomicRead); - }, - [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) { - genOmpAtomicWrite(converter, eval, atomicWrite); - }, - [&](const Fortran::parser::OmpAtomic &atomicConstruct) { - genOmpAtomic(converter, eval, atomicConstruct); - }, - [&](const Fortran::parser::OmpAtomicUpdate &atomicUpdate) { - genOmpAtomicUpdate(converter, eval, atomicUpdate); - }, - [&](const Fortran::parser::OmpAtomicCapture &atomicCapture) { - genOmpAtomicCapture(converter, eval, atomicCapture); - }, - }, - atomicConstruct.u); + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::OmpAtomicRead &atomicRead) { + Fortran::lower::genOmpAccAtomicRead< + Fortran::parser::OmpAtomicRead, + Fortran::parser::OmpAtomicClauseList>(converter, atomicRead); + }, + [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) { + Fortran::lower::genOmpAccAtomicWrite< + Fortran::parser::OmpAtomicWrite, + Fortran::parser::OmpAtomicClauseList>(converter, atomicWrite); + }, + [&](const Fortran::parser::OmpAtomic &atomicConstruct) { + Fortran::lower::genOmpAtomic( + converter, atomicConstruct); + }, + [&](const Fortran::parser::OmpAtomicUpdate &atomicUpdate) { + Fortran::lower::genOmpAccAtomicUpdate< + Fortran::parser::OmpAtomicUpdate, + Fortran::parser::OmpAtomicClauseList>(converter, atomicUpdate); + }, + [&](const Fortran::parser::OmpAtomicCapture &atomicCapture) { + Fortran::lower::genOmpAccAtomicCapture< + Fortran::parser::OmpAtomicCapture, + Fortran::parser::OmpAtomicClauseList>(converter, atomicCapture); + }, + }, + atomicConstruct.u); } static void genOMP(Fortran::lower::AbstractConverter &converter, diff --git a/flang/test/Lower/OpenACC/acc-atomic-capture.f90 b/flang/test/Lower/OpenACC/acc-atomic-capture.f90 new file mode 100644 index 0000000000000..1a5fe8d57c153 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-atomic-capture.f90 @@ -0,0 +1,99 @@ +! RUN: %flang_fc1 -emit-fir -fopenacc %s -o - | FileCheck %s + +! This test checks the lowering of atomic capture + +program acc_atomic_capture_test + integer :: x, y + +!CHECK: %[[X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFEx"} +!CHECK: %[[Y:.*]] = fir.alloca i32 {bindc_name = "y", uniq_name = "_QFEy"} +!CHECK: acc.atomic.capture { +!CHECK: acc.atomic.read %[[X]] = %[[Y]] : !fir.ref +!CHECK: acc.atomic.update %[[Y]] : !fir.ref { +!CHECK: ^bb0(%[[ARG:.*]]: i32): +!CHECK: %[[temp:.*]] = fir.load %[[X]] : !fir.ref +!CHECK: %[[result:.*]] = arith.addi %[[temp]], %[[ARG]] : i32 +!CHECK: acc.yield %[[result]] : i32 +!CHECK: } +!CHECK: } + + !$acc atomic capture + x = y + y = x + y + !$acc end atomic + + +!CHECK: acc.atomic.capture { +!CHECK: acc.atomic.update %[[Y]] : !fir.ref { +!CHECK: ^bb0(%[[ARG:.*]]: i32): +!CHECK: %[[temp:.*]] = fir.load %[[X]] : !fir.ref +!CHECK: %[[result:.*]] = arith.muli %[[temp]], %[[ARG]] : i32 +!CHECK: acc.yield %[[result]] : i32 +!CHECK: } +!CHECK: acc.atomic.read %[[X]] = %[[Y]] : !fir.ref +!CHECK: } + + !$acc atomic capture + y = x * y + x = y + !$acc end atomic + +!CHECK: %[[constant_20:.*]] = arith.constant 20 : i32 +!CHECK: %[[constant_8:.*]] = arith.constant 8 : i32 +!CHECK: %[[temp:.*]] = fir.load %[[X]] : !fir.ref +!CHECK: %[[result:.*]] = arith.subi %[[constant_8]], %[[temp]] : i32 +!CHECK: %[[result_noreassoc:.*]] = fir.no_reassoc %[[result]] : i32 +!CHECK: %[[result:.*]] = arith.addi %[[constant_20]], %[[result_noreassoc]] : i32 +!CHECK: acc.atomic.capture { +!CHECK: acc.atomic.read %[[X]] = %[[Y]] : !fir.ref +!CHECK: acc.atomic.write %[[Y]] = %[[result]] : !fir.ref, i32 +!CHECK: } + + !$acc atomic capture + x = y + y = 2 * 10 + (8 - x) + !$acc end atomic +end program + + + +subroutine pointers_in_atomic_capture() +!CHECK: %[[A:.*]] = fir.alloca !fir.box> {bindc_name = "a", uniq_name = "_QFpointers_in_atomic_captureEa"} +!CHECK: {{.*}} = fir.zero_bits !fir.ptr +!CHECK: {{.*}} = fir.embox {{.*}} : (!fir.ptr) -> !fir.box> +!CHECK: fir.store {{.*}} to %[[A]] : !fir.ref>> +!CHECK: %[[B:.*]] = fir.alloca !fir.box> {bindc_name = "b", uniq_name = "_QFpointers_in_atomic_captureEb"} +!CHECK: {{.*}} = fir.zero_bits !fir.ptr +!CHECK: {{.*}} = fir.embox {{.*}} : (!fir.ptr) -> !fir.box> +!CHECK: fir.store {{.*}} to %[[B]] : !fir.ref>> +!CHECK: %[[C:.*]] = fir.alloca i32 {bindc_name = "c", fir.target, uniq_name = "_QFpointers_in_atomic_captureEc"} +!CHECK: %[[D:.*]] = fir.alloca i32 {bindc_name = "d", fir.target, uniq_name = "_QFpointers_in_atomic_captureEd"} +!CHECK: {{.*}} = fir.embox {{.*}} : (!fir.ref) -> !fir.box> +!CHECK: fir.store {{.*}} to %[[A]] : !fir.ref>> +!CHECK: {{.*}} = fir.embox {{.*}} : (!fir.ref) -> !fir.box> +!CHECK: fir.store {{.*}} to %[[B]] : !fir.ref>> +!CHECK: %[[loaded_A:.*]] = fir.load %[[A]] : !fir.ref>> +!CHECK: %[[loaded_A_addr:.*]] = fir.box_addr %[[loaded_A]] : (!fir.box>) -> !fir.ptr +!CHECK: %[[loaded_B:.*]] = fir.load %[[B]] : !fir.ref>> +!CHECK: %[[loaded_B_addr:.*]] = fir.box_addr %[[loaded_B]] : (!fir.box>) -> !fir.ptr +!CHECK: acc.atomic.capture { +!CHECK: acc.atomic.update %[[loaded_A_addr]] : !fir.ptr { +!CHECK: ^bb0(%[[ARG:.*]]: i32): +!CHECK: %[[PRIVATE_LOADED_B:.*]] = fir.load %[[B]] : !fir.ref>> +!CHECK: %[[PRIVATE_LOADED_B_addr:.*]] = fir.box_addr %[[PRIVATE_LOADED_B]] : (!fir.box>) -> !fir.ptr +!CHECK: %[[loaded_value:.*]] = fir.load %[[PRIVATE_LOADED_B_addr]] : !fir.ptr +!CHECK: %[[result:.*]] = arith.addi %[[ARG]], %[[loaded_value]] : i32 +!CHECK: acc.yield %[[result]] : i32 +!CHECK: } +!CHECK: acc.atomic.read %[[loaded_B_addr]] = %[[loaded_A_addr]] : !fir.ptr, i32 +!CHECK: } + integer, pointer :: a, b + integer, target :: c, d + a=>c + b=>d + + !$acc atomic capture + a = a + b + b = a + !$acc end atomic +end subroutine diff --git a/flang/test/Lower/OpenACC/acc-atomic-read.f90 b/flang/test/Lower/OpenACC/acc-atomic-read.f90 new file mode 100644 index 0000000000000..28f0ce44e6f41 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-atomic-read.f90 @@ -0,0 +1,48 @@ +! RUN: bbc --use-desc-for-alloc=false -fopenacc -emit-fir %s -o - | FileCheck %s + +! This test checks the lowering of atomic read + +!CHECK: func @_QQmain() attributes {fir.bindc_name = "acc_atomic_test"} { +!CHECK: %[[VAR_G:.*]] = fir.alloca f32 {bindc_name = "g", uniq_name = "_QFEg"} +!CHECK: %[[VAR_H:.*]] = fir.alloca f32 {bindc_name = "h", uniq_name = "_QFEh"} +!CHECK: acc.atomic.read %[[VAR_G]] = %[[VAR_H]] : !fir.ref, f32 +!CHECK: return +!CHECK: } + +program acc_atomic_test + real g, h + !$acc atomic read + g = h +end program acc_atomic_test + +! Test lowering atomic read for pointer variables. +! Please notice to use %[[VAL_4]] and %[[VAL_1]] for operands of atomic +! operation, instead of %[[VAL_3]] and %[[VAL_0]]. + +!CHECK-LABEL: func.func @_QPatomic_read_pointer() { +!CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "x", uniq_name = "_QFatomic_read_pointerEx"} +!CHECK: %[[VAL_1:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFatomic_read_pointerEx.addr"} +!CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr +!CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref> +!CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box> {bindc_name = "y", uniq_name = "_QFatomic_read_pointerEy"} +!CHECK: %[[VAL_4:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFatomic_read_pointerEy.addr"} +!CHECK: %[[VAL_5:.*]] = fir.zero_bits !fir.ptr +!CHECK: fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref> +!CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref> +!CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_4]] : !fir.ref> +!CHECK: acc.atomic.read %[[VAL_7]] = %[[VAL_6]] : !fir.ptr, i32 +!CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_4]] : !fir.ref> +!CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ptr +!CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref> +!CHECK: fir.store %[[VAL_9]] to %[[VAL_10]] : !fir.ptr +!CHECK: return +!CHECK: } + +subroutine atomic_read_pointer() + integer, pointer :: x, y + + !$acc atomic read + y = x + + x = y +end diff --git a/flang/test/Lower/OpenACC/acc-atomic-update-hlfir.f90 b/flang/test/Lower/OpenACC/acc-atomic-update-hlfir.f90 new file mode 100644 index 0000000000000..24dd0ee5a8999 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-atomic-update-hlfir.f90 @@ -0,0 +1,23 @@ +! This test checks lowering of atomic and atomic update constructs with HLFIR +! RUN: bbc -hlfir -fopenacc -emit-hlfir %s -o - | FileCheck %s +! RUN: %flang_fc1 -flang-experimental-hlfir -emit-hlfir -fopenacc %s -o - | FileCheck %s + +subroutine sb + integer :: x, y + + !$acc atomic update + x = x + y +end subroutine + +!CHECK-LABEL: @_QPsb +!CHECK: %[[X_REF:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFsbEx"} +!CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X_REF]] {uniq_name = "_QFsbEx"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %[[Y_REF:.*]] = fir.alloca i32 {bindc_name = "y", uniq_name = "_QFsbEy"} +!CHECK: %[[Y_DECL:.*]]:2 = hlfir.declare %[[Y_REF]] {uniq_name = "_QFsbEy"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: acc.atomic.update %[[X_DECL]]#0 : !fir.ref { +!CHECK: ^bb0(%[[ARG_X:.*]]: i32): +!CHECK: %[[Y_VAL:.*]] = fir.load %[[Y_DECL]]#0 : !fir.ref +!CHECK: %[[X_UPDATE_VAL:.*]] = arith.addi %[[ARG_X]], %[[Y_VAL]] : i32 +!CHECK: acc.yield %[[X_UPDATE_VAL]] : i32 +!CHECK: } +!CHECK: return diff --git a/flang/test/Lower/OpenACC/acc-atomic-update.f90 b/flang/test/Lower/OpenACC/acc-atomic-update.f90 new file mode 100644 index 0000000000000..546d012982e23 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-atomic-update.f90 @@ -0,0 +1,74 @@ +! This test checks lowering of atomic and atomic update constructs +! RUN: bbc --use-desc-for-alloc=false -fopenacc -emit-fir %s -o - | FileCheck %s +! RUN: %flang_fc1 -mllvm --use-desc-for-alloc=false -emit-fir -fopenacc %s -o - | FileCheck %s + +program acc_atomic_update_test + integer :: x, y, z + integer, pointer :: a, b + integer, target :: c, d + integer(1) :: i1 + + a=>c + b=>d + +!CHECK: func.func @_QQmain() attributes {fir.bindc_name = "acc_atomic_update_test"} { +!CHECK: %[[A:.*]] = fir.alloca !fir.box> {bindc_name = "a", uniq_name = "_QFEa"} +!CHECK: %[[A_ADDR:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFEa.addr"} +!CHECK: %{{.*}} = fir.zero_bits !fir.ptr +!CHECK: fir.store %{{.*}} to %[[A_ADDR]] : !fir.ref> +!CHECK: %[[B:.*]] = fir.alloca !fir.box> {bindc_name = "b", uniq_name = "_QFEb"} +!CHECK: %[[B_ADDR:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFEb.addr"} +!CHECK: %{{.*}} = fir.zero_bits !fir.ptr +!CHECK: fir.store %{{.*}} to %[[B_ADDR]] : !fir.ref> +!CHECK: %[[C_ADDR:.*]] = fir.address_of(@_QFEc) : !fir.ref +!CHECK: %[[D_ADDR:.*]] = fir.address_of(@_QFEd) : !fir.ref +!CHECK: %[[I1:.*]] = fir.alloca i8 {bindc_name = "i1", uniq_name = "_QFEi1"} +!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: %{{.*}} = fir.convert %[[C_ADDR]] : (!fir.ref) -> !fir.ptr +!CHECK: fir.store %{{.*}} to %[[A_ADDR]] : !fir.ref> +!CHECK: %{{.*}} = fir.convert %[[D_ADDR]] : (!fir.ref) -> !fir.ptr +!CHECK: fir.store {{.*}} to %[[B_ADDR]] : !fir.ref> +!CHECK: %[[LOADED_A:.*]] = fir.load %[[A_ADDR]] : !fir.ref> +!CHECK: acc.atomic.update %[[LOADED_A]] : !fir.ptr { +!CHECK: ^bb0(%[[ARG:.*]]: i32): +!CHECK: %[[LOADED_B:.*]] = fir.load %[[B_ADDR]] : !fir.ref> +!CHECK: %{{.*}} = fir.load %[[LOADED_B]] : !fir.ptr +!CHECK: %[[RESULT:.*]] = arith.addi %[[ARG]], %{{.*}} : i32 +!CHECK: acc.yield %[[RESULT]] : i32 +!CHECK: } + !$acc atomic update + a = a + b + +!CHECK: acc.atomic.update %[[Y]] : !fir.ref { +!CHECK: ^bb0(%[[ARG:.*]]: i32): +!CHECK: {{.*}} = arith.constant 1 : i32 +!CHECK: %[[RESULT:.*]] = arith.addi %[[ARG]], {{.*}} : i32 +!CHECK: acc.yield %[[RESULT]] : i32 +!CHECK: } +!CHECK: acc.atomic.update %[[Z]] : !fir.ref { +!CHECK: ^bb0(%[[ARG:.*]]: i32): +!CHECK: %[[LOADED_X:.*]] = fir.load %[[X]] : !fir.ref +!CHECK: %[[RESULT:.*]] = arith.muli %[[LOADED_X]], %[[ARG]] : i32 +!CHECK: acc.yield %[[RESULT]] : i32 +!CHECK: } + !$acc atomic + y = y + 1 + !$acc atomic update + z = x * z + +!CHECK: acc.atomic.update %[[I1]] : !fir.ref { +!CHECK: ^bb0(%[[VAL:.*]]: i8): +!CHECK: %[[CVT_VAL:.*]] = fir.convert %[[VAL]] : (i8) -> i32 +!CHECK: %[[C1_VAL:.*]] = arith.constant 1 : i32 +!CHECK: %[[ADD_VAL:.*]] = arith.addi %[[CVT_VAL]], %[[C1_VAL]] : i32 +!CHECK: %[[UPDATED_VAL:.*]] = fir.convert %[[ADD_VAL]] : (i32) -> i8 +!CHECK: acc.yield %[[UPDATED_VAL]] : i8 +!CHECK: } + !$acc atomic + i1 = i1 + 1 + !$acc end atomic +!CHECK: return +!CHECK: } +end program acc_atomic_update_test diff --git a/flang/test/Lower/OpenACC/acc-atomic-write.f90 b/flang/test/Lower/OpenACC/acc-atomic-write.f90 new file mode 100644 index 0000000000000..e68aaac3d3858 --- /dev/null +++ b/flang/test/Lower/OpenACC/acc-atomic-write.f90 @@ -0,0 +1,57 @@ +! RUN: bbc --use-desc-for-alloc=false -fopenacc -emit-fir %s -o - | FileCheck %s + +! This test checks the lowering of atomic write + +!CHECK: func @_QQmain() attributes {fir.bindc_name = "acc_atomic_write_test"} { +!CHECK: %[[VAR_X:.*]] = fir.alloca i32 {bindc_name = "x", uniq_name = "_QFEx"} +!CHECK: %[[VAR_Y:.*]] = fir.alloca i32 {bindc_name = "y", uniq_name = "_QFEy"} +!CHECK: %[[CONST_7:.*]] = arith.constant 7 : i32 +!CHECK: {{.*}} = fir.load %[[VAR_Y]] : !fir.ref +!CHECK: %[[VAR_7y:.*]] = arith.muli %[[CONST_7]], {{.*}} : i32 +!CHECK: acc.atomic.write %[[VAR_X]] = %[[VAR_7y]] : !fir.ref, i32 +!CHECK: return +!CHECK: } + +program acc_atomic_write_test + integer :: x, y + + !$acc atomic write + x = 7 * y + +end program acc_atomic_write_test + +! Test lowering atomic read for pointer variables. + +!CHECK-LABEL: func.func @_QPatomic_write_pointer() { +!CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "x", uniq_name = "_QFatomic_write_pointerEx"} +!CHECK: %[[VAL_1:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFatomic_write_pointerEx.addr"} +!CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr +!CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref> +!CHECK: %[[VAL_3:.*]] = arith.constant 1 : i32 +!CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]] : !fir.ref> +!CHECK: acc.atomic.write %[[VAL_4]] = %[[VAL_3]] : !fir.ptr, i32 +!CHECK: %[[VAL_5:.*]] = arith.constant 2 : i32 +!CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref> +!CHECK: fir.store %[[VAL_5]] to %[[VAL_6]] : !fir.ptr +!CHECK: return +!CHECK: } + +subroutine atomic_write_pointer() + integer, pointer :: x + + !$acc atomic write + x = 1 + + x = 2 +end subroutine + +!CHECK-LABEL: func.func @_QPatomic_write_typed_assign +!CHECK: %[[VAR:.*]] = fir.alloca f32 {bindc_name = "r2", uniq_name = "{{.*}}r2"} +!CHECK: %[[CST:.*]] = arith.constant 0.000000e+00 : f32 +!CHECK: acc.atomic.write %[[VAR]] = %[[CST]] : !fir.ref, f32 + +subroutine atomic_write_typed_assign + real :: r2 + !$acc atomic write + r2 = 0 +end subroutine