//===-- 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/Evaluate/tools.h" #include "flang/Lower/AbstractConverter.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/Lower/Support/Utils.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 "mlir/IR/Value.h" #include "llvm/Frontend/OpenMP/OMPConstants.h" #include #include namespace Fortran { namespace lower { /// Information gathered to generate bounds operation and data entry/exit /// operations. struct AddrAndBoundsInfo { explicit AddrAndBoundsInfo() {} explicit AddrAndBoundsInfo(mlir::Value addr) : addr(addr) {} explicit AddrAndBoundsInfo(mlir::Value addr, mlir::Value isPresent) : addr(addr), isPresent(isPresent) {} mlir::Value addr = nullptr; mlir::Value isPresent = nullptr; }; /// 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); return designator != 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, mlir::Location loc) { // Generate `atomic.read` operation for atomic assigment statements fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); 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( loc, fromAddress, toAddress, mlir::TypeAttr::get(elementType), hint, memoryOrder); } else { firOpBuilder.create( loc, 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::Location loc, mlir::Value *evaluatedExprValue = nullptr) { // Generate `atomic.write` operation for atomic assignment statements fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); 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(loc, lhsAddr, rhsExpr, hint, memoryOrder); } else { firOpBuilder.create(loc, 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, mlir::Location loc, mlir::Operation *atomicCaptureOp = nullptr) { // Generate `atomic.update` operation for atomic assignment statements fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Location currentLocation = converter.getCurrentLocation(); // Create the omp.atomic.update or acc.atomic.update 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 = arith.addi %arg0, %2 : i32 // omp.yield(%3 : i32) // } // return // } auto getArgExpression = [](std::list::const_iterator it) { const auto &arg{std::get((*it).t)}; const auto *parserExpr{ std::get_if>(&arg.u)}; return parserExpr; }; // Lower any non atomic sub-expression before the atomic operation, and // map its lowered value to the semantic representation. Fortran::lower::ExprToValueMap exprValueOverrides; // Max and min intrinsics can have a list of Args. Hence we need a list // of nonAtomicSubExprs to hoist. Currently, only the load is hoisted. llvm::SmallVector nonAtomicSubExprs; Fortran::common::visit( Fortran::common::visitors{ [&](const common::Indirection &funcRef) -> void { const auto &args{std::get>( funcRef.value().v.t)}; std::list::const_iterator beginIt = args.begin(); std::list::const_iterator endIt = args.end(); const auto *exprFirst{getArgExpression(beginIt)}; if (exprFirst && exprFirst->value().source == assignmentStmtVariable.GetSource()) { // Add everything except the first beginIt++; } else { // Add everything except the last endIt--; } std::list::const_iterator it; for (it = beginIt; it != endIt; it++) { const common::Indirection *expr = getArgExpression(it); if (expr) nonAtomicSubExprs.push_back(Fortran::semantics::GetExpr(*expr)); } }, [&](const auto &op) -> void { using T = std::decay_t; if constexpr (std::is_base_of< Fortran::parser::Expr::IntrinsicBinary, T>::value) { const auto &exprLeft{std::get<0>(op.t)}; const auto &exprRight{std::get<1>(op.t)}; if (exprLeft.value().source == assignmentStmtVariable.GetSource()) nonAtomicSubExprs.push_back( Fortran::semantics::GetExpr(exprRight)); else nonAtomicSubExprs.push_back( Fortran::semantics::GetExpr(exprLeft)); } }, }, assignmentStmtExpr.u); StatementContext nonAtomicStmtCtx; if (!nonAtomicSubExprs.empty()) { // Generate non atomic part before all the atomic operations. auto insertionPoint = firOpBuilder.saveInsertionPoint(); if (atomicCaptureOp) firOpBuilder.setInsertionPoint(atomicCaptureOp); mlir::Value nonAtomicVal; for (auto *nonAtomicSubExpr : nonAtomicSubExprs) { nonAtomicVal = fir::getBase(converter.genExprValue( currentLocation, *nonAtomicSubExpr, nonAtomicStmtCtx)); exprValueOverrides.try_emplace(nonAtomicSubExpr, nonAtomicVal); } if (atomicCaptureOp) firOpBuilder.restoreInsertionPoint(insertionPoint); } 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, lhsAddr, hint, memoryOrder); } else { atomicUpdateOp = firOpBuilder.create( currentLocation, lhsAddr); } 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)); exprValueOverrides.try_emplace( Fortran::semantics::GetExpr(assignmentStmtVariable), val); { // statement context inside the atomic block. converter.overrideExprValues(&exprValueOverrides); Fortran::lower::StatementContext atomicStmtCtx; mlir::Value rhsExpr = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(assignmentStmtExpr), atomicStmtCtx)); mlir::Value convertResult = firOpBuilder.createConvert(currentLocation, varType, rhsExpr); if constexpr (std::is_same()) { firOpBuilder.create(currentLocation, convertResult); } else { firOpBuilder.create(currentLocation, convertResult); } converter.resetExprOverrides(); } firOpBuilder.setInsertionPointAfter(atomicUpdateOp); } /// Processes an atomic construct with write clause. template void genOmpAccAtomicWrite(Fortran::lower::AbstractConverter &converter, const AtomicT &atomicWrite, mlir::Location loc) { 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, loc); } /// Processes an atomic construct with read clause. template void genOmpAccAtomicRead(Fortran::lower::AbstractConverter &converter, const AtomicT &atomicRead, mlir::Location loc) { 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)); fir::FirOpBuilder &builder = converter.getFirOpBuilder(); if (fromAddress.getType() != toAddress.getType()) fromAddress = builder.create(loc, toAddress.getType(), fromAddress); genOmpAccAtomicCaptureStatement(converter, fromAddress, toAddress, leftHandClauseList, rightHandClauseList, elementType, loc); } /// Processes an atomic construct with update clause. template void genOmpAccAtomicUpdate(Fortran::lower::AbstractConverter &converter, const AtomicT &atomicUpdate, mlir::Location loc) { 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::unwrapRefType(lhsAddr.getType()); genOmpAccAtomicUpdateStatement( converter, lhsAddr, varType, assignmentStmtVariable, assignmentStmtExpr, leftHandClauseList, rightHandClauseList, loc); } /// Processes an atomic construct with no clause - which implies update clause. template void genOmpAtomic(Fortran::lower::AbstractConverter &converter, const AtomicT &atomicConstruct, mlir::Location loc) { 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::unwrapRefType(lhsAddr.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, loc); } /// Processes an atomic construct with capture clause. template void genOmpAccAtomicCapture(Fortran::lower::AbstractConverter &converter, const AtomicT &atomicCapture, mlir::Location loc) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); const Fortran::parser::AssignmentStmt &stmt1 = std::get(atomicCapture.t).v.statement; const Fortran::evaluate::Assignment &assign1 = *stmt1.typedAssignment->v; 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 Fortran::evaluate::Assignment &assign2 = *stmt2.typedAssignment->v; 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(assign1.lhs, stmtCtx)); stmt2LHSArg = fir::getBase(converter.genExprAddr(assign2.lhs, 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(assign1.rhs, stmtCtx)); stmt2RHSArg = fir::getBase(converter.genExprValue(assign2.rhs, stmtCtx)); } else { // Atomic capture construct is of the form [update-stmt, capture-stmt] stmt1RHSArg = fir::getBase(converter.genExprValue(assign1.rhs, stmtCtx)); stmt2RHSArg = fir::getBase(converter.genExprAddr(assign2.lhs, stmtCtx)); } // Type information used in generation of `atomic.update` operation mlir::Type stmt1VarType = fir::getBase(converter.genExprValue(assign1.lhs, stmtCtx)).getType(); mlir::Type stmt2VarType = fir::getBase(converter.genExprValue(assign2.lhs, 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(loc, hint, memoryOrder); } else { atomicCaptureOp = firOpBuilder.create(loc); } 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, loc); genOmpAccAtomicUpdateStatement( converter, stmt1RHSArg, stmt2VarType, stmt2Var, stmt2Expr, /*leftHandClauseList=*/nullptr, /*rightHandClauseList=*/nullptr, loc, atomicCaptureOp); } 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, loc); genOmpAccAtomicWriteStatement( converter, stmt1RHSArg, stmt2RHSArg, /*leftHandClauseList=*/nullptr, /*rightHandClauseList=*/nullptr, loc); } } 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, loc); firOpBuilder.setInsertionPointToStart(&block); genOmpAccAtomicUpdateStatement( converter, stmt1LHSArg, stmt1VarType, stmt1Var, stmt1Expr, /*leftHandClauseList=*/nullptr, /*rightHandClauseList=*/nullptr, loc, atomicCaptureOp); } firOpBuilder.setInsertionPointToEnd(&block); if constexpr (std::is_same()) { firOpBuilder.create(loc); } else { firOpBuilder.create(loc); } firOpBuilder.setInsertionPointToStart(&block); } /// Create empty blocks for the current region. /// These blocks replace blocks parented to an enclosing region. template void createEmptyRegionBlocks( fir::FirOpBuilder &builder, std::list &evaluationList) { mlir::Region *region = &builder.getRegion(); for (Fortran::lower::pft::Evaluation &eval : evaluationList) { if (eval.block) { if (eval.block->empty()) { eval.block->erase(); eval.block = builder.createBlock(region); } else { [[maybe_unused]] mlir::Operation &terminatorOp = eval.block->back(); assert(mlir::isa(terminatorOp) && "expected terminator op"); } } if (!eval.isDirective() && eval.hasNestedEvaluations()) createEmptyRegionBlocks(builder, eval.getNestedEvaluations()); } } inline AddrAndBoundsInfo getDataOperandBaseAddr(Fortran::lower::AbstractConverter &converter, fir::FirOpBuilder &builder, Fortran::lower::SymbolRef sym, mlir::Location loc) { mlir::Value symAddr = converter.getSymbolAddress(sym); // TODO: Might need revisiting to handle for non-shared clauses if (!symAddr) { if (const auto *details = sym->detailsIf()) symAddr = converter.getSymbolAddress(details->symbol()); } if (!symAddr) llvm::report_fatal_error("could not retrieve symbol address"); if (auto boxTy = fir::unwrapRefType(symAddr.getType()).dyn_cast()) { if (boxTy.getEleTy().isa()) TODO(loc, "derived type"); // Load the box when baseAddr is a `fir.ref>` or a // `fir.ref>` type. if (symAddr.getType().isa()) { if (Fortran::semantics::IsOptional(sym)) { mlir::Value isPresent = builder.create(loc, builder.getI1Type(), symAddr); mlir::Value addr = builder.genIfOp(loc, {boxTy}, isPresent, /*withElseRegion=*/true) .genThen([&]() { mlir::Value load = builder.create(loc, symAddr); builder.create(loc, mlir::ValueRange{load}); }) .genElse([&] { mlir::Value absent = builder.create(loc, boxTy); builder.create(loc, mlir::ValueRange{absent}); }) .getResults()[0]; return AddrAndBoundsInfo(addr, isPresent); } mlir::Value addr = builder.create(loc, symAddr); return AddrAndBoundsInfo(addr); ; } } return AddrAndBoundsInfo(symAddr); } template llvm::SmallVector gatherBoundsOrBoundValues(fir::FirOpBuilder &builder, mlir::Location loc, fir::ExtendedValue dataExv, mlir::Value box, bool collectValuesOnly = false) { llvm::SmallVector values; mlir::Value byteStride; mlir::Type idxTy = builder.getIndexType(); mlir::Type boundTy = builder.getType(); mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); for (unsigned dim = 0; dim < dataExv.rank(); ++dim) { mlir::Value d = builder.createIntegerConstant(loc, idxTy, dim); mlir::Value baseLb = fir::factory::readLowerBound(builder, loc, dataExv, dim, one); auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, box, d); mlir::Value lb = builder.createIntegerConstant(loc, idxTy, 0); mlir::Value ub = builder.create(loc, dimInfo.getExtent(), one); if (dim == 0) // First stride is the element size. byteStride = dimInfo.getByteStride(); if (collectValuesOnly) { values.push_back(lb); values.push_back(ub); values.push_back(dimInfo.getExtent()); values.push_back(byteStride); values.push_back(baseLb); } else { mlir::Value bound = builder.create( loc, boundTy, lb, ub, dimInfo.getExtent(), byteStride, true, baseLb); values.push_back(bound); } // Compute the stride for the next dimension. byteStride = builder.create(loc, byteStride, dimInfo.getExtent()); } return values; } /// Generate the bounds operation from the descriptor information. template llvm::SmallVector genBoundsOpsFromBox(fir::FirOpBuilder &builder, mlir::Location loc, Fortran::lower::AbstractConverter &converter, fir::ExtendedValue dataExv, Fortran::lower::AddrAndBoundsInfo &info) { llvm::SmallVector bounds; mlir::Type idxTy = builder.getIndexType(); mlir::Type boundTy = builder.getType(); assert(info.addr.getType().isa() && "expect fir.box or fir.class"); if (info.isPresent) { llvm::SmallVector resTypes; constexpr unsigned nbValuesPerBound = 5; for (unsigned dim = 0; dim < dataExv.rank() * nbValuesPerBound; ++dim) resTypes.push_back(idxTy); mlir::Operation::result_range ifRes = builder.genIfOp(loc, resTypes, info.isPresent, /*withElseRegion=*/true) .genThen([&]() { llvm::SmallVector boundValues = gatherBoundsOrBoundValues( builder, loc, dataExv, info.addr, /*collectValuesOnly=*/true); builder.create(loc, boundValues); }) .genElse([&] { // Box is not present. Populate bound values with default values. llvm::SmallVector boundValues; mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); mlir::Value mOne = builder.createIntegerConstant(loc, idxTy, -1); for (unsigned dim = 0; dim < dataExv.rank(); ++dim) { boundValues.push_back(zero); // lb boundValues.push_back(mOne); // ub boundValues.push_back(zero); // extent boundValues.push_back(zero); // byteStride boundValues.push_back(zero); // baseLb } builder.create(loc, boundValues); }) .getResults(); // Create the bound operations outside the if-then-else with the if op // results. for (unsigned i = 0; i < ifRes.size(); i += nbValuesPerBound) { mlir::Value bound = builder.create( loc, boundTy, ifRes[i], ifRes[i + 1], ifRes[i + 2], ifRes[i + 3], true, ifRes[i + 4]); bounds.push_back(bound); } } else { bounds = gatherBoundsOrBoundValues( builder, loc, dataExv, info.addr); } return bounds; } /// Generate bounds operation for base array without any subscripts /// provided. template llvm::SmallVector genBaseBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, Fortran::lower::AbstractConverter &converter, fir::ExtendedValue dataExv) { mlir::Type idxTy = builder.getIndexType(); mlir::Type boundTy = builder.getType(); llvm::SmallVector bounds; if (dataExv.rank() == 0) return bounds; mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); for (std::size_t dim = 0; dim < dataExv.rank(); ++dim) { mlir::Value baseLb = fir::factory::readLowerBound(builder, loc, dataExv, dim, one); mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); mlir::Value ub; mlir::Value lb = zero; mlir::Value ext = fir::factory::readExtent(builder, loc, dataExv, dim); if (mlir::isa(ext.getDefiningOp())) { ext = zero; ub = lb; } else { // ub = extent - 1 ub = builder.create(loc, ext, one); } mlir::Value bound = builder.create(loc, boundTy, lb, ub, ext, one, false, baseLb); bounds.push_back(bound); } return bounds; } /// Generate bounds operations for an array section when subscripts are /// provided. template llvm::SmallVector genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc, Fortran::lower::AbstractConverter &converter, Fortran::lower::StatementContext &stmtCtx, const std::list &subscripts, std::stringstream &asFortran, fir::ExtendedValue &dataExv, mlir::Value baseAddr, bool treatIndexAsSection = false) { int dimension = 0; mlir::Type idxTy = builder.getIndexType(); mlir::Type boundTy = builder.getType(); llvm::SmallVector bounds; mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); for (const auto &subscript : subscripts) { const auto *triplet{ std::get_if(&subscript.u)}; if (triplet || treatIndexAsSection) { if (dimension != 0) asFortran << ','; mlir::Value lbound, ubound, extent; std::optional lval, uval; mlir::Value baseLb = fir::factory::readLowerBound(builder, loc, dataExv, dimension, one); bool defaultLb = baseLb == one; mlir::Value stride = one; bool strideInBytes = false; if (fir::unwrapRefType(baseAddr.getType()).isa()) { mlir::Value d = builder.createIntegerConstant(loc, idxTy, dimension); auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, baseAddr, d); stride = dimInfo.getByteStride(); strideInBytes = true; } const Fortran::lower::SomeExpr *lower{nullptr}; if (triplet) { if (const auto &tripletLb{std::get<0>(triplet->t)}) lower = Fortran::semantics::GetExpr(*tripletLb); } else { const auto &index{std::get(subscript.u)}; lower = Fortran::semantics::GetExpr(index); if (lower->Rank() > 0) { mlir::emitError( loc, "vector subscript cannot be used for an array section"); break; } } if (lower) { lval = Fortran::evaluate::ToInt64(*lower); if (lval) { if (defaultLb) { lbound = builder.createIntegerConstant(loc, idxTy, *lval - 1); } else { mlir::Value lb = builder.createIntegerConstant(loc, idxTy, *lval); lbound = builder.create(loc, lb, baseLb); } asFortran << *lval; } else { mlir::Value lb = fir::getBase(converter.genExprValue(loc, *lower, stmtCtx)); lb = builder.createConvert(loc, baseLb.getType(), lb); lbound = builder.create(loc, lb, baseLb); asFortran << lower->AsFortran(); } } else { // If the lower bound is not specified, then the section // starts from offset 0 of the dimension. // Note that the lowerbound in the BoundsOp is always 0-based. lbound = zero; } if (!triplet) { // If it is a scalar subscript, then the upper bound // is equal to the lower bound, and the extent is one. ubound = lbound; extent = one; } else { asFortran << ':'; const auto &upper{std::get<1>(triplet->t)}; if (upper) { uval = Fortran::semantics::GetIntValue(upper); if (uval) { if (defaultLb) { ubound = builder.createIntegerConstant(loc, idxTy, *uval - 1); } else { mlir::Value ub = builder.createIntegerConstant(loc, idxTy, *uval); ubound = builder.create(loc, ub, baseLb); } asFortran << *uval; } else { const Fortran::lower::SomeExpr *uexpr = Fortran::semantics::GetExpr(*upper); mlir::Value ub = fir::getBase(converter.genExprValue(loc, *uexpr, stmtCtx)); ub = builder.createConvert(loc, baseLb.getType(), ub); ubound = builder.create(loc, ub, baseLb); asFortran << uexpr->AsFortran(); } } if (lower && upper) { if (lval && uval && *uval < *lval) { mlir::emitError(loc, "zero sized array section"); break; } else if (std::get<2>(triplet->t)) { const auto &strideExpr{std::get<2>(triplet->t)}; if (strideExpr) { mlir::emitError(loc, "stride cannot be specified on " "an array section"); break; } } } extent = fir::factory::readExtent(builder, loc, dataExv, dimension); if (mlir::isa(extent.getDefiningOp())) { extent = zero; if (ubound && lbound) { mlir::Value diff = builder.create(loc, ubound, lbound); extent = builder.create(loc, diff, one); } if (!ubound) ubound = lbound; } if (!ubound) { // ub = extent - 1 ubound = builder.create(loc, extent, one); } } mlir::Value bound = builder.create( loc, boundTy, lbound, ubound, extent, stride, strideInBytes, baseLb); bounds.push_back(bound); ++dimension; } } return bounds; } template AddrAndBoundsInfo gatherDataOperandAddrAndBounds( Fortran::lower::AbstractConverter &converter, fir::FirOpBuilder &builder, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::StatementContext &stmtCtx, const ObjectType &object, mlir::Location operandLocation, std::stringstream &asFortran, llvm::SmallVector &bounds, bool treatIndexAsSection = false) { AddrAndBoundsInfo info; std::visit( Fortran::common::visitors{ [&](const Fortran::parser::Designator &designator) { if (auto expr{Fortran::semantics::AnalyzeExpr(semanticsContext, designator)}) { if (((*expr).Rank() > 0 || treatIndexAsSection) && Fortran::parser::Unwrap( designator)) { const auto *arrayElement = Fortran::parser::Unwrap( designator); const auto *dataRef = std::get_if(&designator.u); fir::ExtendedValue dataExv; if (Fortran::parser::Unwrap< Fortran::parser::StructureComponent>( arrayElement->base)) { auto exprBase = Fortran::semantics::AnalyzeExpr( semanticsContext, arrayElement->base); dataExv = converter.genExprAddr(operandLocation, *exprBase, stmtCtx); info.addr = fir::getBase(dataExv); asFortran << (*exprBase).AsFortran(); } else { const Fortran::parser::Name &name = Fortran::parser::GetLastName(*dataRef); info = getDataOperandBaseAddr(converter, builder, *name.symbol, operandLocation); dataExv = converter.getSymbolExtendedValue(*name.symbol); asFortran << name.ToString(); } if (!arrayElement->subscripts.empty()) { asFortran << '('; bounds = genBoundsOps( builder, operandLocation, converter, stmtCtx, arrayElement->subscripts, asFortran, dataExv, info.addr, treatIndexAsSection); } asFortran << ')'; } else if (auto structComp = Fortran::parser::Unwrap< Fortran::parser::StructureComponent>(designator)) { fir::ExtendedValue compExv = converter.genExprAddr(operandLocation, *expr, stmtCtx); info.addr = fir::getBase(compExv); if (fir::unwrapRefType(info.addr.getType()) .isa()) bounds = genBaseBoundsOps( builder, operandLocation, converter, compExv); asFortran << (*expr).AsFortran(); bool isOptional = Fortran::semantics::IsOptional( *Fortran::parser::GetLastName(*structComp).symbol); if (isOptional) info.isPresent = builder.create( operandLocation, builder.getI1Type(), info.addr); if (auto loadOp = mlir::dyn_cast_or_null( info.addr.getDefiningOp())) { if (fir::isAllocatableType(loadOp.getType()) || fir::isPointerType(loadOp.getType())) info.addr = builder.create(operandLocation, info.addr); } // If the component is an allocatable or pointer the result of // genExprAddr will be the result of a fir.box_addr operation or // a fir.box_addr has been inserted just before. // Retrieve the box so we handle it like other descriptor. if (auto boxAddrOp = mlir::dyn_cast_or_null( info.addr.getDefiningOp())) { info.addr = boxAddrOp.getVal(); bounds = genBoundsOpsFromBox( builder, operandLocation, converter, compExv, info); } } else { if (Fortran::parser::Unwrap( designator)) { // Single array element. const auto *arrayElement = Fortran::parser::Unwrap( designator); (void)arrayElement; fir::ExtendedValue compExv = converter.genExprAddr(operandLocation, *expr, stmtCtx); info.addr = fir::getBase(compExv); asFortran << (*expr).AsFortran(); } else if (const auto *dataRef{ std::get_if( &designator.u)}) { // Scalar or full array. const Fortran::parser::Name &name = Fortran::parser::GetLastName(*dataRef); fir::ExtendedValue dataExv = converter.getSymbolExtendedValue(*name.symbol); info = getDataOperandBaseAddr(converter, builder, *name.symbol, operandLocation); if (fir::unwrapRefType(info.addr.getType()) .isa()) { bounds = genBoundsOpsFromBox( builder, operandLocation, converter, dataExv, info); } if (fir::unwrapRefType(info.addr.getType()) .isa()) bounds = genBaseBoundsOps( builder, operandLocation, converter, dataExv); asFortran << name.ToString(); } else { // Unsupported llvm::report_fatal_error( "Unsupported type of OpenACC operand"); } } } }, [&](const Fortran::parser::Name &name) { info = getDataOperandBaseAddr(converter, builder, *name.symbol, operandLocation); asFortran << name.ToString(); }}, object.u); return info; } } // namespace lower } // namespace Fortran #endif // FORTRAN_LOWER_DIRECTIVES_COMMON_H