brintos

brintos / llvm-project-archived public Read only

0
0
Text · 236.9 KiB · 5355ca6 Raw
5147 lines · cpp
1//===-- OpenACC.cpp -- OpenACC directive lowering -------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8//9// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/10//11//===----------------------------------------------------------------------===//12 13#include "flang/Lower/OpenACC.h"14 15#include "flang/Common/idioms.h"16#include "flang/Lower/Bridge.h"17#include "flang/Lower/ConvertType.h"18#include "flang/Lower/DirectivesCommon.h"19#include "flang/Lower/Mangler.h"20#include "flang/Lower/PFTBuilder.h"21#include "flang/Lower/StatementContext.h"22#include "flang/Lower/Support/Utils.h"23#include "flang/Lower/SymbolMap.h"24#include "flang/Optimizer/Builder/BoxValue.h"25#include "flang/Optimizer/Builder/Complex.h"26#include "flang/Optimizer/Builder/FIRBuilder.h"27#include "flang/Optimizer/Builder/HLFIRTools.h"28#include "flang/Optimizer/Builder/IntrinsicCall.h"29#include "flang/Optimizer/Builder/Todo.h"30#include "flang/Optimizer/Dialect/FIRType.h"31#include "flang/Optimizer/OpenACC/Support/FIROpenACCUtils.h"32#include "flang/Parser/parse-tree-visitor.h"33#include "flang/Parser/parse-tree.h"34#include "flang/Parser/tools.h"35#include "flang/Semantics/expression.h"36#include "flang/Semantics/scope.h"37#include "flang/Semantics/tools.h"38#include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"39#include "mlir/Dialect/OpenACC/OpenACCUtils.h"40#include "mlir/IR/IRMapping.h"41#include "mlir/IR/MLIRContext.h"42#include "mlir/Support/LLVM.h"43#include "llvm/ADT/STLExtras.h"44#include "llvm/ADT/ScopeExit.h"45#include "llvm/Frontend/OpenACC/ACC.h.inc"46#include "llvm/Support/CommandLine.h"47#include "llvm/Support/Debug.h"48#include "llvm/Support/ErrorHandling.h"49 50#define DEBUG_TYPE "flang-lower-openacc"51 52static llvm::cl::opt<bool> generateDefaultBounds(53    "openacc-generate-default-bounds",54    llvm::cl::desc("Whether to generate default bounds for arrays."),55    llvm::cl::init(false));56 57static llvm::cl::opt<bool> strideIncludeLowerExtent(58    "openacc-stride-include-lower-extent",59    llvm::cl::desc(60        "Whether to include the lower dimensions extents in the stride."),61    llvm::cl::init(true));62 63static llvm::cl::opt<bool> lowerDoLoopToAccLoop(64    "openacc-do-loop-to-acc-loop",65    llvm::cl::desc("Whether to lower do loops as `acc.loop` operations."),66    llvm::cl::init(true));67 68static llvm::cl::opt<bool> enableSymbolRemapping(69    "openacc-remap-symbols",70    llvm::cl::desc("Whether to remap symbols that appears in data clauses."),71    llvm::cl::init(true));72 73static llvm::cl::opt<bool> enableDevicePtrRemap(74    "openacc-remap-device-ptr-symbols",75    llvm::cl::desc("sub-option of openacc-remap-symbols for deviceptr clause"),76    llvm::cl::init(false));77 78// Special value for * passed in device_type or gang clauses.79static constexpr std::int64_t starCst = -1;80 81static unsigned routineCounter = 0;82static constexpr llvm::StringRef accRoutinePrefix = "acc_routine_";83static constexpr llvm::StringRef accPrivateInitName = "acc.private.init";84static constexpr llvm::StringRef accReductionInitName = "acc.reduction.init";85 86static mlir::Location87genOperandLocation(Fortran::lower::AbstractConverter &converter,88                   const Fortran::parser::AccObject &accObject) {89  mlir::Location loc = converter.genUnknownLocation();90  Fortran::common::visit(91      Fortran::common::visitors{92          [&](const Fortran::parser::Designator &designator) {93            loc = converter.genLocation(designator.source);94          },95          [&](const Fortran::parser::Name &name) {96            loc = converter.genLocation(name.source);97          }},98      accObject.u);99  return loc;100}101 102static void addOperands(llvm::SmallVectorImpl<mlir::Value> &operands,103                        llvm::SmallVectorImpl<int32_t> &operandSegments,104                        llvm::ArrayRef<mlir::Value> clauseOperands) {105  operands.append(clauseOperands.begin(), clauseOperands.end());106  operandSegments.push_back(clauseOperands.size());107}108 109static void addOperand(llvm::SmallVectorImpl<mlir::Value> &operands,110                       llvm::SmallVectorImpl<int32_t> &operandSegments,111                       const mlir::Value &clauseOperand) {112  if (clauseOperand) {113    operands.push_back(clauseOperand);114    operandSegments.push_back(1);115  } else {116    operandSegments.push_back(0);117  }118}119 120template <typename Op>121static Op122createDataEntryOp(fir::FirOpBuilder &builder, mlir::Location loc,123                  mlir::Value baseAddr, std::stringstream &name,124                  mlir::SmallVector<mlir::Value> bounds, bool structured,125                  bool implicit, mlir::acc::DataClause dataClause,126                  mlir::Type retTy, llvm::ArrayRef<mlir::Value> async,127                  llvm::ArrayRef<mlir::Attribute> asyncDeviceTypes,128                  llvm::ArrayRef<mlir::Attribute> asyncOnlyDeviceTypes,129                  bool unwrapBoxAddr = false, mlir::Value isPresent = {}) {130  mlir::Value varPtrPtr;131  llvm::SmallVector<mlir::Value, 8> operands;132  llvm::SmallVector<int32_t, 8> operandSegments;133 134  addOperand(operands, operandSegments, baseAddr);135  addOperand(operands, operandSegments, varPtrPtr);136  addOperands(operands, operandSegments, bounds);137  addOperands(operands, operandSegments, async);138 139  Op op = Op::create(builder, loc, retTy, operands);140  op.setNameAttr(builder.getStringAttr(name.str()));141  op.setStructured(structured);142  op.setImplicit(implicit);143  op.setDataClause(dataClause);144  if (auto pointerLikeTy =145          mlir::dyn_cast<mlir::acc::PointerLikeType>(baseAddr.getType())) {146    op.setVarType(pointerLikeTy.getElementType());147  } else {148    assert(mlir::isa<mlir::acc::MappableType>(baseAddr.getType()) &&149           "expected mappable");150    op.setVarType(baseAddr.getType());151  }152 153  op->setAttr(Op::getOperandSegmentSizeAttr(),154              builder.getDenseI32ArrayAttr(operandSegments));155  if (!asyncDeviceTypes.empty())156    op.setAsyncOperandsDeviceTypeAttr(builder.getArrayAttr(asyncDeviceTypes));157  if (!asyncOnlyDeviceTypes.empty())158    op.setAsyncOnlyAttr(builder.getArrayAttr(asyncOnlyDeviceTypes));159  return op;160}161 162static void addDeclareAttr(fir::FirOpBuilder &builder, mlir::Operation *op,163                           mlir::acc::DataClause clause) {164  if (!op)165    return;166  op->setAttr(mlir::acc::getDeclareAttrName(),167              mlir::acc::DeclareAttr::get(builder.getContext(),168                                          mlir::acc::DataClauseAttr::get(169                                              builder.getContext(), clause)));170}171 172static mlir::func::FuncOp173createDeclareFunc(mlir::OpBuilder &modBuilder, fir::FirOpBuilder &builder,174                  mlir::Location loc, llvm::StringRef funcName,175                  llvm::SmallVector<mlir::Type> argsTy = {},176                  llvm::SmallVector<mlir::Location> locs = {}) {177  auto funcTy = mlir::FunctionType::get(modBuilder.getContext(), argsTy, {});178  auto funcOp = mlir::func::FuncOp::create(modBuilder, loc, funcName, funcTy);179  funcOp.setVisibility(mlir::SymbolTable::Visibility::Private);180  builder.createBlock(&funcOp.getRegion(), funcOp.getRegion().end(), argsTy,181                      locs);182  builder.setInsertionPointToEnd(&funcOp.getRegion().back());183  mlir::func::ReturnOp::create(builder, loc);184  builder.setInsertionPointToStart(&funcOp.getRegion().back());185  return funcOp;186}187 188template <typename Op>189static Op190createSimpleOp(fir::FirOpBuilder &builder, mlir::Location loc,191               const llvm::SmallVectorImpl<mlir::Value> &operands,192               const llvm::SmallVectorImpl<int32_t> &operandSegments) {193  llvm::ArrayRef<mlir::Type> argTy;194  Op op = Op::create(builder, loc, argTy, operands);195  op->setAttr(Op::getOperandSegmentSizeAttr(),196              builder.getDenseI32ArrayAttr(operandSegments));197  return op;198}199 200template <typename EntryOp>201static void createDeclareAllocFuncWithArg(mlir::OpBuilder &modBuilder,202                                          fir::FirOpBuilder &builder,203                                          mlir::Location loc, mlir::Type descTy,204                                          llvm::StringRef funcNamePrefix,205                                          std::stringstream &asFortran,206                                          mlir::acc::DataClause clause) {207  auto crtInsPt = builder.saveInsertionPoint();208  std::stringstream registerFuncName;209  registerFuncName << funcNamePrefix.str()210                   << Fortran::lower::declarePostAllocSuffix.str();211 212  if (!mlir::isa<fir::ReferenceType>(descTy))213    descTy = fir::ReferenceType::get(descTy);214  auto registerFuncOp = createDeclareFunc(215      modBuilder, builder, loc, registerFuncName.str(), {descTy}, {loc});216 217  llvm::SmallVector<mlir::Value> bounds;218  std::stringstream asFortranDesc;219  asFortranDesc << asFortran.str();220  // Start a structured region with declare_enter.221  EntryOp descEntryOp = createDataEntryOp<EntryOp>(222      builder, loc, registerFuncOp.getArgument(0), asFortranDesc, bounds,223      /*structured=*/false, /*implicit=*/true, clause, descTy,224      /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});225  mlir::acc::DeclareEnterOp::create(226      builder, loc, mlir::acc::DeclareTokenType::get(descEntryOp.getContext()),227      mlir::ValueRange(descEntryOp.getAccVar()));228 229  modBuilder.setInsertionPointAfter(registerFuncOp);230  builder.restoreInsertionPoint(crtInsPt);231}232 233template <typename ExitOp>234static void createDeclareDeallocFuncWithArg(235    mlir::OpBuilder &modBuilder, fir::FirOpBuilder &builder, mlir::Location loc,236    mlir::Type descTy, llvm::StringRef funcNamePrefix,237    std::stringstream &asFortran, mlir::acc::DataClause clause) {238  auto crtInsPt = builder.saveInsertionPoint();239  // Generate the pre dealloc function.240  std::stringstream preDeallocFuncName;241  preDeallocFuncName << funcNamePrefix.str()242                     << Fortran::lower::declarePreDeallocSuffix.str();243  if (!mlir::isa<fir::ReferenceType>(descTy))244    descTy = fir::ReferenceType::get(descTy);245  auto preDeallocOp = createDeclareFunc(246      modBuilder, builder, loc, preDeallocFuncName.str(), {descTy}, {loc});247 248  mlir::Value var = preDeallocOp.getArgument(0);249 250  llvm::SmallVector<mlir::Value> bounds;251  mlir::acc::GetDevicePtrOp entryOp =252      createDataEntryOp<mlir::acc::GetDevicePtrOp>(253          builder, loc, var, asFortran, bounds,254          /*structured=*/false, /*implicit=*/false, clause, var.getType(),255          /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});256  mlir::acc::DeclareExitOp::create(builder, loc, mlir::Value{},257                                   mlir::ValueRange(entryOp.getAccVar()));258 259  if constexpr (std::is_same_v<ExitOp, mlir::acc::CopyoutOp> ||260                std::is_same_v<ExitOp, mlir::acc::UpdateHostOp>)261    ExitOp::create(builder, entryOp.getLoc(), entryOp.getAccVar(),262                   entryOp.getVar(), entryOp.getVarType(), entryOp.getBounds(),263                   entryOp.getAsyncOperands(),264                   entryOp.getAsyncOperandsDeviceTypeAttr(),265                   entryOp.getAsyncOnlyAttr(), entryOp.getDataClause(),266                   /*structured=*/false, /*implicit=*/false,267                   builder.getStringAttr(*entryOp.getName()));268  else269    ExitOp::create(builder, entryOp.getLoc(), entryOp.getAccVar(),270                   entryOp.getBounds(), entryOp.getAsyncOperands(),271                   entryOp.getAsyncOperandsDeviceTypeAttr(),272                   entryOp.getAsyncOnlyAttr(), entryOp.getDataClause(),273                   /*structured=*/false, /*implicit=*/false,274                   builder.getStringAttr(*entryOp.getName()));275 276  // Generate the post dealloc function.277  modBuilder.setInsertionPointAfter(preDeallocOp);278  std::stringstream postDeallocFuncName;279  postDeallocFuncName << funcNamePrefix.str()280                      << Fortran::lower::declarePostDeallocSuffix.str();281  auto postDeallocOp = createDeclareFunc(282      modBuilder, builder, loc, postDeallocFuncName.str(), {descTy}, {loc});283 284  var = postDeallocOp.getArgument(0);285  // End structured region with declare_exit.286  mlir::acc::GetDevicePtrOp postEntryOp =287      createDataEntryOp<mlir::acc::GetDevicePtrOp>(288          builder, loc, var, asFortran, bounds,289          /*structured=*/false, /*implicit=*/true, clause, var.getType(),290          /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});291  mlir::acc::DeclareExitOp::create(builder, loc, mlir::Value{},292                                   mlir::ValueRange(postEntryOp.getAccVar()));293  modBuilder.setInsertionPointAfter(postDeallocOp);294  builder.restoreInsertionPoint(crtInsPt);295}296 297Fortran::semantics::Symbol &298getSymbolFromAccObject(const Fortran::parser::AccObject &accObject) {299  if (const auto *designator =300          std::get_if<Fortran::parser::Designator>(&accObject.u)) {301    if (const auto *name =302            Fortran::parser::GetDesignatorNameIfDataRef(*designator))303      return *name->symbol;304    if (const auto *arrayElement =305            Fortran::parser::Unwrap<Fortran::parser::ArrayElement>(306                *designator)) {307      const Fortran::parser::Name &name =308          Fortran::parser::GetLastName(arrayElement->base);309      return *name.symbol;310    }311    if (const auto *component =312            Fortran::parser::Unwrap<Fortran::parser::StructureComponent>(313                *designator)) {314      return *component->component.symbol;315    }316  } else if (const auto *name =317                 std::get_if<Fortran::parser::Name>(&accObject.u)) {318    return *name->symbol;319  }320  llvm::report_fatal_error("Could not find symbol");321}322 323/// Used to generate atomic.read operation which is created in existing324/// location set by builder.325static inline void326genAtomicCaptureStatement(Fortran::lower::AbstractConverter &converter,327                          mlir::Value fromAddress, mlir::Value toAddress,328                          mlir::Type elementType, mlir::Location loc) {329  // Generate `atomic.read` operation for atomic assignment statements330  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();331 332  mlir::acc::AtomicReadOp::create(firOpBuilder, loc, fromAddress, toAddress,333                                  mlir::TypeAttr::get(elementType),334                                  /*ifCond=*/mlir::Value{});335}336 337/// Used to generate atomic.write operation which is created in existing338/// location set by builder.339static inline void340genAtomicWriteStatement(Fortran::lower::AbstractConverter &converter,341                        mlir::Value lhsAddr, mlir::Value rhsExpr,342                        mlir::Location loc,343                        mlir::Value *evaluatedExprValue = nullptr) {344  // Generate `atomic.write` operation for atomic assignment statements345  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();346 347  mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());348  // Create a conversion outside the capture block.349  auto insertionPoint = firOpBuilder.saveInsertionPoint();350  firOpBuilder.setInsertionPointAfter(rhsExpr.getDefiningOp());351  rhsExpr = firOpBuilder.createConvert(loc, varType, rhsExpr);352  firOpBuilder.restoreInsertionPoint(insertionPoint);353 354  mlir::acc::AtomicWriteOp::create(firOpBuilder, loc, lhsAddr, rhsExpr,355                                   /*ifCond=*/mlir::Value{});356}357 358/// Used to generate atomic.update operation which is created in existing359/// location set by builder.360static inline void genAtomicUpdateStatement(361    Fortran::lower::AbstractConverter &converter, mlir::Value lhsAddr,362    mlir::Type varType, const Fortran::parser::Variable &assignmentStmtVariable,363    const Fortran::parser::Expr &assignmentStmtExpr, mlir::Location loc,364    mlir::Operation *atomicCaptureOp = nullptr,365    Fortran::lower::StatementContext *atomicCaptureStmtCtx = nullptr) {366  // Generate `atomic.update` operation for atomic assignment statements367  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();368  mlir::Location currentLocation = converter.getCurrentLocation();369 370  //  Create the omp.atomic.update or acc.atomic.update operation371  //372  //  func.func @_QPsb() {373  //    %0 = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFsbEa"}374  //    %1 = fir.alloca i32 {bindc_name = "b", uniq_name = "_QFsbEb"}375  //    %2 = fir.load %1 : !fir.ref<i32>376  //    omp.atomic.update   %0 : !fir.ref<i32> {377  //    ^bb0(%arg0: i32):378  //      %3 = arith.addi %arg0, %2 : i32379  //      omp.yield(%3 : i32)380  //    }381  //    return382  //  }383 384  auto getArgExpression =385      [](std::list<Fortran::parser::ActualArgSpec>::const_iterator it) {386        const auto &arg{std::get<Fortran::parser::ActualArg>((*it).t)};387        const auto *parserExpr{388            std::get_if<Fortran::common::Indirection<Fortran::parser::Expr>>(389                &arg.u)};390        return parserExpr;391      };392 393  // Lower any non atomic sub-expression before the atomic operation, and394  // map its lowered value to the semantic representation.395  Fortran::lower::ExprToValueMap exprValueOverrides;396  // Max and min intrinsics can have a list of Args. Hence we need a list397  // of nonAtomicSubExprs to hoist. Currently, only the load is hoisted.398  llvm::SmallVector<const Fortran::lower::SomeExpr *> nonAtomicSubExprs;399  Fortran::common::visit(400      Fortran::common::visitors{401          [&](const Fortran::common::Indirection<402              Fortran::parser::FunctionReference> &funcRef) -> void {403            const auto &args{404                std::get<std::list<Fortran::parser::ActualArgSpec>>(405                    funcRef.value().v.t)};406            std::list<Fortran::parser::ActualArgSpec>::const_iterator beginIt =407                args.begin();408            std::list<Fortran::parser::ActualArgSpec>::const_iterator endIt =409                args.end();410            const auto *exprFirst{getArgExpression(beginIt)};411            if (exprFirst && exprFirst->value().source ==412                                 assignmentStmtVariable.GetSource()) {413              // Add everything except the first414              beginIt++;415            } else {416              // Add everything except the last417              endIt--;418            }419            std::list<Fortran::parser::ActualArgSpec>::const_iterator it;420            for (it = beginIt; it != endIt; it++) {421              const Fortran::common::Indirection<Fortran::parser::Expr> *expr =422                  getArgExpression(it);423              if (expr)424                nonAtomicSubExprs.push_back(Fortran::semantics::GetExpr(*expr));425            }426          },427          [&](const auto &op) -> void {428            using T = std::decay_t<decltype(op)>;429            if constexpr (std::is_base_of<430                              Fortran::parser::Expr::IntrinsicBinary,431                              T>::value) {432              const auto &exprLeft{std::get<0>(op.t)};433              const auto &exprRight{std::get<1>(op.t)};434              if (exprLeft.value().source == assignmentStmtVariable.GetSource())435                nonAtomicSubExprs.push_back(436                    Fortran::semantics::GetExpr(exprRight));437              else438                nonAtomicSubExprs.push_back(439                    Fortran::semantics::GetExpr(exprLeft));440            }441          },442      },443      assignmentStmtExpr.u);444  Fortran::lower::StatementContext nonAtomicStmtCtx;445  Fortran::lower::StatementContext *stmtCtxPtr = &nonAtomicStmtCtx;446  if (!nonAtomicSubExprs.empty()) {447    // Generate non atomic part before all the atomic operations.448    auto insertionPoint = firOpBuilder.saveInsertionPoint();449    if (atomicCaptureOp) {450      assert(atomicCaptureStmtCtx && "must specify statement context");451      firOpBuilder.setInsertionPoint(atomicCaptureOp);452      // Any clean-ups associated with the expression lowering453      // must also be generated outside of the atomic update operation454      // and after the atomic capture operation.455      // The atomicCaptureStmtCtx will be finalized at the end456      // of the atomic capture operation generation.457      stmtCtxPtr = atomicCaptureStmtCtx;458    }459    mlir::Value nonAtomicVal;460    for (auto *nonAtomicSubExpr : nonAtomicSubExprs) {461      nonAtomicVal = fir::getBase(converter.genExprValue(462          currentLocation, *nonAtomicSubExpr, *stmtCtxPtr));463      exprValueOverrides.try_emplace(nonAtomicSubExpr, nonAtomicVal);464    }465    if (atomicCaptureOp)466      firOpBuilder.restoreInsertionPoint(insertionPoint);467  }468 469  mlir::Operation *atomicUpdateOp = nullptr;470  atomicUpdateOp =471      mlir::acc::AtomicUpdateOp::create(firOpBuilder, currentLocation, lhsAddr,472                                        /*ifCond=*/mlir::Value{});473 474  llvm::SmallVector<mlir::Type> varTys = {varType};475  llvm::SmallVector<mlir::Location> locs = {currentLocation};476  firOpBuilder.createBlock(&atomicUpdateOp->getRegion(0), {}, varTys, locs);477  mlir::Value val =478      fir::getBase(atomicUpdateOp->getRegion(0).front().getArgument(0));479 480  exprValueOverrides.try_emplace(481      Fortran::semantics::GetExpr(assignmentStmtVariable), val);482  {483    // statement context inside the atomic block.484    converter.overrideExprValues(&exprValueOverrides);485    Fortran::lower::StatementContext atomicStmtCtx;486    mlir::Value rhsExpr = fir::getBase(converter.genExprValue(487        *Fortran::semantics::GetExpr(assignmentStmtExpr), atomicStmtCtx));488    mlir::Value convertResult =489        firOpBuilder.createConvert(currentLocation, varType, rhsExpr);490    mlir::acc::YieldOp::create(firOpBuilder, currentLocation, convertResult);491    converter.resetExprOverrides();492  }493  firOpBuilder.setInsertionPointAfter(atomicUpdateOp);494}495 496/// Processes an atomic construct with write clause.497void genAtomicWrite(Fortran::lower::AbstractConverter &converter,498                    const Fortran::parser::AccAtomicWrite &atomicWrite,499                    mlir::Location loc) {500  const Fortran::parser::AssignmentStmt &stmt =501      std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(502          atomicWrite.t)503          .statement;504  const Fortran::evaluate::Assignment &assign = *stmt.typedAssignment->v;505  Fortran::lower::StatementContext stmtCtx;506  // Get the value and address of atomic write operands.507  mlir::Value rhsExpr =508      fir::getBase(converter.genExprValue(assign.rhs, stmtCtx));509  mlir::Value lhsAddr =510      fir::getBase(converter.genExprAddr(assign.lhs, stmtCtx));511  genAtomicWriteStatement(converter, lhsAddr, rhsExpr, loc);512}513 514/// Processes an atomic construct with read clause.515void genAtomicRead(Fortran::lower::AbstractConverter &converter,516                   const Fortran::parser::AccAtomicRead &atomicRead,517                   mlir::Location loc) {518  const auto &assignmentStmtExpr = std::get<Fortran::parser::Expr>(519      std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(520          atomicRead.t)521          .statement.t);522  const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(523      std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(524          atomicRead.t)525          .statement.t);526 527  Fortran::lower::StatementContext stmtCtx;528  const Fortran::semantics::SomeExpr &fromExpr =529      *Fortran::semantics::GetExpr(assignmentStmtExpr);530  mlir::Type elementType = converter.genType(fromExpr);531  mlir::Value fromAddress =532      fir::getBase(converter.genExprAddr(fromExpr, stmtCtx));533  mlir::Value toAddress = fir::getBase(converter.genExprAddr(534      *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));535  genAtomicCaptureStatement(converter, fromAddress, toAddress, elementType,536                            loc);537}538 539/// Processes an atomic construct with update clause.540void genAtomicUpdate(Fortran::lower::AbstractConverter &converter,541                     const Fortran::parser::AccAtomicUpdate &atomicUpdate,542                     mlir::Location loc) {543  const auto &assignmentStmtExpr = std::get<Fortran::parser::Expr>(544      std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(545          atomicUpdate.t)546          .statement.t);547  const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(548      std::get<Fortran::parser::Statement<Fortran::parser::AssignmentStmt>>(549          atomicUpdate.t)550          .statement.t);551 552  Fortran::lower::StatementContext stmtCtx;553  mlir::Value lhsAddr = fir::getBase(converter.genExprAddr(554      *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));555  mlir::Type varType = fir::unwrapRefType(lhsAddr.getType());556  genAtomicUpdateStatement(converter, lhsAddr, varType, assignmentStmtVariable,557                           assignmentStmtExpr, loc);558}559 560/// Processes an atomic construct with capture clause.561void genAtomicCapture(Fortran::lower::AbstractConverter &converter,562                      const Fortran::parser::AccAtomicCapture &atomicCapture,563                      mlir::Location loc) {564  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();565 566  const Fortran::parser::AssignmentStmt &stmt1 =567      std::get<Fortran::parser::AccAtomicCapture::Stmt1>(atomicCapture.t)568          .v.statement;569  const Fortran::evaluate::Assignment &assign1 = *stmt1.typedAssignment->v;570  const auto &stmt1Var{std::get<Fortran::parser::Variable>(stmt1.t)};571  const auto &stmt1Expr{std::get<Fortran::parser::Expr>(stmt1.t)};572  const Fortran::parser::AssignmentStmt &stmt2 =573      std::get<Fortran::parser::AccAtomicCapture::Stmt2>(atomicCapture.t)574          .v.statement;575  const Fortran::evaluate::Assignment &assign2 = *stmt2.typedAssignment->v;576  const auto &stmt2Var{std::get<Fortran::parser::Variable>(stmt2.t)};577  const auto &stmt2Expr{std::get<Fortran::parser::Expr>(stmt2.t)};578 579  // Pre-evaluate expressions to be used in the various operations inside580  // `atomic.capture` since it is not desirable to have anything other than581  // a `atomic.read`, `atomic.write`, or `atomic.update` operation582  // inside `atomic.capture`583  Fortran::lower::StatementContext stmtCtx;584  // LHS evaluations are common to all combinations of `atomic.capture`585  mlir::Value stmt1LHSArg =586      fir::getBase(converter.genExprAddr(assign1.lhs, stmtCtx));587  mlir::Value stmt2LHSArg =588      fir::getBase(converter.genExprAddr(assign2.lhs, stmtCtx));589 590  // Type information used in generation of `atomic.update` operation591  mlir::Type stmt1VarType =592      fir::getBase(converter.genExprValue(assign1.lhs, stmtCtx)).getType();593  mlir::Type stmt2VarType =594      fir::getBase(converter.genExprValue(assign2.lhs, stmtCtx)).getType();595 596  mlir::Operation *atomicCaptureOp = nullptr;597  atomicCaptureOp =598      mlir::acc::AtomicCaptureOp::create(firOpBuilder, loc,599                                         /*ifCond=*/mlir::Value{});600 601  firOpBuilder.createBlock(&(atomicCaptureOp->getRegion(0)));602  mlir::Block &block = atomicCaptureOp->getRegion(0).back();603  firOpBuilder.setInsertionPointToStart(&block);604  if (Fortran::parser::CheckForSingleVariableOnRHS(stmt1)) {605    if (Fortran::evaluate::CheckForSymbolMatch(606            Fortran::semantics::GetExpr(stmt2Var),607            Fortran::semantics::GetExpr(stmt2Expr))) {608      // Atomic capture construct is of the form [capture-stmt, update-stmt]609      const Fortran::semantics::SomeExpr &fromExpr =610          *Fortran::semantics::GetExpr(stmt1Expr);611      mlir::Type elementType = converter.genType(fromExpr);612      genAtomicCaptureStatement(converter, stmt2LHSArg, stmt1LHSArg,613                                elementType, loc);614      genAtomicUpdateStatement(converter, stmt2LHSArg, stmt2VarType, stmt2Var,615                               stmt2Expr, loc, atomicCaptureOp, &stmtCtx);616    } else {617      // Atomic capture construct is of the form [capture-stmt, write-stmt]618      firOpBuilder.setInsertionPoint(atomicCaptureOp);619      mlir::Value stmt2RHSArg =620          fir::getBase(converter.genExprValue(assign2.rhs, stmtCtx));621      firOpBuilder.setInsertionPointToStart(&block);622      const Fortran::semantics::SomeExpr &fromExpr =623          *Fortran::semantics::GetExpr(stmt1Expr);624      mlir::Type elementType = converter.genType(fromExpr);625      genAtomicCaptureStatement(converter, stmt2LHSArg, stmt1LHSArg,626                                elementType, loc);627      genAtomicWriteStatement(converter, stmt2LHSArg, stmt2RHSArg, loc);628    }629  } else {630    // Atomic capture construct is of the form [update-stmt, capture-stmt]631    const Fortran::semantics::SomeExpr &fromExpr =632        *Fortran::semantics::GetExpr(stmt2Expr);633    mlir::Type elementType = converter.genType(fromExpr);634    genAtomicUpdateStatement(converter, stmt1LHSArg, stmt1VarType, stmt1Var,635                             stmt1Expr, loc, atomicCaptureOp, &stmtCtx);636    genAtomicCaptureStatement(converter, stmt1LHSArg, stmt2LHSArg, elementType,637                              loc);638  }639  firOpBuilder.setInsertionPointToEnd(&block);640  mlir::acc::TerminatorOp::create(firOpBuilder, loc);641  // The clean-ups associated with the statements inside the capture642  // construct must be generated after the AtomicCaptureOp.643  firOpBuilder.setInsertionPointAfter(atomicCaptureOp);644}645 646template <typename Op>647static void genDataOperandOperations(648    const Fortran::parser::AccObjectList &objectList,649    Fortran::lower::AbstractConverter &converter,650    Fortran::semantics::SemanticsContext &semanticsContext,651    Fortran::lower::StatementContext &stmtCtx,652    llvm::SmallVectorImpl<mlir::Value> &dataOperands,653    mlir::acc::DataClause dataClause, bool structured, bool implicit,654    llvm::ArrayRef<mlir::Value> async,655    llvm::ArrayRef<mlir::Attribute> asyncDeviceTypes,656    llvm::ArrayRef<mlir::Attribute> asyncOnlyDeviceTypes,657    bool setDeclareAttr = false,658    llvm::SmallVectorImpl<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>659        *symbolPairs = nullptr) {660  fir::FirOpBuilder &builder = converter.getFirOpBuilder();661  Fortran::evaluate::ExpressionAnalyzer ea{semanticsContext};662  const bool unwrapBoxAddr = true;663  for (const auto &accObject : objectList.v) {664    llvm::SmallVector<mlir::Value> bounds;665    std::stringstream asFortran;666    mlir::Location operandLocation = genOperandLocation(converter, accObject);667    Fortran::semantics::Symbol &symbol = getSymbolFromAccObject(accObject);668    Fortran::semantics::MaybeExpr designator = Fortran::common::visit(669        [&](auto &&s) { return ea.Analyze(s); }, accObject.u);670    fir::factory::AddrAndBoundsInfo info =671        Fortran::lower::gatherDataOperandAddrAndBounds<672            mlir::acc::DataBoundsOp, mlir::acc::DataBoundsType>(673            converter, builder, semanticsContext, stmtCtx, symbol, designator,674            operandLocation, asFortran, bounds,675            /*treatIndexAsSection=*/true, /*unwrapFirBox=*/false,676            /*genDefaultBounds=*/generateDefaultBounds,677            /*strideIncludeLowerExtent=*/strideIncludeLowerExtent);678    LLVM_DEBUG(llvm::dbgs() << __func__ << "\n"; info.dump(llvm::dbgs()));679 680    bool isWholeSymbol =681        !designator || Fortran::evaluate::UnwrapWholeSymbolDataRef(*designator);682 683    // If the input value is optional and is not a descriptor, we use the684    // rawInput directly.685    mlir::Value baseAddr = ((fir::unwrapRefType(info.addr.getType()) !=686                             fir::unwrapRefType(info.rawInput.getType())) &&687                            info.isPresent)688                               ? info.rawInput689                               : info.addr;690    Op op = createDataEntryOp<Op>(691        builder, operandLocation, baseAddr, asFortran, bounds, structured,692        implicit, dataClause, baseAddr.getType(), async, asyncDeviceTypes,693        asyncOnlyDeviceTypes, unwrapBoxAddr, info.isPresent);694    dataOperands.push_back(op.getAccVar());695 696    // Track the symbol and its corresponding mlir::Value if requested697    if (symbolPairs && isWholeSymbol)698      symbolPairs->emplace_back(op.getAccVar(),699                                Fortran::semantics::SymbolRef(symbol));700 701    // For UseDeviceOp, if operand is one of a pair resulting from a702    // declare operation, create a UseDeviceOp for the other operand as well.703    if constexpr (std::is_same_v<Op, mlir::acc::UseDeviceOp>) {704      if (auto declareOp =705              mlir::dyn_cast<hlfir::DeclareOp>(baseAddr.getDefiningOp())) {706        mlir::Value otherAddr = declareOp.getResult(1);707        if (baseAddr != otherAddr) {708          Op op = createDataEntryOp<Op>(builder, operandLocation, otherAddr,709                                        asFortran, bounds, structured, implicit,710                                        dataClause, otherAddr.getType(), async,711                                        asyncDeviceTypes, asyncOnlyDeviceTypes,712                                        unwrapBoxAddr, info.isPresent);713          dataOperands.push_back(op.getAccVar());714          // Not adding this to symbolPairs because it only make sense to715          // map the symbol to a single value.716        }717      }718    }719  }720}721 722template <typename GlobalCtorOrDtorOp, typename EntryOp, typename DeclareOp,723          typename ExitOp>724static void createDeclareGlobalOp(mlir::OpBuilder &modBuilder,725                                  fir::FirOpBuilder &builder,726                                  mlir::Location loc, fir::GlobalOp globalOp,727                                  mlir::acc::DataClause clause,728                                  const std::string &declareGlobalName,729                                  bool implicit, std::stringstream &asFortran) {730  GlobalCtorOrDtorOp declareGlobalOp =731      GlobalCtorOrDtorOp::create(modBuilder, loc, declareGlobalName);732  builder.createBlock(&declareGlobalOp.getRegion(),733                      declareGlobalOp.getRegion().end(), {}, {});734  builder.setInsertionPointToEnd(&declareGlobalOp.getRegion().back());735 736  fir::AddrOfOp addrOp = fir::AddrOfOp::create(737      builder, loc, fir::ReferenceType::get(globalOp.getType()),738      globalOp.getSymbol());739  addDeclareAttr(builder, addrOp, clause);740 741  llvm::SmallVector<mlir::Value> bounds;742  EntryOp entryOp = createDataEntryOp<EntryOp>(743      builder, loc, addrOp.getResTy(), asFortran, bounds,744      /*structured=*/false, implicit, clause, addrOp.getResTy().getType(),745      /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});746  if constexpr (std::is_same_v<DeclareOp, mlir::acc::DeclareEnterOp>)747    DeclareOp::create(builder, loc,748                      mlir::acc::DeclareTokenType::get(entryOp.getContext()),749                      mlir::ValueRange(entryOp.getAccVar()));750  else751    DeclareOp::create(builder, loc, mlir::Value{},752                      mlir::ValueRange(entryOp.getAccVar()));753  if constexpr (std::is_same_v<GlobalCtorOrDtorOp,754                               mlir::acc::GlobalDestructorOp>) {755    if constexpr (std::is_same_v<ExitOp, mlir::acc::DeclareLinkOp>) {756      // No destructor emission for declare link in this path to avoid757      // complex var/varType/varPtrPtr signatures. The ctor registers the link.758    } else if constexpr (std::is_same_v<ExitOp, mlir::acc::CopyoutOp> ||759                         std::is_same_v<ExitOp, mlir::acc::UpdateHostOp>) {760      ExitOp::create(builder, entryOp.getLoc(), entryOp.getAccVar(),761                     entryOp.getVar(), entryOp.getVarType(),762                     entryOp.getBounds(), entryOp.getAsyncOperands(),763                     entryOp.getAsyncOperandsDeviceTypeAttr(),764                     entryOp.getAsyncOnlyAttr(), entryOp.getDataClause(),765                     /*structured=*/false, /*implicit=*/false,766                     builder.getStringAttr(*entryOp.getName()));767    } else {768      ExitOp::create(builder, entryOp.getLoc(), entryOp.getAccVar(),769                     entryOp.getBounds(), entryOp.getAsyncOperands(),770                     entryOp.getAsyncOperandsDeviceTypeAttr(),771                     entryOp.getAsyncOnlyAttr(), entryOp.getDataClause(),772                     /*structured=*/false, /*implicit=*/false,773                     builder.getStringAttr(*entryOp.getName()));774    }775  }776  mlir::acc::TerminatorOp::create(builder, loc);777  modBuilder.setInsertionPointAfter(declareGlobalOp);778}779 780template <typename EntryOp, typename ExitOp>781static void782emitCtorDtorPair(mlir::OpBuilder &modBuilder, fir::FirOpBuilder &builder,783                 mlir::Location operandLocation, fir::GlobalOp globalOp,784                 mlir::acc::DataClause clause, std::stringstream &asFortran,785                 const std::string &ctorName) {786  createDeclareGlobalOp<mlir::acc::GlobalConstructorOp, EntryOp,787                        mlir::acc::DeclareEnterOp, ExitOp>(788      modBuilder, builder, operandLocation, globalOp, clause, ctorName,789      /*implicit=*/false, asFortran);790 791  std::stringstream dtorName;792  dtorName << globalOp.getSymName().str() << "_acc_dtor";793  createDeclareGlobalOp<mlir::acc::GlobalDestructorOp,794                        mlir::acc::GetDevicePtrOp, mlir::acc::DeclareExitOp,795                        ExitOp>(modBuilder, builder, operandLocation, globalOp,796                                clause, dtorName.str(),797                                /*implicit=*/false, asFortran);798}799 800template <typename EntryOp, typename ExitOp>801static void genDeclareDataOperandOperations(802    const Fortran::parser::AccObjectList &objectList,803    Fortran::lower::AbstractConverter &converter,804    Fortran::semantics::SemanticsContext &semanticsContext,805    Fortran::lower::StatementContext &stmtCtx,806    llvm::SmallVectorImpl<mlir::Value> &dataOperands,807    mlir::acc::DataClause dataClause, bool structured, bool implicit) {808  fir::FirOpBuilder &builder = converter.getFirOpBuilder();809  Fortran::evaluate::ExpressionAnalyzer ea{semanticsContext};810  for (const auto &accObject : objectList.v) {811    llvm::SmallVector<mlir::Value> bounds;812    std::stringstream asFortran;813    mlir::Location operandLocation = genOperandLocation(converter, accObject);814    Fortran::semantics::Symbol &symbol = getSymbolFromAccObject(accObject);815    // Handle COMMON/global symbols via module-level ctor/dtor path.816    if (symbol.detailsIf<Fortran::semantics::CommonBlockDetails>() ||817        Fortran::semantics::FindCommonBlockContaining(symbol)) {818      emitCommonGlobal(819          converter, builder, accObject, dataClause,820          [&](mlir::OpBuilder &modBuilder, [[maybe_unused]] mlir::Location loc,821              [[maybe_unused]] fir::GlobalOp globalOp,822              [[maybe_unused]] mlir::acc::DataClause clause,823              std::stringstream &asFortranStr, const std::string &ctorName) {824            if constexpr (std::is_same_v<EntryOp, mlir::acc::DeclareLinkOp>) {825              createDeclareGlobalOp<826                  mlir::acc::GlobalConstructorOp, mlir::acc::DeclareLinkOp,827                  mlir::acc::DeclareEnterOp, mlir::acc::DeclareLinkOp>(828                  modBuilder, builder, loc, globalOp, clause, ctorName,829                  /*implicit=*/false, asFortranStr);830            } else if constexpr (std::is_same_v<EntryOp, mlir::acc::CreateOp> ||831                                 std::is_same_v<EntryOp, mlir::acc::CopyinOp> ||832                                 std::is_same_v<833                                     EntryOp,834                                     mlir::acc::DeclareDeviceResidentOp> ||835                                 std::is_same_v<ExitOp, mlir::acc::CopyoutOp>) {836              emitCtorDtorPair<EntryOp, ExitOp>(modBuilder, builder, loc,837                                                globalOp, clause, asFortranStr,838                                                ctorName);839            } else {840              // No module-level ctor/dtor for this clause (e.g., deviceptr,841              // present). Handled via structured declare region only.842              return;843            }844          });845      continue;846    }847    Fortran::semantics::MaybeExpr designator = Fortran::common::visit(848        [&](auto &&s) { return ea.Analyze(s); }, accObject.u);849    fir::factory::AddrAndBoundsInfo info =850        Fortran::lower::gatherDataOperandAddrAndBounds<851            mlir::acc::DataBoundsOp, mlir::acc::DataBoundsType>(852            converter, builder, semanticsContext, stmtCtx, symbol, designator,853            operandLocation, asFortran, bounds,854            /*treatIndexAsSection=*/true, /*unwrapFirBox=*/false,855            /*genDefaultBounds=*/generateDefaultBounds,856            /*strideIncludeLowerExtent=*/strideIncludeLowerExtent);857    LLVM_DEBUG(llvm::dbgs() << __func__ << "\n"; info.dump(llvm::dbgs()));858    EntryOp op = createDataEntryOp<EntryOp>(859        builder, operandLocation, info.addr, asFortran, bounds, structured,860        implicit, dataClause, info.addr.getType(),861        /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});862    dataOperands.push_back(op.getAccVar());863    addDeclareAttr(builder, op.getVar().getDefiningOp(), dataClause);864    if (mlir::isa<fir::BaseBoxType>(fir::unwrapRefType(info.addr.getType()))) {865      mlir::OpBuilder modBuilder(builder.getModule().getBodyRegion());866      modBuilder.setInsertionPointAfter(builder.getFunction());867      std::string prefix = converter.mangleName(symbol);868      createDeclareAllocFuncWithArg<EntryOp>(869          modBuilder, builder, operandLocation, info.addr.getType(), prefix,870          asFortran, dataClause);871      if constexpr (!std::is_same_v<EntryOp, ExitOp>)872        createDeclareDeallocFuncWithArg<ExitOp>(873            modBuilder, builder, operandLocation, info.addr.getType(), prefix,874            asFortran, dataClause);875    }876  }877}878 879template <typename EntryOp, typename ExitOp, typename Clause>880static void genDeclareDataOperandOperationsWithModifier(881    const Clause *x, Fortran::lower::AbstractConverter &converter,882    Fortran::semantics::SemanticsContext &semanticsContext,883    Fortran::lower::StatementContext &stmtCtx,884    Fortran::parser::AccDataModifier::Modifier mod,885    llvm::SmallVectorImpl<mlir::Value> &dataClauseOperands,886    const mlir::acc::DataClause clause,887    const mlir::acc::DataClause clauseWithModifier) {888  const Fortran::parser::AccObjectListWithModifier &listWithModifier = x->v;889  const auto &accObjectList =890      std::get<Fortran::parser::AccObjectList>(listWithModifier.t);891  const auto &modifier =892      std::get<std::optional<Fortran::parser::AccDataModifier>>(893          listWithModifier.t);894  mlir::acc::DataClause dataClause =895      (modifier && (*modifier).v == mod) ? clauseWithModifier : clause;896  genDeclareDataOperandOperations<EntryOp, ExitOp>(897      accObjectList, converter, semanticsContext, stmtCtx, dataClauseOperands,898      dataClause,899      /*structured=*/true, /*implicit=*/false);900}901 902template <typename EntryOp, typename ExitOp>903static void904genDataExitOperations(fir::FirOpBuilder &builder,905                      llvm::SmallVector<mlir::Value> operands, bool structured,906                      std::optional<mlir::Location> exitLoc = std::nullopt) {907  for (mlir::Value operand : operands) {908    auto entryOp = mlir::dyn_cast_or_null<EntryOp>(operand.getDefiningOp());909    assert(entryOp && "data entry op expected");910    mlir::Location opLoc = exitLoc ? *exitLoc : entryOp.getLoc();911    if constexpr (std::is_same_v<ExitOp, mlir::acc::CopyoutOp> ||912                  std::is_same_v<ExitOp, mlir::acc::UpdateHostOp>)913      ExitOp::create(914          builder, opLoc, entryOp.getAccVar(), entryOp.getVar(),915          entryOp.getVarType(), entryOp.getBounds(), entryOp.getAsyncOperands(),916          entryOp.getAsyncOperandsDeviceTypeAttr(), entryOp.getAsyncOnlyAttr(),917          entryOp.getDataClause(), structured, entryOp.getImplicit(),918          builder.getStringAttr(*entryOp.getName()));919    else920      ExitOp::create(921          builder, opLoc, entryOp.getAccVar(), entryOp.getBounds(),922          entryOp.getAsyncOperands(), entryOp.getAsyncOperandsDeviceTypeAttr(),923          entryOp.getAsyncOnlyAttr(), entryOp.getDataClause(), structured,924          entryOp.getImplicit(), builder.getStringAttr(*entryOp.getName()));925  }926}927 928fir::ShapeOp genShapeOp(mlir::OpBuilder &builder, fir::SequenceType seqTy,929                        mlir::Location loc) {930  llvm::SmallVector<mlir::Value> extents;931  mlir::Type idxTy = builder.getIndexType();932  for (auto extent : seqTy.getShape())933    extents.push_back(mlir::arith::ConstantOp::create(934        builder, loc, idxTy, builder.getIntegerAttr(idxTy, extent)));935  return fir::ShapeOp::create(builder, loc, extents);936}937 938/// Get the initial value for reduction operator.939template <typename R>940static R getReductionInitValue(mlir::acc::ReductionOperator op, mlir::Type ty) {941  if (op == mlir::acc::ReductionOperator::AccMin) {942    // min init value -> largest943    if constexpr (std::is_same_v<R, llvm::APInt>) {944      assert(ty.isIntOrIndex() && "expect integer or index type");945      return llvm::APInt::getSignedMaxValue(ty.getIntOrFloatBitWidth());946    }947    if constexpr (std::is_same_v<R, llvm::APFloat>) {948      auto floatTy = mlir::dyn_cast_or_null<mlir::FloatType>(ty);949      assert(floatTy && "expect float type");950      return llvm::APFloat::getLargest(floatTy.getFloatSemantics(),951                                       /*negative=*/false);952    }953  } else if (op == mlir::acc::ReductionOperator::AccMax) {954    // max init value -> smallest955    if constexpr (std::is_same_v<R, llvm::APInt>) {956      assert(ty.isIntOrIndex() && "expect integer or index type");957      return llvm::APInt::getSignedMinValue(ty.getIntOrFloatBitWidth());958    }959    if constexpr (std::is_same_v<R, llvm::APFloat>) {960      auto floatTy = mlir::dyn_cast_or_null<mlir::FloatType>(ty);961      assert(floatTy && "expect float type");962      return llvm::APFloat::getSmallest(floatTy.getFloatSemantics(),963                                        /*negative=*/true);964    }965  } else if (op == mlir::acc::ReductionOperator::AccIand) {966    if constexpr (std::is_same_v<R, llvm::APInt>) {967      assert(ty.isIntOrIndex() && "expect integer type");968      unsigned bits = ty.getIntOrFloatBitWidth();969      return llvm::APInt::getAllOnes(bits);970    }971  } else {972    assert(op != mlir::acc::ReductionOperator::AccNone);973    // +, ior, ieor init value -> 0974    // * init value -> 1975    int64_t value = (op == mlir::acc::ReductionOperator::AccMul) ? 1 : 0;976    if constexpr (std::is_same_v<R, llvm::APInt>) {977      assert(ty.isIntOrIndex() && "expect integer or index type");978      return llvm::APInt(ty.getIntOrFloatBitWidth(), value, true);979    }980 981    if constexpr (std::is_same_v<R, llvm::APFloat>) {982      assert(mlir::isa<mlir::FloatType>(ty) && "expect float type");983      auto floatTy = mlir::dyn_cast<mlir::FloatType>(ty);984      return llvm::APFloat(floatTy.getFloatSemantics(), value);985    }986 987    if constexpr (std::is_same_v<R, int64_t>)988      return value;989  }990  llvm_unreachable("OpenACC reduction unsupported type");991}992 993/// Return a constant with the initial value for the reduction operator and994/// type combination.995static mlir::Value getReductionInitValue(fir::FirOpBuilder &builder,996                                         mlir::Location loc, mlir::Type ty,997                                         mlir::acc::ReductionOperator op) {998  if (op == mlir::acc::ReductionOperator::AccLand ||999      op == mlir::acc::ReductionOperator::AccLor ||1000      op == mlir::acc::ReductionOperator::AccEqv ||1001      op == mlir::acc::ReductionOperator::AccNeqv) {1002    assert(mlir::isa<fir::LogicalType>(ty) && "expect fir.logical type");1003    bool value = true; // .true. for .and. and .eqv.1004    if (op == mlir::acc::ReductionOperator::AccLor ||1005        op == mlir::acc::ReductionOperator::AccNeqv)1006      value = false; // .false. for .or. and .neqv.1007    return builder.createBool(loc, value);1008  }1009  if (ty.isIntOrIndex())1010    return mlir::arith::ConstantOp::create(1011        builder, loc, ty,1012        builder.getIntegerAttr(ty, getReductionInitValue<llvm::APInt>(op, ty)));1013  if (op == mlir::acc::ReductionOperator::AccMin ||1014      op == mlir::acc::ReductionOperator::AccMax) {1015    if (mlir::isa<mlir::ComplexType>(ty))1016      llvm::report_fatal_error(1017          "min/max reduction not supported for complex type");1018    if (auto floatTy = mlir::dyn_cast_or_null<mlir::FloatType>(ty))1019      return mlir::arith::ConstantOp::create(1020          builder, loc, ty,1021          builder.getFloatAttr(ty,1022                               getReductionInitValue<llvm::APFloat>(op, ty)));1023  } else if (auto floatTy = mlir::dyn_cast_or_null<mlir::FloatType>(ty)) {1024    return mlir::arith::ConstantOp::create(1025        builder, loc, ty,1026        builder.getFloatAttr(ty, getReductionInitValue<int64_t>(op, ty)));1027  } else if (auto cmplxTy = mlir::dyn_cast_or_null<mlir::ComplexType>(ty)) {1028    mlir::Type floatTy = cmplxTy.getElementType();1029    mlir::Value realInit = builder.createRealConstant(1030        loc, floatTy, getReductionInitValue<int64_t>(op, cmplxTy));1031    mlir::Value imagInit = builder.createRealConstant(loc, floatTy, 0.0);1032    return fir::factory::Complex{builder, loc}.createComplex(cmplxTy, realInit,1033                                                             imagInit);1034  }1035 1036  if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(ty))1037    return getReductionInitValue(builder, loc, seqTy.getEleTy(), op);1038 1039  if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(ty))1040    return getReductionInitValue(builder, loc, boxTy.getEleTy(), op);1041 1042  if (auto heapTy = mlir::dyn_cast<fir::HeapType>(ty))1043    return getReductionInitValue(builder, loc, heapTy.getEleTy(), op);1044 1045  if (auto ptrTy = mlir::dyn_cast<fir::PointerType>(ty))1046    return getReductionInitValue(builder, loc, ptrTy.getEleTy(), op);1047 1048  llvm::report_fatal_error("Unsupported OpenACC reduction type");1049}1050 1051template <typename RecipeOp>1052static RecipeOp genRecipeOp(1053    fir::FirOpBuilder &builder, mlir::ModuleOp mod, llvm::StringRef recipeName,1054    mlir::Location loc, mlir::Type ty,1055    mlir::acc::ReductionOperator op = mlir::acc::ReductionOperator::AccNone) {1056  mlir::OpBuilder modBuilder(mod.getBodyRegion());1057  RecipeOp recipe;1058  if constexpr (std::is_same_v<RecipeOp, mlir::acc::ReductionRecipeOp>) {1059    recipe = mlir::acc::ReductionRecipeOp::create(modBuilder, loc, recipeName,1060                                                  ty, op);1061  } else {1062    recipe = RecipeOp::create(modBuilder, loc, recipeName, ty);1063  }1064 1065  llvm::SmallVector<mlir::Type> argsTy{ty};1066  llvm::SmallVector<mlir::Location> argsLoc{loc};1067  if (auto refTy = mlir::dyn_cast_or_null<fir::ReferenceType>(ty)) {1068    if (auto seqTy =1069            mlir::dyn_cast_or_null<fir::SequenceType>(refTy.getEleTy())) {1070      if (seqTy.hasDynamicExtents()) {1071        mlir::Type idxTy = builder.getIndexType();1072        for (unsigned i = 0; i < seqTy.getDimension(); ++i) {1073          argsTy.push_back(idxTy);1074          argsLoc.push_back(loc);1075        }1076      }1077    }1078  }1079  auto initBlock = builder.createBlock(1080      &recipe.getInitRegion(), recipe.getInitRegion().end(), argsTy, argsLoc);1081  builder.setInsertionPointToEnd(&recipe.getInitRegion().back());1082  mlir::Value initValue;1083  if constexpr (std::is_same_v<RecipeOp, mlir::acc::ReductionRecipeOp>) {1084    assert(op != mlir::acc::ReductionOperator::AccNone);1085    initValue = getReductionInitValue(builder, loc, fir::unwrapRefType(ty), op);1086  }1087 1088  // Since we reuse the same recipe for all variables of the same type - we1089  // cannot use the actual variable name. Thus use a temporary name.1090  llvm::StringRef initName;1091  if constexpr (std::is_same_v<RecipeOp, mlir::acc::ReductionRecipeOp>)1092    initName = accReductionInitName;1093  else1094    initName = accPrivateInitName;1095 1096  auto mappableTy = mlir::dyn_cast<mlir::acc::MappableType>(ty);1097  assert(mappableTy &&1098         "Expected that all variable types are considered mappable");1099  bool needsDestroy = false;1100  auto retVal = mappableTy.generatePrivateInit(1101      builder, loc,1102      mlir::cast<mlir::TypedValue<mlir::acc::MappableType>>(1103          initBlock->getArgument(0)),1104      initName,1105      initBlock->getArguments().take_back(initBlock->getArguments().size() - 1),1106      initValue, needsDestroy);1107  mlir::acc::YieldOp::create(builder, loc,1108                             retVal ? retVal : initBlock->getArgument(0));1109  // Create destroy region and generate destruction if requested.1110  if (needsDestroy) {1111    llvm::SmallVector<mlir::Type> destroyArgsTy;1112    llvm::SmallVector<mlir::Location> destroyArgsLoc;1113    // original and privatized/reduction value1114    destroyArgsTy.push_back(ty);1115    destroyArgsTy.push_back(ty);1116    destroyArgsLoc.push_back(loc);1117    destroyArgsLoc.push_back(loc);1118    // Append bounds arguments (if any) in the same order as init region1119    if (argsTy.size() > 1) {1120      destroyArgsTy.append(argsTy.begin() + 1, argsTy.end());1121      destroyArgsLoc.insert(destroyArgsLoc.end(), argsTy.size() - 1, loc);1122    }1123 1124    builder.createBlock(&recipe.getDestroyRegion(),1125                        recipe.getDestroyRegion().end(), destroyArgsTy,1126                        destroyArgsLoc);1127    builder.setInsertionPointToEnd(&recipe.getDestroyRegion().back());1128    // Call interface on the privatized/reduction value (2nd argument).1129    (void)mappableTy.generatePrivateDestroy(1130        builder, loc, recipe.getDestroyRegion().front().getArgument(1));1131    mlir::acc::TerminatorOp::create(builder, loc);1132  }1133  return recipe;1134}1135 1136mlir::acc::PrivateRecipeOp1137Fortran::lower::createOrGetPrivateRecipe(fir::FirOpBuilder &builder,1138                                         llvm::StringRef recipeName,1139                                         mlir::Location loc, mlir::Type ty) {1140  mlir::ModuleOp mod =1141      builder.getBlock()->getParent()->getParentOfType<mlir::ModuleOp>();1142  if (auto recipe = mod.lookupSymbol<mlir::acc::PrivateRecipeOp>(recipeName))1143    return recipe;1144 1145  auto ip = builder.saveInsertionPoint();1146  auto recipe = genRecipeOp<mlir::acc::PrivateRecipeOp>(builder, mod,1147                                                        recipeName, loc, ty);1148  builder.restoreInsertionPoint(ip);1149  return recipe;1150}1151 1152/// Check if the DataBoundsOp is a constant bound (lb and ub are constants or1153/// extent is a constant).1154bool isConstantBound(mlir::acc::DataBoundsOp &op) {1155  if (op.getLowerbound() && fir::getIntIfConstant(op.getLowerbound()) &&1156      op.getUpperbound() && fir::getIntIfConstant(op.getUpperbound()))1157    return true;1158  if (op.getExtent() && fir::getIntIfConstant(op.getExtent()))1159    return true;1160  return false;1161}1162 1163static llvm::SmallVector<mlir::Value>1164genConstantBounds(fir::FirOpBuilder &builder, mlir::Location loc,1165                  mlir::acc::DataBoundsOp &dataBound) {1166  mlir::Type idxTy = builder.getIndexType();1167  mlir::Value lb, ub, step;1168  if (dataBound.getLowerbound() &&1169      fir::getIntIfConstant(dataBound.getLowerbound()) &&1170      dataBound.getUpperbound() &&1171      fir::getIntIfConstant(dataBound.getUpperbound())) {1172    lb = builder.createIntegerConstant(1173        loc, idxTy, *fir::getIntIfConstant(dataBound.getLowerbound()));1174    ub = builder.createIntegerConstant(1175        loc, idxTy, *fir::getIntIfConstant(dataBound.getUpperbound()));1176    step = builder.createIntegerConstant(loc, idxTy, 1);1177  } else if (dataBound.getExtent()) {1178    lb = builder.createIntegerConstant(loc, idxTy, 0);1179    ub = builder.createIntegerConstant(1180        loc, idxTy, *fir::getIntIfConstant(dataBound.getExtent()) - 1);1181    step = builder.createIntegerConstant(loc, idxTy, 1);1182  } else {1183    llvm::report_fatal_error("Expect constant lb/ub or extent");1184  }1185  return {lb, ub, step};1186}1187 1188static hlfir::Entity genDesignateWithTriplets(1189    fir::FirOpBuilder &builder, mlir::Location loc, hlfir::Entity &entity,1190    hlfir::DesignateOp::Subscripts &triplets, mlir::Value shape) {1191  llvm::SmallVector<mlir::Value> lenParams;1192  hlfir::genLengthParameters(loc, builder, entity, lenParams);1193  auto designate = hlfir::DesignateOp::create(1194      builder, loc, entity.getBase().getType(), entity, /*component=*/"",1195      /*componentShape=*/mlir::Value{}, triplets,1196      /*substring=*/mlir::ValueRange{}, /*complexPartAttr=*/std::nullopt, shape,1197      lenParams);1198  return hlfir::Entity{designate.getResult()};1199}1200 1201// Designate uses triplets based on object lower bounds while acc.bounds are1202// zero based. This helper shift the bounds to create the designate triplets.1203static hlfir::DesignateOp::Subscripts1204genTripletsFromAccBounds(fir::FirOpBuilder &builder, mlir::Location loc,1205                         const llvm::SmallVector<mlir::Value> &accBounds,1206                         hlfir::Entity entity) {1207  assert(entity.getRank() * 3 == static_cast<int>(accBounds.size()) &&1208         "must get lb,ub,step for each dimension");1209  hlfir::DesignateOp::Subscripts triplets;1210  for (unsigned i = 0; i < accBounds.size(); i += 3) {1211    mlir::Value lb = hlfir::genLBound(loc, builder, entity, i / 3);1212    lb = builder.createConvert(loc, accBounds[i].getType(), lb);1213    assert(accBounds[i].getType() == accBounds[i + 1].getType() &&1214           "mix of integer types in triplets");1215    mlir::Value sliceLB =1216        builder.createOrFold<mlir::arith::AddIOp>(loc, accBounds[i], lb);1217    mlir::Value sliceUB =1218        builder.createOrFold<mlir::arith::AddIOp>(loc, accBounds[i + 1], lb);1219    triplets.emplace_back(1220        hlfir::DesignateOp::Triplet{sliceLB, sliceUB, accBounds[i + 2]});1221  }1222  return triplets;1223}1224 1225static std::pair<hlfir::Entity, hlfir::Entity>1226genArraySectionsInRecipe(fir::FirOpBuilder &builder, mlir::Location loc,1227                         llvm::SmallVector<mlir::Value> &dataOperationBounds,1228                         mlir::ValueRange recipeArguments,1229                         bool allConstantBound, hlfir::Entity lhs,1230                         hlfir::Entity rhs) {1231  lhs = hlfir::derefPointersAndAllocatables(loc, builder, lhs);1232  rhs = hlfir::derefPointersAndAllocatables(loc, builder, rhs);1233  // Get the list of lb,ub,step values for the sections that can be used inside1234  // the recipe region.1235  llvm::SmallVector<mlir::Value> bounds;1236  if (allConstantBound) {1237    // For constant bounds, the bounds are not region arguments. Materialize1238    // constants looking at the IR for the bounds on the data operation.1239    for (auto bound : dataOperationBounds) {1240      auto dataBound =1241          mlir::cast<mlir::acc::DataBoundsOp>(bound.getDefiningOp());1242      bounds.append(genConstantBounds(builder, loc, dataBound));1243    }1244  } else {1245    // If one bound is not constant, all of the bounds are region arguments.1246    for (auto arg : recipeArguments.drop_front(2))1247      bounds.push_back(arg);1248  }1249  // Compute the fir.shape of the array section and the triplets to create1250  // hlfir.designate.1251  assert(lhs.getRank() * 3 == static_cast<int>(bounds.size()) &&1252         "must get lb,ub,step for each dimension");1253  llvm::SmallVector<mlir::Value> extents;1254  mlir::Type idxTy = builder.getIndexType();1255  for (unsigned i = 0; i < bounds.size(); i += 3)1256    extents.push_back(builder.genExtentFromTriplet(1257        loc, bounds[i], bounds[i + 1], bounds[i + 2], idxTy));1258  mlir::Value shape = fir::ShapeOp::create(builder, loc, extents);1259  hlfir::DesignateOp::Subscripts rhsTriplets =1260      genTripletsFromAccBounds(builder, loc, bounds, rhs);1261  hlfir::DesignateOp::Subscripts lhsTriplets;1262  // Share the bounds when both rhs/lhs are known to be 1-based to avoid noise1263  // in the IR for the most common cases.1264  if (!lhs.mayHaveNonDefaultLowerBounds() &&1265      !rhs.mayHaveNonDefaultLowerBounds())1266    lhsTriplets = rhsTriplets;1267  else1268    lhsTriplets = genTripletsFromAccBounds(builder, loc, bounds, lhs);1269  hlfir::Entity leftSection =1270      genDesignateWithTriplets(builder, loc, lhs, lhsTriplets, shape);1271  hlfir::Entity rightSection =1272      genDesignateWithTriplets(builder, loc, rhs, rhsTriplets, shape);1273  return {leftSection, rightSection};1274}1275 1276// Generate the combiner or copy region block and block arguments and return the1277// source and destination entities.1278static std::pair<hlfir::Entity, hlfir::Entity>1279genRecipeCombinerOrCopyRegion(fir::FirOpBuilder &builder, mlir::Location loc,1280                              mlir::Type ty, mlir::Region &region,1281                              llvm::SmallVector<mlir::Value> &bounds,1282                              bool allConstantBound) {1283  llvm::SmallVector<mlir::Type> argsTy{ty, ty};1284  llvm::SmallVector<mlir::Location> argsLoc{loc, loc};1285  if (!allConstantBound) {1286    for (mlir::Value bound : llvm::reverse(bounds)) {1287      auto dataBound =1288          mlir::dyn_cast<mlir::acc::DataBoundsOp>(bound.getDefiningOp());1289      argsTy.push_back(dataBound.getLowerbound().getType());1290      argsLoc.push_back(dataBound.getLowerbound().getLoc());1291      argsTy.push_back(dataBound.getUpperbound().getType());1292      argsLoc.push_back(dataBound.getUpperbound().getLoc());1293      argsTy.push_back(dataBound.getStartIdx().getType());1294      argsLoc.push_back(dataBound.getStartIdx().getLoc());1295    }1296  }1297  mlir::Block *block =1298      builder.createBlock(&region, region.end(), argsTy, argsLoc);1299  builder.setInsertionPointToEnd(&region.back());1300  return {hlfir::Entity{block->getArgument(0)},1301          hlfir::Entity{block->getArgument(1)}};1302}1303 1304mlir::acc::FirstprivateRecipeOp Fortran::lower::createOrGetFirstprivateRecipe(1305    fir::FirOpBuilder &builder, llvm::StringRef recipeName, mlir::Location loc,1306    mlir::Type ty, llvm::SmallVector<mlir::Value> &bounds) {1307  mlir::ModuleOp mod =1308      builder.getBlock()->getParent()->getParentOfType<mlir::ModuleOp>();1309  if (auto recipe =1310          mod.lookupSymbol<mlir::acc::FirstprivateRecipeOp>(recipeName))1311    return recipe;1312 1313  mlir::OpBuilder::InsertionGuard guard(builder);1314  auto recipe = genRecipeOp<mlir::acc::FirstprivateRecipeOp>(1315      builder, mod, recipeName, loc, ty);1316  bool allConstantBound = fir::acc::areAllBoundsConstant(bounds);1317  auto [source, destination] = genRecipeCombinerOrCopyRegion(1318      builder, loc, ty, recipe.getCopyRegion(), bounds, allConstantBound);1319 1320  fir::FirOpBuilder firBuilder{builder, recipe.getOperation()};1321 1322  source = hlfir::derefPointersAndAllocatables(loc, builder, source);1323  destination = hlfir::derefPointersAndAllocatables(loc, builder, destination);1324 1325  if (!bounds.empty())1326    std::tie(source, destination) = genArraySectionsInRecipe(1327        firBuilder, loc, bounds, recipe.getCopyRegion().getArguments(),1328        allConstantBound, source, destination);1329  // The source and the destination of the firstprivate copy cannot alias,1330  // the destination is already properly allocated, so a simple assignment1331  // can be generated right away to avoid ending-up with runtime calls1332  // for arrays of numerical, logical and, character types.1333  //1334  // The temporary_lhs flag allows indicating that user defined assignments1335  // should not be called while copying components, and that the LHS and RHS1336  // are known to not alias since the LHS is a created object.1337  //1338  // TODO: detect cases where user defined assignment is needed and add a TODO.1339  // using temporary_lhs allows more aggressive optimizations of simple derived1340  // types. Existing compilers supporting OpenACC do not call user defined1341  // assignments, some use case is needed to decide what to do.1342  source = hlfir::loadTrivialScalar(loc, builder, source);1343  hlfir::AssignOp::create(builder, loc, source, destination, /*realloc=*/false,1344                          /*keep_lhs_length_if_realloc=*/false,1345                          /*temporary_lhs=*/true);1346  mlir::acc::TerminatorOp::create(builder, loc);1347  return recipe;1348}1349 1350/// Rebuild the array type from the acc.bounds operation with constant1351/// lowerbound/upperbound or extent.1352mlir::Type getTypeFromBounds(llvm::SmallVector<mlir::Value> &bounds,1353                             mlir::Type ty) {1354  auto seqTy =1355      mlir::dyn_cast_or_null<fir::SequenceType>(fir::unwrapRefType(ty));1356  if (!bounds.empty() && seqTy) {1357    llvm::SmallVector<int64_t> shape;1358    for (auto b : bounds) {1359      auto boundsOp =1360          mlir::dyn_cast<mlir::acc::DataBoundsOp>(b.getDefiningOp());1361      if (boundsOp.getLowerbound() &&1362          fir::getIntIfConstant(boundsOp.getLowerbound()) &&1363          boundsOp.getUpperbound() &&1364          fir::getIntIfConstant(boundsOp.getUpperbound())) {1365        int64_t ext = *fir::getIntIfConstant(boundsOp.getUpperbound()) -1366                      *fir::getIntIfConstant(boundsOp.getLowerbound()) + 1;1367        shape.push_back(ext);1368      } else if (boundsOp.getExtent() &&1369                 fir::getIntIfConstant(boundsOp.getExtent())) {1370        shape.push_back(*fir::getIntIfConstant(boundsOp.getExtent()));1371      } else {1372        return ty; // TODO: handle dynamic shaped array slice.1373      }1374    }1375    if (shape.empty() || shape.size() != bounds.size())1376      return ty;1377    auto newSeqTy = fir::SequenceType::get(shape, seqTy.getEleTy());1378    if (mlir::isa<fir::ReferenceType, fir::PointerType>(ty))1379      return fir::ReferenceType::get(newSeqTy);1380    return newSeqTy;1381  }1382  return ty;1383}1384 1385template <typename RecipeOp>1386static void genPrivatizationRecipes(1387    const Fortran::parser::AccObjectList &objectList,1388    Fortran::lower::AbstractConverter &converter,1389    Fortran::semantics::SemanticsContext &semanticsContext,1390    Fortran::lower::StatementContext &stmtCtx,1391    llvm::SmallVectorImpl<mlir::Value> &dataOperands,1392    llvm::ArrayRef<mlir::Value> async,1393    llvm::ArrayRef<mlir::Attribute> asyncDeviceTypes,1394    llvm::ArrayRef<mlir::Attribute> asyncOnlyDeviceTypes,1395    llvm::SmallVectorImpl<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>1396        *symbolPairs = nullptr) {1397  fir::FirOpBuilder &builder = converter.getFirOpBuilder();1398  Fortran::evaluate::ExpressionAnalyzer ea{semanticsContext};1399  for (const auto &accObject : objectList.v) {1400    llvm::SmallVector<mlir::Value> bounds;1401    std::stringstream asFortran;1402    mlir::Location operandLocation = genOperandLocation(converter, accObject);1403    Fortran::semantics::Symbol &symbol = getSymbolFromAccObject(accObject);1404    Fortran::semantics::MaybeExpr designator = Fortran::common::visit(1405        [&](auto &&s) { return ea.Analyze(s); }, accObject.u);1406    fir::factory::AddrAndBoundsInfo info =1407        Fortran::lower::gatherDataOperandAddrAndBounds<1408            mlir::acc::DataBoundsOp, mlir::acc::DataBoundsType>(1409            converter, builder, semanticsContext, stmtCtx, symbol, designator,1410            operandLocation, asFortran, bounds,1411            /*treatIndexAsSection=*/true, /*unwrapFirBox=*/false,1412            /*genDefaultBounds=*/generateDefaultBounds,1413            /*strideIncludeLowerExtent=*/strideIncludeLowerExtent);1414    LLVM_DEBUG(llvm::dbgs() << __func__ << "\n"; info.dump(llvm::dbgs()));1415 1416    bool isWholeSymbol =1417        !designator || Fortran::evaluate::UnwrapWholeSymbolDataRef(*designator);1418 1419    RecipeOp recipe;1420    mlir::Type retTy = getTypeFromBounds(bounds, info.addr.getType());1421    if constexpr (std::is_same_v<RecipeOp, mlir::acc::PrivateRecipeOp>) {1422      std::string recipeName = fir::acc::getRecipeName(1423          mlir::acc::RecipeKind::private_recipe, retTy, info.addr, bounds);1424      recipe = Fortran::lower::createOrGetPrivateRecipe(builder, recipeName,1425                                                        operandLocation, retTy);1426      auto op = createDataEntryOp<mlir::acc::PrivateOp>(1427          builder, operandLocation, info.addr, asFortran, bounds, true,1428          /*implicit=*/false, mlir::acc::DataClause::acc_private, retTy, async,1429          asyncDeviceTypes, asyncOnlyDeviceTypes, /*unwrapBoxAddr=*/true);1430      op.setRecipeAttr(1431          mlir::SymbolRefAttr::get(builder.getContext(), recipe.getSymName()));1432      dataOperands.push_back(op.getAccVar());1433 1434      // Track the symbol and its corresponding mlir::Value if requested1435      if (symbolPairs && isWholeSymbol)1436        symbolPairs->emplace_back(op.getAccVar(),1437                                  Fortran::semantics::SymbolRef(symbol));1438    } else {1439      std::string recipeName = fir::acc::getRecipeName(1440          mlir::acc::RecipeKind::firstprivate_recipe, retTy, info.addr, bounds);1441      recipe = Fortran::lower::createOrGetFirstprivateRecipe(1442          builder, recipeName, operandLocation, retTy, bounds);1443      auto op = createDataEntryOp<mlir::acc::FirstprivateOp>(1444          builder, operandLocation, info.addr, asFortran, bounds, true,1445          /*implicit=*/false, mlir::acc::DataClause::acc_firstprivate, retTy,1446          async, asyncDeviceTypes, asyncOnlyDeviceTypes,1447          /*unwrapBoxAddr=*/true);1448      op.setRecipeAttr(1449          mlir::SymbolRefAttr::get(builder.getContext(), recipe.getSymName()));1450      dataOperands.push_back(op.getAccVar());1451 1452      // Track the symbol and its corresponding mlir::Value if requested1453      if (symbolPairs && isWholeSymbol)1454        symbolPairs->emplace_back(op.getAccVar(),1455                                  Fortran::semantics::SymbolRef(symbol));1456    }1457  }1458}1459 1460/// Return the corresponding enum value for the mlir::acc::ReductionOperator1461/// from the parser representation.1462static mlir::acc::ReductionOperator1463getReductionOperator(const Fortran::parser::ReductionOperator &op) {1464  switch (op.v) {1465  case Fortran::parser::ReductionOperator::Operator::Plus:1466    return mlir::acc::ReductionOperator::AccAdd;1467  case Fortran::parser::ReductionOperator::Operator::Multiply:1468    return mlir::acc::ReductionOperator::AccMul;1469  case Fortran::parser::ReductionOperator::Operator::Max:1470    return mlir::acc::ReductionOperator::AccMax;1471  case Fortran::parser::ReductionOperator::Operator::Min:1472    return mlir::acc::ReductionOperator::AccMin;1473  case Fortran::parser::ReductionOperator::Operator::Iand:1474    return mlir::acc::ReductionOperator::AccIand;1475  case Fortran::parser::ReductionOperator::Operator::Ior:1476    return mlir::acc::ReductionOperator::AccIor;1477  case Fortran::parser::ReductionOperator::Operator::Ieor:1478    return mlir::acc::ReductionOperator::AccXor;1479  case Fortran::parser::ReductionOperator::Operator::And:1480    return mlir::acc::ReductionOperator::AccLand;1481  case Fortran::parser::ReductionOperator::Operator::Or:1482    return mlir::acc::ReductionOperator::AccLor;1483  case Fortran::parser::ReductionOperator::Operator::Eqv:1484    return mlir::acc::ReductionOperator::AccEqv;1485  case Fortran::parser::ReductionOperator::Operator::Neqv:1486    return mlir::acc::ReductionOperator::AccNeqv;1487  }1488  llvm_unreachable("unexpected reduction operator");1489}1490 1491template <typename Op>1492static mlir::Value genLogicalCombiner(fir::FirOpBuilder &builder,1493                                      mlir::Location loc, mlir::Value value1,1494                                      mlir::Value value2) {1495  mlir::Type i1 = builder.getI1Type();1496  mlir::Value v1 = fir::ConvertOp::create(builder, loc, i1, value1);1497  mlir::Value v2 = fir::ConvertOp::create(builder, loc, i1, value2);1498  mlir::Value combined = Op::create(builder, loc, v1, v2);1499  return fir::ConvertOp::create(builder, loc, value1.getType(), combined);1500}1501 1502static mlir::Value genComparisonCombiner(fir::FirOpBuilder &builder,1503                                         mlir::Location loc,1504                                         mlir::arith::CmpIPredicate pred,1505                                         mlir::Value value1,1506                                         mlir::Value value2) {1507  mlir::Type i1 = builder.getI1Type();1508  mlir::Value v1 = fir::ConvertOp::create(builder, loc, i1, value1);1509  mlir::Value v2 = fir::ConvertOp::create(builder, loc, i1, value2);1510  mlir::Value add = mlir::arith::CmpIOp::create(builder, loc, pred, v1, v2);1511  return fir::ConvertOp::create(builder, loc, value1.getType(), add);1512}1513 1514static mlir::Value genScalarCombiner(fir::FirOpBuilder &builder,1515                                     mlir::Location loc,1516                                     mlir::acc::ReductionOperator op,1517                                     mlir::Type ty, mlir::Value value1,1518                                     mlir::Value value2) {1519  value1 = builder.loadIfRef(loc, value1);1520  value2 = builder.loadIfRef(loc, value2);1521  if (op == mlir::acc::ReductionOperator::AccAdd) {1522    if (ty.isIntOrIndex())1523      return mlir::arith::AddIOp::create(builder, loc, value1, value2);1524    if (mlir::isa<mlir::FloatType>(ty))1525      return mlir::arith::AddFOp::create(builder, loc, value1, value2);1526    if (auto cmplxTy = mlir::dyn_cast_or_null<mlir::ComplexType>(ty))1527      return fir::AddcOp::create(builder, loc, value1, value2);1528    TODO(loc, "reduction add type");1529  }1530 1531  if (op == mlir::acc::ReductionOperator::AccMul) {1532    if (ty.isIntOrIndex())1533      return mlir::arith::MulIOp::create(builder, loc, value1, value2);1534    if (mlir::isa<mlir::FloatType>(ty))1535      return mlir::arith::MulFOp::create(builder, loc, value1, value2);1536    if (mlir::isa<mlir::ComplexType>(ty))1537      return fir::MulcOp::create(builder, loc, value1, value2);1538    TODO(loc, "reduction mul type");1539  }1540 1541  if (op == mlir::acc::ReductionOperator::AccMin)1542    return fir::genMin(builder, loc, {value1, value2});1543 1544  if (op == mlir::acc::ReductionOperator::AccMax)1545    return fir::genMax(builder, loc, {value1, value2});1546 1547  if (op == mlir::acc::ReductionOperator::AccIand)1548    return mlir::arith::AndIOp::create(builder, loc, value1, value2);1549 1550  if (op == mlir::acc::ReductionOperator::AccIor)1551    return mlir::arith::OrIOp::create(builder, loc, value1, value2);1552 1553  if (op == mlir::acc::ReductionOperator::AccXor)1554    return mlir::arith::XOrIOp::create(builder, loc, value1, value2);1555 1556  if (op == mlir::acc::ReductionOperator::AccLand)1557    return genLogicalCombiner<mlir::arith::AndIOp>(builder, loc, value1,1558                                                   value2);1559 1560  if (op == mlir::acc::ReductionOperator::AccLor)1561    return genLogicalCombiner<mlir::arith::OrIOp>(builder, loc, value1, value2);1562 1563  if (op == mlir::acc::ReductionOperator::AccEqv)1564    return genComparisonCombiner(builder, loc, mlir::arith::CmpIPredicate::eq,1565                                 value1, value2);1566 1567  if (op == mlir::acc::ReductionOperator::AccNeqv)1568    return genComparisonCombiner(builder, loc, mlir::arith::CmpIPredicate::ne,1569                                 value1, value2);1570 1571  TODO(loc, "reduction operator");1572}1573 1574mlir::acc::ReductionRecipeOp Fortran::lower::createOrGetReductionRecipe(1575    fir::FirOpBuilder &builder, llvm::StringRef recipeName, mlir::Location loc,1576    mlir::Type ty, mlir::acc::ReductionOperator op,1577    llvm::SmallVector<mlir::Value> &bounds) {1578  mlir::ModuleOp mod =1579      builder.getBlock()->getParent()->getParentOfType<mlir::ModuleOp>();1580  if (auto recipe = mod.lookupSymbol<mlir::acc::ReductionRecipeOp>(recipeName))1581    return recipe;1582 1583  mlir::OpBuilder::InsertionGuard guard(builder);1584  auto recipe = genRecipeOp<mlir::acc::ReductionRecipeOp>(1585      builder, mod, recipeName, loc, ty, op);1586  bool allConstantBound = fir::acc::areAllBoundsConstant(bounds);1587 1588  auto [dest, src] = genRecipeCombinerOrCopyRegion(1589      builder, loc, ty, recipe.getCombinerRegion(), bounds, allConstantBound);1590  // Generate loops that combine and assign the inputs into dest (or array1591  // section of the inputs when there are bounds).1592  hlfir::Entity srcSection = src;1593  hlfir::Entity destSection = dest;1594  if (!bounds.empty())1595    std::tie(srcSection, destSection) = genArraySectionsInRecipe(1596        builder, loc, bounds, recipe.getCombinerRegion().getArguments(),1597        allConstantBound, srcSection, destSection);1598 1599  mlir::Type elementType = fir::getFortranElementType(ty);1600  auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,1601                       hlfir::Entity srcElementValue,1602                       hlfir::Entity destElementValue) -> hlfir::Entity {1603    return hlfir::Entity{genScalarCombiner(builder, loc, op, elementType,1604                                           srcElementValue, destElementValue)};1605  };1606  hlfir::genNoAliasAssignment(loc, builder, srcSection, destSection,1607                              /*emitWorkshareLoop=*/false,1608                              /*temporaryLHS=*/false, genKernel);1609  mlir::acc::YieldOp::create(builder, loc, dest);1610  return recipe;1611}1612 1613static bool isSupportedReductionType(mlir::Type ty) {1614  ty = fir::unwrapRefType(ty);1615  if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(ty))1616    return isSupportedReductionType(boxTy.getEleTy());1617  if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(ty))1618    return isSupportedReductionType(seqTy.getEleTy());1619  if (auto heapTy = mlir::dyn_cast<fir::HeapType>(ty))1620    return isSupportedReductionType(heapTy.getEleTy());1621  if (auto ptrTy = mlir::dyn_cast<fir::PointerType>(ty))1622    return isSupportedReductionType(ptrTy.getEleTy());1623  return fir::isa_trivial(ty);1624}1625 1626static void genReductions(1627    const Fortran::parser::AccObjectListWithReduction &objectList,1628    Fortran::lower::AbstractConverter &converter,1629    Fortran::semantics::SemanticsContext &semanticsContext,1630    Fortran::lower::StatementContext &stmtCtx,1631    llvm::SmallVectorImpl<mlir::Value> &reductionOperands,1632    llvm::ArrayRef<mlir::Value> async,1633    llvm::ArrayRef<mlir::Attribute> asyncDeviceTypes,1634    llvm::ArrayRef<mlir::Attribute> asyncOnlyDeviceTypes,1635    llvm::SmallVectorImpl<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>1636        *symbolPairs = nullptr) {1637  fir::FirOpBuilder &builder = converter.getFirOpBuilder();1638  const auto &objects = std::get<Fortran::parser::AccObjectList>(objectList.t);1639  const auto &op = std::get<Fortran::parser::ReductionOperator>(objectList.t);1640  mlir::acc::ReductionOperator mlirOp = getReductionOperator(op);1641  Fortran::evaluate::ExpressionAnalyzer ea{semanticsContext};1642  for (const auto &accObject : objects.v) {1643    llvm::SmallVector<mlir::Value> bounds;1644    std::stringstream asFortran;1645    mlir::Location operandLocation = genOperandLocation(converter, accObject);1646    Fortran::semantics::Symbol &symbol = getSymbolFromAccObject(accObject);1647    Fortran::semantics::MaybeExpr designator = Fortran::common::visit(1648        [&](auto &&s) { return ea.Analyze(s); }, accObject.u);1649    bool isWholeSymbol =1650        !designator || Fortran::evaluate::UnwrapWholeSymbolDataRef(*designator);1651    fir::factory::AddrAndBoundsInfo info =1652        Fortran::lower::gatherDataOperandAddrAndBounds<1653            mlir::acc::DataBoundsOp, mlir::acc::DataBoundsType>(1654            converter, builder, semanticsContext, stmtCtx, symbol, designator,1655            operandLocation, asFortran, bounds,1656            /*treatIndexAsSection=*/true, /*unwrapFirBox=*/false,1657            /*genDefaultBounds=*/generateDefaultBounds,1658            /*strideIncludeLowerExtent=*/strideIncludeLowerExtent);1659    LLVM_DEBUG(llvm::dbgs() << __func__ << "\n"; info.dump(llvm::dbgs()));1660 1661    mlir::Type reductionTy = fir::unwrapRefType(info.addr.getType());1662    if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(reductionTy))1663      reductionTy = seqTy.getEleTy();1664 1665    if (!isSupportedReductionType(reductionTy))1666      TODO(operandLocation, "reduction with unsupported type");1667 1668    auto op = createDataEntryOp<mlir::acc::ReductionOp>(1669        builder, operandLocation, info.addr, asFortran, bounds,1670        /*structured=*/true, /*implicit=*/false,1671        mlir::acc::DataClause::acc_reduction, info.addr.getType(), async,1672        asyncDeviceTypes, asyncOnlyDeviceTypes, /*unwrapBoxAddr=*/true);1673    mlir::Type ty = op.getAccVar().getType();1674    if (!fir::acc::areAllBoundsConstant(bounds) ||1675        fir::isAssumedShape(info.addr.getType()) ||1676        fir::isAllocatableOrPointerArray(info.addr.getType()))1677      ty = info.addr.getType();1678    std::string recipeName = fir::acc::getRecipeName(1679        mlir::acc::RecipeKind::reduction_recipe, ty, info.addr, bounds, mlirOp);1680 1681    mlir::acc::ReductionRecipeOp recipe =1682        Fortran::lower::createOrGetReductionRecipe(1683            builder, recipeName, operandLocation, ty, mlirOp, bounds);1684    op.setRecipeAttr(1685        mlir::SymbolRefAttr::get(builder.getContext(), recipe.getSymName()));1686    reductionOperands.push_back(op.getAccVar());1687    // Track the symbol and its corresponding mlir::Value if requested so that1688    // accesses inside the compute/loop regions use the acc.reduction variable.1689    if (symbolPairs && isWholeSymbol)1690      symbolPairs->emplace_back(op.getAccVar(),1691                                Fortran::semantics::SymbolRef(symbol));1692  }1693}1694 1695template <typename Op, typename Terminator>1696static Op1697createRegionOp(fir::FirOpBuilder &builder, mlir::Location loc,1698               mlir::Location returnLoc, Fortran::lower::pft::Evaluation &eval,1699               const llvm::SmallVectorImpl<mlir::Value> &operands,1700               const llvm::SmallVectorImpl<int32_t> &operandSegments,1701               bool outerCombined = false,1702               llvm::SmallVector<mlir::Type> retTy = {},1703               mlir::Value yieldValue = {}, mlir::TypeRange argsTy = {},1704               llvm::SmallVector<mlir::Location> locs = {}) {1705  Op op = Op::create(builder, loc, retTy, operands);1706  builder.createBlock(&op.getRegion(), op.getRegion().end(), argsTy, locs);1707  mlir::Block &block = op.getRegion().back();1708  builder.setInsertionPointToStart(&block);1709 1710  op->setAttr(Op::getOperandSegmentSizeAttr(),1711              builder.getDenseI32ArrayAttr(operandSegments));1712 1713  // Place the insertion point to the start of the first block.1714  builder.setInsertionPointToStart(&block);1715 1716  // If it is an unstructured region and is not the outer region of a combined1717  // construct, create empty blocks for all evaluations.1718  if (eval.lowerAsUnstructured() && !outerCombined)1719    Fortran::lower::createEmptyRegionBlocks<mlir::acc::TerminatorOp,1720                                            mlir::acc::YieldOp>(1721        builder, eval.getNestedEvaluations());1722 1723  if (yieldValue) {1724    if constexpr (std::is_same_v<Terminator, mlir::acc::YieldOp>) {1725      Terminator yieldOp = Terminator::create(builder, returnLoc, yieldValue);1726      yieldValue.getDefiningOp()->moveBefore(yieldOp);1727    } else {1728      Terminator::create(builder, returnLoc);1729    }1730  } else {1731    Terminator::create(builder, returnLoc);1732  }1733  builder.setInsertionPointToStart(&block);1734  return op;1735}1736 1737static void genAsyncClause(Fortran::lower::AbstractConverter &converter,1738                           const Fortran::parser::AccClause::Async *asyncClause,1739                           mlir::Value &async, bool &addAsyncAttr,1740                           Fortran::lower::StatementContext &stmtCtx) {1741  const auto &asyncClauseValue = asyncClause->v;1742  if (asyncClauseValue) { // async has a value.1743    async = fir::getBase(converter.genExprValue(1744        *Fortran::semantics::GetExpr(*asyncClauseValue), stmtCtx));1745  } else {1746    addAsyncAttr = true;1747  }1748}1749 1750static void1751genAsyncClause(Fortran::lower::AbstractConverter &converter,1752               const Fortran::parser::AccClause::Async *asyncClause,1753               llvm::SmallVector<mlir::Value> &async,1754               llvm::SmallVector<mlir::Attribute> &asyncDeviceTypes,1755               llvm::SmallVector<mlir::Attribute> &asyncOnlyDeviceTypes,1756               llvm::SmallVector<mlir::Attribute> &deviceTypeAttrs,1757               Fortran::lower::StatementContext &stmtCtx) {1758  const auto &asyncClauseValue = asyncClause->v;1759  if (asyncClauseValue) { // async has a value.1760    mlir::Value asyncValue = fir::getBase(converter.genExprValue(1761        *Fortran::semantics::GetExpr(*asyncClauseValue), stmtCtx));1762    for (auto deviceTypeAttr : deviceTypeAttrs) {1763      async.push_back(asyncValue);1764      asyncDeviceTypes.push_back(deviceTypeAttr);1765    }1766  } else {1767    for (auto deviceTypeAttr : deviceTypeAttrs)1768      asyncOnlyDeviceTypes.push_back(deviceTypeAttr);1769  }1770}1771 1772static mlir::acc::DeviceType1773getDeviceType(Fortran::common::OpenACCDeviceType device) {1774  switch (device) {1775  case Fortran::common::OpenACCDeviceType::Star:1776    return mlir::acc::DeviceType::Star;1777  case Fortran::common::OpenACCDeviceType::Default:1778    return mlir::acc::DeviceType::Default;1779  case Fortran::common::OpenACCDeviceType::Nvidia:1780    return mlir::acc::DeviceType::Nvidia;1781  case Fortran::common::OpenACCDeviceType::Radeon:1782    return mlir::acc::DeviceType::Radeon;1783  case Fortran::common::OpenACCDeviceType::Host:1784    return mlir::acc::DeviceType::Host;1785  case Fortran::common::OpenACCDeviceType::Multicore:1786    return mlir::acc::DeviceType::Multicore;1787  case Fortran::common::OpenACCDeviceType::None:1788    return mlir::acc::DeviceType::None;1789  }1790  return mlir::acc::DeviceType::None;1791}1792 1793static void gatherDeviceTypeAttrs(1794    fir::FirOpBuilder &builder,1795    const Fortran::parser::AccClause::DeviceType *deviceTypeClause,1796    llvm::SmallVector<mlir::Attribute> &deviceTypes) {1797  const Fortran::parser::AccDeviceTypeExprList &deviceTypeExprList =1798      deviceTypeClause->v;1799  for (const auto &deviceTypeExpr : deviceTypeExprList.v)1800    deviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(1801        builder.getContext(), getDeviceType(deviceTypeExpr.v)));1802}1803 1804static void genIfClause(Fortran::lower::AbstractConverter &converter,1805                        mlir::Location clauseLocation,1806                        const Fortran::parser::AccClause::If *ifClause,1807                        mlir::Value &ifCond,1808                        Fortran::lower::StatementContext &stmtCtx) {1809  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();1810  mlir::Value cond = fir::getBase(converter.genExprValue(1811      *Fortran::semantics::GetExpr(ifClause->v), stmtCtx, &clauseLocation));1812  ifCond = firOpBuilder.createConvert(clauseLocation, firOpBuilder.getI1Type(),1813                                      cond);1814}1815 1816static void genWaitClause(Fortran::lower::AbstractConverter &converter,1817                          const Fortran::parser::AccClause::Wait *waitClause,1818                          llvm::SmallVectorImpl<mlir::Value> &operands,1819                          mlir::Value &waitDevnum, bool &addWaitAttr,1820                          Fortran::lower::StatementContext &stmtCtx) {1821  const auto &waitClauseValue = waitClause->v;1822  if (waitClauseValue) { // wait has a value.1823    const Fortran::parser::AccWaitArgument &waitArg = *waitClauseValue;1824    const auto &waitList =1825        std::get<std::list<Fortran::parser::ScalarIntExpr>>(waitArg.t);1826    for (const Fortran::parser::ScalarIntExpr &value : waitList) {1827      mlir::Value v = fir::getBase(1828          converter.genExprValue(*Fortran::semantics::GetExpr(value), stmtCtx));1829      operands.push_back(v);1830    }1831 1832    const auto &waitDevnumValue =1833        std::get<std::optional<Fortran::parser::ScalarIntExpr>>(waitArg.t);1834    if (waitDevnumValue)1835      waitDevnum = fir::getBase(converter.genExprValue(1836          *Fortran::semantics::GetExpr(*waitDevnumValue), stmtCtx));1837  } else {1838    addWaitAttr = true;1839  }1840}1841 1842static void genWaitClauseWithDeviceType(1843    Fortran::lower::AbstractConverter &converter,1844    const Fortran::parser::AccClause::Wait *waitClause,1845    llvm::SmallVector<mlir::Value> &waitOperands,1846    llvm::SmallVector<mlir::Attribute> &waitOperandsDeviceTypes,1847    llvm::SmallVector<mlir::Attribute> &waitOnlyDeviceTypes,1848    llvm::SmallVector<bool> &hasDevnums,1849    llvm::SmallVector<int32_t> &waitOperandsSegments,1850    llvm::SmallVector<mlir::Attribute> deviceTypeAttrs,1851    Fortran::lower::StatementContext &stmtCtx) {1852  const auto &waitClauseValue = waitClause->v;1853  if (waitClauseValue) { // wait has a value.1854    llvm::SmallVector<mlir::Value> waitValues;1855 1856    const Fortran::parser::AccWaitArgument &waitArg = *waitClauseValue;1857    const auto &waitDevnumValue =1858        std::get<std::optional<Fortran::parser::ScalarIntExpr>>(waitArg.t);1859    bool hasDevnum = false;1860    if (waitDevnumValue) {1861      waitValues.push_back(fir::getBase(converter.genExprValue(1862          *Fortran::semantics::GetExpr(*waitDevnumValue), stmtCtx)));1863      hasDevnum = true;1864    }1865 1866    const auto &waitList =1867        std::get<std::list<Fortran::parser::ScalarIntExpr>>(waitArg.t);1868    for (const Fortran::parser::ScalarIntExpr &value : waitList) {1869      waitValues.push_back(fir::getBase(converter.genExprValue(1870          *Fortran::semantics::GetExpr(value), stmtCtx)));1871    }1872 1873    for (auto deviceTypeAttr : deviceTypeAttrs) {1874      for (auto value : waitValues)1875        waitOperands.push_back(value);1876      waitOperandsDeviceTypes.push_back(deviceTypeAttr);1877      waitOperandsSegments.push_back(waitValues.size());1878      hasDevnums.push_back(hasDevnum);1879    }1880  } else {1881    for (auto deviceTypeAttr : deviceTypeAttrs)1882      waitOnlyDeviceTypes.push_back(deviceTypeAttr);1883  }1884}1885 1886mlir::Type getTypeFromIvTypeSize(fir::FirOpBuilder &builder,1887                                 const Fortran::semantics::Symbol &ivSym) {1888  std::size_t ivTypeSize = ivSym.size();1889  if (ivTypeSize == 0)1890    llvm::report_fatal_error("unexpected induction variable size");1891  // ivTypeSize is in bytes and IntegerType needs to be in bits.1892  return builder.getIntegerType(ivTypeSize * 8);1893}1894 1895static void privatizeIv(1896    Fortran::lower::AbstractConverter &converter,1897    const Fortran::semantics::Symbol &sym, mlir::Location loc,1898    llvm::SmallVector<mlir::Type> &ivTypes,1899    llvm::SmallVector<mlir::Location> &ivLocs,1900    llvm::SmallVector<mlir::Value> &privateOperands,1901    llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>1902        &ivPrivate,1903    bool isDoConcurrent = false) {1904  fir::FirOpBuilder &builder = converter.getFirOpBuilder();1905 1906  mlir::Type ivTy = getTypeFromIvTypeSize(builder, sym);1907  ivTypes.push_back(ivTy);1908  ivLocs.push_back(loc);1909  mlir::Value ivValue = converter.getSymbolAddress(sym);1910  if (!ivValue && isDoConcurrent) {1911    // DO CONCURRENT induction variables are not mapped yet since they are local1912    // to the DO CONCURRENT scope.1913    mlir::OpBuilder::InsertPoint insPt = builder.saveInsertionPoint();1914    builder.setInsertionPointToStart(builder.getAllocaBlock());1915    ivValue = builder.createTemporaryAlloc(loc, ivTy, toStringRef(sym.name()));1916    builder.restoreInsertionPoint(insPt);1917  }1918 1919  mlir::Operation *privateOp = nullptr;1920  for (auto privateVal : privateOperands) {1921    if (mlir::acc::getVar(privateVal.getDefiningOp()) == ivValue) {1922      privateOp = privateVal.getDefiningOp();1923      break;1924    }1925  }1926 1927  if (privateOp == nullptr) {1928    std::string recipeName = fir::acc::getRecipeName(1929        mlir::acc::RecipeKind::private_recipe, ivValue.getType(), ivValue, {});1930    auto recipe = Fortran::lower::createOrGetPrivateRecipe(1931        builder, recipeName, loc, ivValue.getType());1932 1933    std::stringstream asFortran;1934    asFortran << Fortran::lower::mangle::demangleName(toStringRef(sym.name()));1935    auto op = createDataEntryOp<mlir::acc::PrivateOp>(1936        builder, loc, ivValue, asFortran, {}, true, /*implicit=*/true,1937        mlir::acc::DataClause::acc_private, ivValue.getType(),1938        /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});1939    op.setRecipeAttr(1940        mlir::SymbolRefAttr::get(builder.getContext(), recipe.getSymName()));1941    privateOp = op.getOperation();1942 1943    privateOperands.push_back(op.getAccVar());1944  }1945 1946  ivPrivate.emplace_back(mlir::acc::getAccVar(privateOp),1947                         Fortran::semantics::SymbolRef(sym));1948}1949 1950static void determineDefaultLoopParMode(1951    Fortran::lower::AbstractConverter &converter, mlir::acc::LoopOp &loopOp,1952    llvm::SmallVector<mlir::Attribute> &seqDeviceTypes,1953    llvm::SmallVector<mlir::Attribute> &independentDeviceTypes,1954    llvm::SmallVector<mlir::Attribute> &autoDeviceTypes) {1955  auto hasDeviceNone = [](mlir::Attribute attr) -> bool {1956    return mlir::dyn_cast<mlir::acc::DeviceTypeAttr>(attr).getValue() ==1957           mlir::acc::DeviceType::None;1958  };1959  bool hasDefaultSeq = llvm::any_of(seqDeviceTypes, hasDeviceNone);1960  bool hasDefaultIndependent =1961      llvm::any_of(independentDeviceTypes, hasDeviceNone);1962  bool hasDefaultAuto = llvm::any_of(autoDeviceTypes, hasDeviceNone);1963  if (hasDefaultSeq || hasDefaultIndependent || hasDefaultAuto)1964    return; // Default loop par mode is already specified.1965 1966  mlir::Region *currentRegion =1967      converter.getFirOpBuilder().getBlock()->getParent();1968  mlir::Operation *parentOp = mlir::acc::getEnclosingComputeOp(*currentRegion);1969  const bool isOrphanedLoop = !parentOp;1970  if (isOrphanedLoop ||1971      mlir::isa_and_present<mlir::acc::ParallelOp>(parentOp)) {1972    // As per OpenACC 3.3 standard section 2.9.6 independent clause:1973    // A loop construct with no auto or seq clause is treated as if it has the1974    // independent clause when it is an orphaned loop construct or its parent1975    // compute construct is a parallel construct.1976    independentDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(1977        converter.getFirOpBuilder().getContext(), mlir::acc::DeviceType::None));1978  } else if (mlir::isa_and_present<mlir::acc::SerialOp>(parentOp)) {1979    // Serial construct implies `seq` clause on loop. However, this1980    // conflicts with parallelism assignment if already set. Therefore check1981    // that first.1982    bool hasDefaultGangWorkerOrVector =1983        loopOp.hasVector() || loopOp.getVectorValue() || loopOp.hasWorker() ||1984        loopOp.getWorkerValue() || loopOp.hasGang() ||1985        loopOp.getGangValue(mlir::acc::GangArgType::Num) ||1986        loopOp.getGangValue(mlir::acc::GangArgType::Dim) ||1987        loopOp.getGangValue(mlir::acc::GangArgType::Static);1988    if (!hasDefaultGangWorkerOrVector)1989      seqDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(1990          converter.getFirOpBuilder().getContext(),1991          mlir::acc::DeviceType::None));1992    // Since the loop has some parallelism assigned - we cannot assign `seq`.1993    // However, the `acc.loop` verifier will check that one of seq, independent,1994    // or auto is marked. Seems reasonable to mark as auto since the OpenACC1995    // spec does say "If not, or if it is unable to make a determination, it1996    // must treat the auto clause as if it is a seq clause, and it must1997    // ignore any gang, worker, or vector clauses on the loop construct"1998    else1999      autoDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(2000          converter.getFirOpBuilder().getContext(),2001          mlir::acc::DeviceType::None));2002  } else {2003    // As per OpenACC 3.3 standard section 2.9.7 auto clause:2004    // When the parent compute construct is a kernels construct, a loop2005    // construct with no independent or seq clause is treated as if it has the2006    // auto clause.2007    assert(mlir::isa_and_present<mlir::acc::KernelsOp>(parentOp) &&2008           "Expected kernels construct");2009    autoDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(2010        converter.getFirOpBuilder().getContext(), mlir::acc::DeviceType::None));2011  }2012}2013 2014// Helper to visit Bounds of DO LOOP nest.2015static void visitLoopControl(2016    Fortran::lower::AbstractConverter &converter,2017    const Fortran::parser::DoConstruct &outerDoConstruct,2018    uint64_t loopsToProcess, Fortran::lower::pft::Evaluation &eval,2019    std::function<void(const Fortran::parser::LoopControl::Bounds &,2020                       mlir::Location)>2021        callback) {2022  Fortran::lower::pft::Evaluation *crtEval = &eval.getFirstNestedEvaluation();2023  for (uint64_t i = 0; i < loopsToProcess; ++i) {2024    const Fortran::parser::LoopControl *loopControl;2025    if (i == 0) {2026      loopControl = &*outerDoConstruct.GetLoopControl();2027      mlir::Location loc = converter.genLocation(2028          Fortran::parser::FindSourceLocation(outerDoConstruct));2029      callback(std::get<Fortran::parser::LoopControl::Bounds>(loopControl->u),2030               loc);2031    } else {2032      // Safely locate the next inner DoConstruct within this eval.2033      const Fortran::parser::DoConstruct *innerDo = nullptr;2034      if (crtEval && crtEval->hasNestedEvaluations()) {2035        for (Fortran::lower::pft::Evaluation &child :2036             crtEval->getNestedEvaluations()) {2037          if (auto *stmt = child.getIf<Fortran::parser::DoConstruct>()) {2038            innerDo = stmt;2039            // Prepare to descend for the next iteration2040            crtEval = &child;2041            break;2042          }2043        }2044      }2045      if (!innerDo)2046        break; // No deeper loop; stop collecting collapsed bounds.2047 2048      loopControl = &*innerDo->GetLoopControl();2049      mlir::Location loc =2050          converter.genLocation(Fortran::parser::FindSourceLocation(*innerDo));2051      callback(std::get<Fortran::parser::LoopControl::Bounds>(loopControl->u),2052               loc);2053    }2054  }2055}2056 2057// Extract loop bounds, steps, induction variables, and privatization info2058// for both DO CONCURRENT and regular do loops2059static void processDoLoopBounds(2060    Fortran::lower::AbstractConverter &converter,2061    mlir::Location currentLocation, Fortran::lower::StatementContext &stmtCtx,2062    fir::FirOpBuilder &builder,2063    const Fortran::parser::DoConstruct &outerDoConstruct,2064    Fortran::lower::pft::Evaluation &eval,2065    llvm::SmallVector<mlir::Value> &lowerbounds,2066    llvm::SmallVector<mlir::Value> &upperbounds,2067    llvm::SmallVector<mlir::Value> &steps,2068    llvm::SmallVector<mlir::Value> &privateOperands,2069    llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2070        &ivPrivate,2071    llvm::SmallVector<mlir::Type> &ivTypes,2072    llvm::SmallVector<mlir::Location> &ivLocs,2073    llvm::SmallVector<bool> &inclusiveBounds,2074    llvm::SmallVector<mlir::Location> &locs, uint64_t loopsToProcess) {2075  assert(loopsToProcess > 0 && "expect at least one loop");2076  locs.push_back(currentLocation); // Location of the directive2077  bool isDoConcurrent = outerDoConstruct.IsDoConcurrent();2078 2079  if (isDoConcurrent) {2080    locs.push_back(converter.genLocation(2081        Fortran::parser::FindSourceLocation(outerDoConstruct)));2082    const Fortran::parser::LoopControl *loopControl =2083        &*outerDoConstruct.GetLoopControl();2084    const auto &concurrent =2085        std::get<Fortran::parser::LoopControl::Concurrent>(loopControl->u);2086    if (!std::get<std::list<Fortran::parser::LocalitySpec>>(concurrent.t)2087             .empty())2088      TODO(currentLocation, "DO CONCURRENT with locality spec inside ACC");2089 2090    const auto &concurrentHeader =2091        std::get<Fortran::parser::ConcurrentHeader>(concurrent.t);2092    const auto &controls =2093        std::get<std::list<Fortran::parser::ConcurrentControl>>(2094            concurrentHeader.t);2095    for (const auto &control : controls) {2096      lowerbounds.push_back(fir::getBase(converter.genExprValue(2097          *Fortran::semantics::GetExpr(std::get<1>(control.t)), stmtCtx)));2098      upperbounds.push_back(fir::getBase(converter.genExprValue(2099          *Fortran::semantics::GetExpr(std::get<2>(control.t)), stmtCtx)));2100      if (const auto &expr =2101              std::get<std::optional<Fortran::parser::ScalarIntExpr>>(2102                  control.t))2103        steps.push_back(fir::getBase(converter.genExprValue(2104            *Fortran::semantics::GetExpr(*expr), stmtCtx)));2105      else // If `step` is not present, assume it is `1`.2106        steps.push_back(builder.createIntegerConstant(2107            currentLocation, upperbounds[upperbounds.size() - 1].getType(), 1));2108 2109      const auto &name = std::get<Fortran::parser::Name>(control.t);2110      privatizeIv(converter, *name.symbol, currentLocation, ivTypes, ivLocs,2111                  privateOperands, ivPrivate, isDoConcurrent);2112 2113      inclusiveBounds.push_back(true);2114    }2115  } else {2116    visitLoopControl(2117        converter, outerDoConstruct, loopsToProcess, eval,2118        [&](const Fortran::parser::LoopControl::Bounds &bounds,2119            mlir::Location loc) {2120          locs.push_back(loc);2121          lowerbounds.push_back(fir::getBase(converter.genExprValue(2122              *Fortran::semantics::GetExpr(bounds.lower), stmtCtx)));2123          upperbounds.push_back(fir::getBase(converter.genExprValue(2124              *Fortran::semantics::GetExpr(bounds.upper), stmtCtx)));2125          if (bounds.step)2126            steps.push_back(fir::getBase(converter.genExprValue(2127                *Fortran::semantics::GetExpr(bounds.step), stmtCtx)));2128          else // If `step` is not present, assume it is `1`.2129            steps.push_back(builder.createIntegerConstant(2130                currentLocation, upperbounds[upperbounds.size() - 1].getType(),2131                1));2132          Fortran::semantics::Symbol &ivSym =2133              bounds.name.thing.symbol->GetUltimate();2134          privatizeIv(converter, ivSym, currentLocation, ivTypes, ivLocs,2135                      privateOperands, ivPrivate);2136 2137          inclusiveBounds.push_back(true);2138        });2139  }2140}2141 2142static void remapCommonBlockMember(2143    Fortran::lower::AbstractConverter &converter, mlir::Location loc,2144    const Fortran::semantics::Symbol &member,2145    mlir::Value newCommonBlockBaseAddress,2146    const Fortran::semantics::Symbol &commonBlockSymbol,2147    llvm::SmallPtrSetImpl<const Fortran::semantics::Symbol *> &seenSymbols) {2148  if (seenSymbols.contains(&member))2149    return;2150  mlir::Value accMemberValue = Fortran::lower::genCommonBlockMember(2151      converter, loc, member, newCommonBlockBaseAddress,2152      commonBlockSymbol.size());2153  fir::ExtendedValue hostExv = converter.getSymbolExtendedValue(member);2154  fir::ExtendedValue accExv = fir::substBase(hostExv, accMemberValue);2155  converter.bindSymbol(member, accExv);2156  seenSymbols.insert(&member);2157}2158 2159/// Remap symbols that appeared in OpenACC data clauses to use the results of2160/// the corresponding data operations. This allows isolating symbol accesses2161/// inside the OpenACC region from accesses in the host and other regions while2162/// preserving Fortran information about the symbols for optimizations.2163template <typename RegionOp>2164static void remapDataOperandSymbols(2165    Fortran::lower::AbstractConverter &converter, fir::FirOpBuilder &builder,2166    RegionOp &regionOp,2167    const llvm::SmallVector<2168        std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2169        &dataOperandSymbolPairs) {2170  if (!enableSymbolRemapping || dataOperandSymbolPairs.empty())2171    return;2172 2173  // Map Symbols that appeared inside data clauses to a new hlfir.declare whose2174  // input is the acc data operation result.2175  // This allows isolating all the symbol accesses inside the compute region2176  // from accesses in the host and other regions while preserving the Fortran2177  // information about the symbols for Fortran specific optimizations inside the2178  // region.2179  Fortran::lower::SymMap &symbolMap = converter.getSymbolMap();2180  mlir::OpBuilder::InsertionGuard insertGuard(builder);2181  builder.setInsertionPointToStart(&regionOp.getRegion().front());2182  llvm::SmallPtrSet<const Fortran::semantics::Symbol *, 8> seenSymbols;2183  mlir::IRMapping mapper;2184  mlir::Location loc = regionOp.getLoc();2185  for (auto [value, symbol] : dataOperandSymbolPairs) {2186    // If a symbol appears on several data clause, just map it to the first2187    // result (all data operations results for a symbol are pointing same2188    // memory, so it does not matter which one is used).2189    if (seenSymbols.contains(&symbol.get()))2190      continue;2191    seenSymbols.insert(&symbol.get());2192    // When a common block appears in a directive, remap its members.2193    // Note: this will instantiate all common block members even if they are not2194    // used inside the region. If hlfir.declare DCE is not made possible, this2195    // could be improved to reduce IR noise.2196    if (const auto *commonBlock = symbol->template detailsIf<2197                                  Fortran::semantics::CommonBlockDetails>()) {2198      const Fortran::semantics::Scope &commonScope = symbol->owner();2199      if (commonScope.equivalenceSets().empty()) {2200        for (auto member : commonBlock->objects())2201          remapCommonBlockMember(converter, loc, *member, value, *symbol,2202                                 seenSymbols);2203      } else {2204        // Objects equivalenced with common block members still belong to the2205        // common block storage even if they are not part of the common block2206        // declaration. The easiest and most robust way to find all symbols2207        // belonging to the common block is to loop through the scope symbols2208        // and check if they belong to the common.2209        for (const auto &scopeSymbol : commonScope)2210          if (Fortran::semantics::FindCommonBlockContaining(2211                  *scopeSymbol.second) == &symbol.get())2212            remapCommonBlockMember(converter, loc, *scopeSymbol.second, value,2213                                   *symbol, seenSymbols);2214      }2215      continue;2216    }2217    std::optional<fir::FortranVariableOpInterface> hostDef =2218        symbolMap.lookupVariableDefinition(symbol);2219    assert(hostDef.has_value() && llvm::isa<hlfir::DeclareOp>(*hostDef) &&2220           "expected symbol to be mapped to hlfir.declare");2221    auto hostDeclare = llvm::cast<hlfir::DeclareOp>(*hostDef);2222    // Replace base input and DummyScope inputs.2223    mlir::Value hostInput = hostDeclare.getMemref();2224    mlir::Type hostType = hostInput.getType();2225    mlir::Type computeType = value.getType();2226    if (hostType == computeType) {2227      mapper.map(hostInput, value);2228    } else if (llvm::isa<fir::BaseBoxType>(computeType)) {2229      assert(!llvm::isa<fir::BaseBoxType>(hostType) &&2230             "box type mismatch between compute region variable and "2231             "hlfir.declare input unexpected");2232      if (Fortran::semantics::IsOptional(symbol))2233        TODO(loc, "remapping OPTIONAL symbol in OpenACC compute region");2234      auto rawValue = fir::BoxAddrOp::create(builder, loc, hostType, value);2235      mapper.map(hostInput, rawValue);2236    } else {2237      assert(!llvm::isa<fir::BaseBoxType>(hostType) &&2238             "compute region variable should not be raw address when host "2239             "hlfir.declare input was a box");2240      assert(fir::isBoxAddress(hostType) == fir::isBoxAddress(computeType) &&2241             "compute region variable should be a pointer/allocatable if and "2242             "only if host is");2243      assert(fir::isa_ref_type(hostType) && fir::isa_ref_type(computeType) &&2244             "compute region variable and host variable should both be raw "2245             "addresses");2246      mlir::Value cast = builder.createConvert(loc, hostType, value);2247      mapper.map(hostInput, cast);2248    }2249    if (mlir::Value dummyScope = hostDeclare.getDummyScope()) {2250      // Copy the dummy scope into the region so that aliasing rules about2251      // Fortran dummies are understood inside the region and the abstract dummy2252      // scope type does not have to cross the OpenACC compute region boundary.2253      if (!mapper.contains(dummyScope)) {2254        mlir::Operation *hostDummyScopeOp = dummyScope.getDefiningOp();2255        assert(hostDummyScopeOp &&2256               "dummyScope defining operation must be visible in lowering");2257        (void)builder.clone(*hostDummyScopeOp, mapper);2258      }2259    }2260 2261    mlir::Operation *computeDef =2262        builder.clone(*hostDeclare.getOperation(), mapper);2263 2264    // The input box already went through an hlfir.declare. It has the correct2265    // local lower bounds and attribute. Do not generate a new fir.rebox.2266    if (llvm::isa<fir::BaseBoxType>(hostDeclare.getMemref().getType()))2267      llvm::cast<hlfir::DeclareOp>(*computeDef).setSkipRebox(true);2268 2269    symbolMap.addVariableDefinition(2270        symbol, llvm::cast<fir::FortranVariableOpInterface>(computeDef));2271  }2272}2273 2274static void privatizeInductionVariables(2275    Fortran::lower::AbstractConverter &converter,2276    mlir::Location currentLocation,2277    const Fortran::parser::DoConstruct &outerDoConstruct,2278    Fortran::lower::pft::Evaluation &eval,2279    llvm::SmallVector<mlir::Value> &privateOperands,2280    llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2281        &ivPrivate,2282    llvm::SmallVector<mlir::Location> &locs, uint64_t loopsToProcess) {2283  // ivTypes and locs will be ignored since no acc.loop control arguments will2284  // be created.2285  llvm::SmallVector<mlir::Type> ivTypes;2286  llvm::SmallVector<mlir::Location> ivLocs;2287  assert(!outerDoConstruct.IsDoConcurrent() &&2288         "do concurrent loops are not expected to contained earlty exits");2289  visitLoopControl(converter, outerDoConstruct, loopsToProcess, eval,2290                   [&](const Fortran::parser::LoopControl::Bounds &bounds,2291                       mlir::Location loc) {2292                     locs.push_back(loc);2293                     Fortran::semantics::Symbol &ivSym =2294                         bounds.name.thing.symbol->GetUltimate();2295                     privatizeIv(converter, ivSym, currentLocation, ivTypes,2296                                 ivLocs, privateOperands, ivPrivate);2297                   });2298}2299 2300static mlir::acc::LoopOp buildACCLoopOp(2301    Fortran::lower::AbstractConverter &converter,2302    mlir::Location currentLocation,2303    Fortran::semantics::SemanticsContext &semanticsContext,2304    Fortran::lower::StatementContext &stmtCtx,2305    const Fortran::parser::DoConstruct &outerDoConstruct,2306    Fortran::lower::pft::Evaluation &eval,2307    llvm::SmallVector<mlir::Value> &privateOperands,2308    llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2309        &dataOperandSymbolPairs,2310    llvm::SmallVector<mlir::Value> &gangOperands,2311    llvm::SmallVector<mlir::Value> &workerNumOperands,2312    llvm::SmallVector<mlir::Value> &vectorOperands,2313    llvm::SmallVector<mlir::Value> &tileOperands,2314    llvm::SmallVector<mlir::Value> &cacheOperands,2315    llvm::SmallVector<mlir::Value> &reductionOperands,2316    llvm::SmallVector<mlir::Type> &retTy, mlir::Value yieldValue,2317    uint64_t loopsToProcess) {2318  fir::FirOpBuilder &builder = converter.getFirOpBuilder();2319 2320  llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2321      ivPrivate;2322  llvm::SmallVector<mlir::Type> ivTypes;2323  llvm::SmallVector<mlir::Location> ivLocs;2324  llvm::SmallVector<bool> inclusiveBounds;2325  llvm::SmallVector<mlir::Location> locs;2326  llvm::SmallVector<mlir::Value> lowerbounds, upperbounds, steps;2327 2328  // Look at the do/do concurrent loops to extract bounds information unless2329  // this loop is lowered in an unstructured fashion, in which case bounds are2330  // not represented on acc.loop and explicit control flow is used inside body.2331  if (!eval.lowerAsUnstructured()) {2332    processDoLoopBounds(converter, currentLocation, stmtCtx, builder,2333                        outerDoConstruct, eval, lowerbounds, upperbounds, steps,2334                        privateOperands, ivPrivate, ivTypes, ivLocs,2335                        inclusiveBounds, locs, loopsToProcess);2336  } else {2337    // When the loop contains early exits, privatize induction variables, but do2338    // not create acc.loop bounds. The control flow of the loop will be2339    // generated explicitly in the acc.loop body that is just a container.2340    privatizeInductionVariables(converter, currentLocation, outerDoConstruct,2341                                eval, privateOperands, ivPrivate, locs,2342                                loopsToProcess);2343  }2344  llvm::SmallVector<mlir::Value> operands;2345  llvm::SmallVector<int32_t> operandSegments;2346  addOperands(operands, operandSegments, lowerbounds);2347  addOperands(operands, operandSegments, upperbounds);2348  addOperands(operands, operandSegments, steps);2349  addOperands(operands, operandSegments, gangOperands);2350  addOperands(operands, operandSegments, workerNumOperands);2351  addOperands(operands, operandSegments, vectorOperands);2352  addOperands(operands, operandSegments, tileOperands);2353  addOperands(operands, operandSegments, cacheOperands);2354  addOperands(operands, operandSegments, privateOperands);2355  // fill empty firstprivate operands since they are not permitted2356  // from OpenACC language perspective.2357  addOperands(operands, operandSegments, {});2358  addOperands(operands, operandSegments, reductionOperands);2359 2360  auto loopOp = createRegionOp<mlir::acc::LoopOp, mlir::acc::YieldOp>(2361      builder, builder.getFusedLoc(locs), currentLocation, eval, operands,2362      operandSegments, /*outerCombined=*/false, retTy, yieldValue, ivTypes,2363      ivLocs);2364  // Ensure the iv symbol is mapped to private iv SSA value for the scope of2365  // the loop even if it did not appear explicitly in a PRIVATE clause (if it2366  // appeared explicitly in such clause, that is also fine because duplicates2367  // in the list are ignored).2368  dataOperandSymbolPairs.append(ivPrivate.begin(), ivPrivate.end());2369  // Remap symbols from data clauses to use data operation results2370  remapDataOperandSymbols(converter, builder, loopOp, dataOperandSymbolPairs);2371 2372  if (!eval.lowerAsUnstructured()) {2373    for (auto [arg, iv] :2374         llvm::zip(loopOp.getLoopRegions().front()->front().getArguments(),2375                   ivPrivate)) {2376      // Store block argument to the related iv private variable.2377      mlir::Value privateValue = converter.getSymbolAddress(2378          std::get<Fortran::semantics::SymbolRef>(iv));2379      fir::StoreOp::create(builder, currentLocation, arg, privateValue);2380    }2381    loopOp.setInclusiveUpperbound(inclusiveBounds);2382  } else {2383    loopOp.setUnstructuredAttr(builder.getUnitAttr());2384  }2385 2386  return loopOp;2387}2388 2389static bool hasEarlyReturn(Fortran::lower::pft::Evaluation &eval) {2390  bool hasReturnStmt = false;2391  for (auto &e : eval.getNestedEvaluations()) {2392    e.visit(Fortran::common::visitors{2393        [&](const Fortran::parser::ReturnStmt &) { hasReturnStmt = true; },2394        [&](const auto &s) {},2395    });2396    if (e.hasNestedEvaluations())2397      hasReturnStmt = hasEarlyReturn(e);2398  }2399  return hasReturnStmt;2400}2401 2402static mlir::acc::LoopOp createLoopOp(2403    Fortran::lower::AbstractConverter &converter,2404    mlir::Location currentLocation,2405    Fortran::semantics::SemanticsContext &semanticsContext,2406    Fortran::lower::StatementContext &stmtCtx,2407    const Fortran::parser::DoConstruct &outerDoConstruct,2408    Fortran::lower::pft::Evaluation &eval,2409    const Fortran::parser::AccClauseList &accClauseList,2410    std::optional<mlir::acc::CombinedConstructsType> combinedConstructs =2411        std::nullopt) {2412  fir::FirOpBuilder &builder = converter.getFirOpBuilder();2413  llvm::SmallVector<mlir::Value> tileOperands, privateOperands,2414      reductionOperands, cacheOperands, vectorOperands, workerNumOperands,2415      gangOperands;2416  llvm::SmallVector<int32_t> tileOperandsSegments, gangOperandsSegments;2417  llvm::SmallVector<int64_t> collapseValues;2418 2419  // Vector to track mlir::Value results and their corresponding Fortran symbols2420  llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2421      dataOperandSymbolPairs;2422 2423  llvm::SmallVector<mlir::Attribute> gangArgTypes;2424  llvm::SmallVector<mlir::Attribute> seqDeviceTypes, independentDeviceTypes,2425      autoDeviceTypes, vectorOperandsDeviceTypes, workerNumOperandsDeviceTypes,2426      vectorDeviceTypes, workerNumDeviceTypes, tileOperandsDeviceTypes,2427      collapseDeviceTypes, gangDeviceTypes, gangOperandsDeviceTypes;2428 2429  // device_type attribute is set to `none` until a device_type clause is2430  // encountered.2431  llvm::SmallVector<mlir::Attribute> crtDeviceTypes;2432  crtDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(2433      builder.getContext(), mlir::acc::DeviceType::None));2434 2435  for (const Fortran::parser::AccClause &clause : accClauseList.v) {2436    mlir::Location clauseLocation = converter.genLocation(clause.source);2437    if (const auto *gangClause =2438            std::get_if<Fortran::parser::AccClause::Gang>(&clause.u)) {2439      if (gangClause->v) {2440        const Fortran::parser::AccGangArgList &x = *gangClause->v;2441        mlir::SmallVector<mlir::Value> gangValues;2442        mlir::SmallVector<mlir::Attribute> gangArgs;2443        for (const Fortran::parser::AccGangArg &gangArg : x.v) {2444          if (const auto *num =2445                  std::get_if<Fortran::parser::AccGangArg::Num>(&gangArg.u)) {2446            gangValues.push_back(fir::getBase(converter.genExprValue(2447                *Fortran::semantics::GetExpr(num->v), stmtCtx)));2448            gangArgs.push_back(mlir::acc::GangArgTypeAttr::get(2449                builder.getContext(), mlir::acc::GangArgType::Num));2450          } else if (const auto *staticArg =2451                         std::get_if<Fortran::parser::AccGangArg::Static>(2452                             &gangArg.u)) {2453            const Fortran::parser::AccSizeExpr &sizeExpr = staticArg->v;2454            if (sizeExpr.v) {2455              gangValues.push_back(fir::getBase(converter.genExprValue(2456                  *Fortran::semantics::GetExpr(*sizeExpr.v), stmtCtx)));2457            } else {2458              // * was passed as value and will be represented as a special2459              // constant.2460              gangValues.push_back(builder.createIntegerConstant(2461                  clauseLocation, builder.getIndexType(), starCst));2462            }2463            gangArgs.push_back(mlir::acc::GangArgTypeAttr::get(2464                builder.getContext(), mlir::acc::GangArgType::Static));2465          } else if (const auto *dim =2466                         std::get_if<Fortran::parser::AccGangArg::Dim>(2467                             &gangArg.u)) {2468            gangValues.push_back(fir::getBase(converter.genExprValue(2469                *Fortran::semantics::GetExpr(dim->v), stmtCtx)));2470            gangArgs.push_back(mlir::acc::GangArgTypeAttr::get(2471                builder.getContext(), mlir::acc::GangArgType::Dim));2472          }2473        }2474        for (auto crtDeviceTypeAttr : crtDeviceTypes) {2475          for (const auto &pair : llvm::zip(gangValues, gangArgs)) {2476            gangOperands.push_back(std::get<0>(pair));2477            gangArgTypes.push_back(std::get<1>(pair));2478          }2479          gangOperandsSegments.push_back(gangValues.size());2480          gangOperandsDeviceTypes.push_back(crtDeviceTypeAttr);2481        }2482      } else {2483        for (auto crtDeviceTypeAttr : crtDeviceTypes)2484          gangDeviceTypes.push_back(crtDeviceTypeAttr);2485      }2486    } else if (const auto *workerClause =2487                   std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) {2488      if (workerClause->v) {2489        mlir::Value workerNumValue = fir::getBase(converter.genExprValue(2490            *Fortran::semantics::GetExpr(*workerClause->v), stmtCtx));2491        for (auto crtDeviceTypeAttr : crtDeviceTypes) {2492          workerNumOperands.push_back(workerNumValue);2493          workerNumOperandsDeviceTypes.push_back(crtDeviceTypeAttr);2494        }2495      } else {2496        for (auto crtDeviceTypeAttr : crtDeviceTypes)2497          workerNumDeviceTypes.push_back(crtDeviceTypeAttr);2498      }2499    } else if (const auto *vectorClause =2500                   std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) {2501      if (vectorClause->v) {2502        mlir::Value vectorValue = fir::getBase(converter.genExprValue(2503            *Fortran::semantics::GetExpr(*vectorClause->v), stmtCtx));2504        for (auto crtDeviceTypeAttr : crtDeviceTypes) {2505          vectorOperands.push_back(vectorValue);2506          vectorOperandsDeviceTypes.push_back(crtDeviceTypeAttr);2507        }2508      } else {2509        for (auto crtDeviceTypeAttr : crtDeviceTypes)2510          vectorDeviceTypes.push_back(crtDeviceTypeAttr);2511      }2512    } else if (const auto *tileClause =2513                   std::get_if<Fortran::parser::AccClause::Tile>(&clause.u)) {2514      const Fortran::parser::AccTileExprList &accTileExprList = tileClause->v;2515      llvm::SmallVector<mlir::Value> tileValues;2516      for (const auto &accTileExpr : accTileExprList.v) {2517        const auto &expr =2518            std::get<std::optional<Fortran::parser::ScalarIntConstantExpr>>(2519                accTileExpr.t);2520        if (expr) {2521          tileValues.push_back(fir::getBase(converter.genExprValue(2522              *Fortran::semantics::GetExpr(*expr), stmtCtx)));2523        } else {2524          // * was passed as value and will be represented as a special2525          // constant.2526          mlir::Value tileStar = builder.createIntegerConstant(2527              clauseLocation, builder.getIntegerType(32), starCst);2528          tileValues.push_back(tileStar);2529        }2530      }2531      for (auto crtDeviceTypeAttr : crtDeviceTypes) {2532        for (auto value : tileValues)2533          tileOperands.push_back(value);2534        tileOperandsDeviceTypes.push_back(crtDeviceTypeAttr);2535        tileOperandsSegments.push_back(tileValues.size());2536      }2537    } else if (const auto *privateClause =2538                   std::get_if<Fortran::parser::AccClause::Private>(2539                       &clause.u)) {2540      genPrivatizationRecipes<mlir::acc::PrivateRecipeOp>(2541          privateClause->v, converter, semanticsContext, stmtCtx,2542          privateOperands, /*async=*/{},2543          /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{},2544          &dataOperandSymbolPairs);2545    } else if (const auto *reductionClause =2546                   std::get_if<Fortran::parser::AccClause::Reduction>(2547                       &clause.u)) {2548      genReductions(reductionClause->v, converter, semanticsContext, stmtCtx,2549                    reductionOperands, /*async=*/{},2550                    /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{},2551                    &dataOperandSymbolPairs);2552    } else if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) {2553      for (auto crtDeviceTypeAttr : crtDeviceTypes)2554        seqDeviceTypes.push_back(crtDeviceTypeAttr);2555    } else if (std::get_if<Fortran::parser::AccClause::Independent>(2556                   &clause.u)) {2557      for (auto crtDeviceTypeAttr : crtDeviceTypes)2558        independentDeviceTypes.push_back(crtDeviceTypeAttr);2559    } else if (std::get_if<Fortran::parser::AccClause::Auto>(&clause.u)) {2560      for (auto crtDeviceTypeAttr : crtDeviceTypes)2561        autoDeviceTypes.push_back(crtDeviceTypeAttr);2562    } else if (const auto *deviceTypeClause =2563                   std::get_if<Fortran::parser::AccClause::DeviceType>(2564                       &clause.u)) {2565      crtDeviceTypes.clear();2566      gatherDeviceTypeAttrs(builder, deviceTypeClause, crtDeviceTypes);2567    } else if (const auto *collapseClause =2568                   std::get_if<Fortran::parser::AccClause::Collapse>(2569                       &clause.u)) {2570      const Fortran::parser::AccCollapseArg &arg = collapseClause->v;2571      const auto &intExpr =2572          std::get<Fortran::parser::ScalarIntConstantExpr>(arg.t);2573      const auto *expr = Fortran::semantics::GetExpr(intExpr);2574      const std::optional<int64_t> collapseValue =2575          Fortran::evaluate::ToInt64(*expr);2576      assert(collapseValue && "expect integer value for the collapse clause");2577 2578      for (auto crtDeviceTypeAttr : crtDeviceTypes) {2579        collapseValues.push_back(*collapseValue);2580        collapseDeviceTypes.push_back(crtDeviceTypeAttr);2581      }2582    }2583  }2584 2585  llvm::SmallVector<mlir::Type> retTy;2586  mlir::Value yieldValue;2587  if (eval.lowerAsUnstructured() && hasEarlyReturn(eval)) {2588    // When there is a return statement inside the loop, add a result to the2589    // acc.loop that will be used in a conditional branch after the loop to2590    // return.2591    mlir::Type i1Ty = builder.getI1Type();2592    yieldValue = builder.createIntegerConstant(currentLocation, i1Ty, 0);2593    retTy.push_back(i1Ty);2594  }2595 2596  uint64_t loopsToProcess =2597      Fortran::lower::getLoopCountForCollapseAndTile(accClauseList);2598  auto loopOp = buildACCLoopOp(2599      converter, currentLocation, semanticsContext, stmtCtx, outerDoConstruct,2600      eval, privateOperands, dataOperandSymbolPairs, gangOperands,2601      workerNumOperands, vectorOperands, tileOperands, cacheOperands,2602      reductionOperands, retTy, yieldValue, loopsToProcess);2603 2604  if (!gangDeviceTypes.empty())2605    loopOp.setGangAttr(builder.getArrayAttr(gangDeviceTypes));2606  if (!gangArgTypes.empty())2607    loopOp.setGangOperandsArgTypeAttr(builder.getArrayAttr(gangArgTypes));2608  if (!gangOperandsSegments.empty())2609    loopOp.setGangOperandsSegmentsAttr(2610        builder.getDenseI32ArrayAttr(gangOperandsSegments));2611  if (!gangOperandsDeviceTypes.empty())2612    loopOp.setGangOperandsDeviceTypeAttr(2613        builder.getArrayAttr(gangOperandsDeviceTypes));2614 2615  if (!workerNumDeviceTypes.empty())2616    loopOp.setWorkerAttr(builder.getArrayAttr(workerNumDeviceTypes));2617  if (!workerNumOperandsDeviceTypes.empty())2618    loopOp.setWorkerNumOperandsDeviceTypeAttr(2619        builder.getArrayAttr(workerNumOperandsDeviceTypes));2620 2621  if (!vectorDeviceTypes.empty())2622    loopOp.setVectorAttr(builder.getArrayAttr(vectorDeviceTypes));2623  if (!vectorOperandsDeviceTypes.empty())2624    loopOp.setVectorOperandsDeviceTypeAttr(2625        builder.getArrayAttr(vectorOperandsDeviceTypes));2626 2627  if (!tileOperandsDeviceTypes.empty())2628    loopOp.setTileOperandsDeviceTypeAttr(2629        builder.getArrayAttr(tileOperandsDeviceTypes));2630  if (!tileOperandsSegments.empty())2631    loopOp.setTileOperandsSegmentsAttr(2632        builder.getDenseI32ArrayAttr(tileOperandsSegments));2633 2634  // Determine the loop's default par mode - either seq, independent, or auto.2635  determineDefaultLoopParMode(converter, loopOp, seqDeviceTypes,2636                              independentDeviceTypes, autoDeviceTypes);2637  if (!seqDeviceTypes.empty())2638    loopOp.setSeqAttr(builder.getArrayAttr(seqDeviceTypes));2639  if (!independentDeviceTypes.empty())2640    loopOp.setIndependentAttr(builder.getArrayAttr(independentDeviceTypes));2641  if (!autoDeviceTypes.empty())2642    loopOp.setAuto_Attr(builder.getArrayAttr(autoDeviceTypes));2643 2644  if (!collapseValues.empty())2645    loopOp.setCollapseAttr(builder.getI64ArrayAttr(collapseValues));2646  if (!collapseDeviceTypes.empty())2647    loopOp.setCollapseDeviceTypeAttr(builder.getArrayAttr(collapseDeviceTypes));2648 2649  if (combinedConstructs)2650    loopOp.setCombinedAttr(mlir::acc::CombinedConstructsTypeAttr::get(2651        builder.getContext(), *combinedConstructs));2652 2653  // TODO: retrieve directives from NonLabelDoStmt pft::Evaluation, and add them2654  // as attribute to the acc.loop as an extra attribute. It is not quite clear2655  // how useful these $dir are in acc contexts, but they could still provide2656  // more information about the loop acc codegen. They can be obtained by2657  // looking for the first lexicalSuccessor of eval that is a NonLabelDoStmt,2658  // and using the related `dirs` member.2659 2660  return loopOp;2661}2662 2663static mlir::Value2664genACC(Fortran::lower::AbstractConverter &converter,2665       Fortran::semantics::SemanticsContext &semanticsContext,2666       Fortran::lower::pft::Evaluation &eval,2667       const Fortran::parser::OpenACCLoopConstruct &loopConstruct) {2668 2669  const auto &beginLoopDirective =2670      std::get<Fortran::parser::AccBeginLoopDirective>(loopConstruct.t);2671  const auto &loopDirective =2672      std::get<Fortran::parser::AccLoopDirective>(beginLoopDirective.t);2673 2674  mlir::Location currentLocation =2675      converter.genLocation(beginLoopDirective.source);2676  Fortran::lower::StatementContext stmtCtx;2677 2678  assert(loopDirective.v == llvm::acc::ACCD_loop &&2679         "Unsupported OpenACC loop construct");2680  (void)loopDirective;2681 2682  const auto &accClauseList =2683      std::get<Fortran::parser::AccClauseList>(beginLoopDirective.t);2684  const auto &outerDoConstruct =2685      std::get<std::optional<Fortran::parser::DoConstruct>>(loopConstruct.t);2686  auto loopOp = createLoopOp(converter, currentLocation, semanticsContext,2687                             stmtCtx, *outerDoConstruct, eval, accClauseList,2688                             /*combinedConstructs=*/{});2689  if (loopOp.getNumResults() == 1)2690    return loopOp.getResult(0);2691 2692  return mlir::Value{};2693}2694 2695template <typename Op, typename Clause>2696static void genDataOperandOperationsWithModifier(2697    const Clause *x, Fortran::lower::AbstractConverter &converter,2698    Fortran::semantics::SemanticsContext &semanticsContext,2699    Fortran::lower::StatementContext &stmtCtx,2700    Fortran::parser::AccDataModifier::Modifier mod,2701    llvm::SmallVectorImpl<mlir::Value> &dataClauseOperands,2702    const mlir::acc::DataClause clause,2703    const mlir::acc::DataClause clauseWithModifier,2704    llvm::ArrayRef<mlir::Value> async,2705    llvm::ArrayRef<mlir::Attribute> asyncDeviceTypes,2706    llvm::ArrayRef<mlir::Attribute> asyncOnlyDeviceTypes,2707    bool setDeclareAttr = false,2708    llvm::SmallVectorImpl<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2709        *symbolPairs = nullptr) {2710  const Fortran::parser::AccObjectListWithModifier &listWithModifier = x->v;2711  const auto &accObjectList =2712      std::get<Fortran::parser::AccObjectList>(listWithModifier.t);2713  const auto &modifier =2714      std::get<std::optional<Fortran::parser::AccDataModifier>>(2715          listWithModifier.t);2716  mlir::acc::DataClause dataClause =2717      (modifier && (*modifier).v == mod) ? clauseWithModifier : clause;2718  genDataOperandOperations<Op>(accObjectList, converter, semanticsContext,2719                               stmtCtx, dataClauseOperands, dataClause,2720                               /*structured=*/true, /*implicit=*/false, async,2721                               asyncDeviceTypes, asyncOnlyDeviceTypes,2722                               setDeclareAttr, symbolPairs);2723}2724 2725template <typename Op>2726static Op createComputeOp(2727    Fortran::lower::AbstractConverter &converter,2728    mlir::Location currentLocation, Fortran::lower::pft::Evaluation &eval,2729    Fortran::semantics::SemanticsContext &semanticsContext,2730    Fortran::lower::StatementContext &stmtCtx,2731    const Fortran::parser::AccClauseList &accClauseList,2732    std::optional<mlir::acc::CombinedConstructsType> combinedConstructs =2733        std::nullopt) {2734 2735  // Parallel operation operands2736  mlir::Value ifCond;2737  mlir::Value selfCond;2738  llvm::SmallVector<mlir::Value> waitOperands, attachEntryOperands,2739      copyEntryOperands, copyinEntryOperands, copyoutEntryOperands,2740      createEntryOperands, nocreateEntryOperands, presentEntryOperands,2741      dataClauseOperands, numGangs, numWorkers, vectorLength, async;2742  llvm::SmallVector<mlir::Attribute> numGangsDeviceTypes, numWorkersDeviceTypes,2743      vectorLengthDeviceTypes, asyncDeviceTypes, asyncOnlyDeviceTypes,2744      waitOperandsDeviceTypes, waitOnlyDeviceTypes;2745  llvm::SmallVector<int32_t> numGangsSegments, waitOperandsSegments;2746  llvm::SmallVector<bool> hasWaitDevnums;2747 2748  llvm::SmallVector<mlir::Value> reductionOperands, privateOperands,2749      firstprivateOperands;2750 2751  // Vector to track mlir::Value results and their corresponding Fortran symbols2752  llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>2753      dataOperandSymbolPairs;2754 2755  // Self clause has optional values but can be present with2756  // no value as well. When there is no value, the op has an attribute to2757  // represent the clause.2758  bool addSelfAttr = false;2759 2760  bool hasDefaultNone = false;2761  bool hasDefaultPresent = false;2762 2763  fir::FirOpBuilder &builder = converter.getFirOpBuilder();2764 2765  // device_type attribute is set to `none` until a device_type clause is2766  // encountered.2767  llvm::SmallVector<mlir::Attribute> crtDeviceTypes;2768  auto crtDeviceTypeAttr = mlir::acc::DeviceTypeAttr::get(2769      builder.getContext(), mlir::acc::DeviceType::None);2770  crtDeviceTypes.push_back(crtDeviceTypeAttr);2771 2772  // Lower clauses values mapped to operands and array attributes.2773  // Keep track of each group of operands separately as clauses can appear2774  // more than once.2775 2776  // Process the clauses that may have a specified device_type first.2777  for (const Fortran::parser::AccClause &clause : accClauseList.v) {2778    if (const auto *asyncClause =2779            std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {2780      genAsyncClause(converter, asyncClause, async, asyncDeviceTypes,2781                     asyncOnlyDeviceTypes, crtDeviceTypes, stmtCtx);2782    } else if (const auto *waitClause =2783                   std::get_if<Fortran::parser::AccClause::Wait>(&clause.u)) {2784      genWaitClauseWithDeviceType(converter, waitClause, waitOperands,2785                                  waitOperandsDeviceTypes, waitOnlyDeviceTypes,2786                                  hasWaitDevnums, waitOperandsSegments,2787                                  crtDeviceTypes, stmtCtx);2788    } else if (const auto *numGangsClause =2789                   std::get_if<Fortran::parser::AccClause::NumGangs>(2790                       &clause.u)) {2791      llvm::SmallVector<mlir::Value> numGangValues;2792      for (const Fortran::parser::ScalarIntExpr &expr : numGangsClause->v)2793        numGangValues.push_back(fir::getBase(converter.genExprValue(2794            *Fortran::semantics::GetExpr(expr), stmtCtx)));2795      for (auto crtDeviceTypeAttr : crtDeviceTypes) {2796        for (auto value : numGangValues)2797          numGangs.push_back(value);2798        numGangsDeviceTypes.push_back(crtDeviceTypeAttr);2799        numGangsSegments.push_back(numGangValues.size());2800      }2801    } else if (const auto *numWorkersClause =2802                   std::get_if<Fortran::parser::AccClause::NumWorkers>(2803                       &clause.u)) {2804      mlir::Value numWorkerValue = fir::getBase(converter.genExprValue(2805          *Fortran::semantics::GetExpr(numWorkersClause->v), stmtCtx));2806      for (auto crtDeviceTypeAttr : crtDeviceTypes) {2807        numWorkers.push_back(numWorkerValue);2808        numWorkersDeviceTypes.push_back(crtDeviceTypeAttr);2809      }2810    } else if (const auto *vectorLengthClause =2811                   std::get_if<Fortran::parser::AccClause::VectorLength>(2812                       &clause.u)) {2813      mlir::Value vectorLengthValue = fir::getBase(converter.genExprValue(2814          *Fortran::semantics::GetExpr(vectorLengthClause->v), stmtCtx));2815      for (auto crtDeviceTypeAttr : crtDeviceTypes) {2816        vectorLength.push_back(vectorLengthValue);2817        vectorLengthDeviceTypes.push_back(crtDeviceTypeAttr);2818      }2819    } else if (const auto *deviceTypeClause =2820                   std::get_if<Fortran::parser::AccClause::DeviceType>(2821                       &clause.u)) {2822      crtDeviceTypes.clear();2823      gatherDeviceTypeAttrs(builder, deviceTypeClause, crtDeviceTypes);2824    }2825  }2826 2827  // Process the clauses independent of device_type.2828  for (const Fortran::parser::AccClause &clause : accClauseList.v) {2829    mlir::Location clauseLocation = converter.genLocation(clause.source);2830    if (const auto *ifClause =2831            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {2832      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);2833    } else if (const auto *selfClause =2834                   std::get_if<Fortran::parser::AccClause::Self>(&clause.u)) {2835      const std::optional<Fortran::parser::AccSelfClause> &accSelfClause =2836          selfClause->v;2837      if (accSelfClause) {2838        if (const auto *optCondition =2839                std::get_if<std::optional<Fortran::parser::ScalarLogicalExpr>>(2840                    &(*accSelfClause).u)) {2841          if (*optCondition) {2842            mlir::Value cond = fir::getBase(converter.genExprValue(2843                *Fortran::semantics::GetExpr(*optCondition), stmtCtx));2844            selfCond = builder.createConvert(clauseLocation,2845                                             builder.getI1Type(), cond);2846          }2847        } else if (const auto *accClauseList =2848                       std::get_if<Fortran::parser::AccObjectList>(2849                           &(*accSelfClause).u)) {2850          // TODO This would be nicer to be done in canonicalization step.2851          if (accClauseList->v.size() == 1) {2852            const auto &accObject = accClauseList->v.front();2853            if (const auto *designator =2854                    std::get_if<Fortran::parser::Designator>(&accObject.u)) {2855              if (const auto *name =2856                      Fortran::parser::GetDesignatorNameIfDataRef(2857                          *designator)) {2858                auto cond = converter.getSymbolAddress(*name->symbol);2859                selfCond = builder.createConvert(clauseLocation,2860                                                 builder.getI1Type(), cond);2861              }2862            }2863          }2864        }2865      } else {2866        addSelfAttr = true;2867      }2868    } else if (const auto *copyClause =2869                   std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {2870      auto crtDataStart = dataClauseOperands.size();2871      genDataOperandOperations<mlir::acc::CopyinOp>(2872          copyClause->v, converter, semanticsContext, stmtCtx,2873          dataClauseOperands, mlir::acc::DataClause::acc_copy,2874          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,2875          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2876          &dataOperandSymbolPairs);2877      copyEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2878                               dataClauseOperands.end());2879    } else if (const auto *copyinClause =2880                   std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {2881      auto crtDataStart = dataClauseOperands.size();2882      genDataOperandOperationsWithModifier<mlir::acc::CopyinOp,2883                                           Fortran::parser::AccClause::Copyin>(2884          copyinClause, converter, semanticsContext, stmtCtx,2885          Fortran::parser::AccDataModifier::Modifier::ReadOnly,2886          dataClauseOperands, mlir::acc::DataClause::acc_copyin,2887          mlir::acc::DataClause::acc_copyin_readonly, async, asyncDeviceTypes,2888          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2889          &dataOperandSymbolPairs);2890      copyinEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2891                                 dataClauseOperands.end());2892    } else if (const auto *copyoutClause =2893                   std::get_if<Fortran::parser::AccClause::Copyout>(2894                       &clause.u)) {2895      auto crtDataStart = dataClauseOperands.size();2896      genDataOperandOperationsWithModifier<mlir::acc::CreateOp,2897                                           Fortran::parser::AccClause::Copyout>(2898          copyoutClause, converter, semanticsContext, stmtCtx,2899          Fortran::parser::AccDataModifier::Modifier::Zero, dataClauseOperands,2900          mlir::acc::DataClause::acc_copyout,2901          mlir::acc::DataClause::acc_copyout_zero, async, asyncDeviceTypes,2902          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2903          &dataOperandSymbolPairs);2904      copyoutEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2905                                  dataClauseOperands.end());2906    } else if (const auto *createClause =2907                   std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {2908      auto crtDataStart = dataClauseOperands.size();2909      genDataOperandOperationsWithModifier<mlir::acc::CreateOp,2910                                           Fortran::parser::AccClause::Create>(2911          createClause, converter, semanticsContext, stmtCtx,2912          Fortran::parser::AccDataModifier::Modifier::Zero, dataClauseOperands,2913          mlir::acc::DataClause::acc_create,2914          mlir::acc::DataClause::acc_create_zero, async, asyncDeviceTypes,2915          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2916          &dataOperandSymbolPairs);2917      createEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2918                                 dataClauseOperands.end());2919    } else if (const auto *noCreateClause =2920                   std::get_if<Fortran::parser::AccClause::NoCreate>(2921                       &clause.u)) {2922      auto crtDataStart = dataClauseOperands.size();2923      genDataOperandOperations<mlir::acc::NoCreateOp>(2924          noCreateClause->v, converter, semanticsContext, stmtCtx,2925          dataClauseOperands, mlir::acc::DataClause::acc_no_create,2926          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,2927          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2928          &dataOperandSymbolPairs);2929      nocreateEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2930                                   dataClauseOperands.end());2931    } else if (const auto *presentClause =2932                   std::get_if<Fortran::parser::AccClause::Present>(2933                       &clause.u)) {2934      auto crtDataStart = dataClauseOperands.size();2935      genDataOperandOperations<mlir::acc::PresentOp>(2936          presentClause->v, converter, semanticsContext, stmtCtx,2937          dataClauseOperands, mlir::acc::DataClause::acc_present,2938          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,2939          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2940          &dataOperandSymbolPairs);2941      presentEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2942                                  dataClauseOperands.end());2943    } else if (const auto *devicePtrClause =2944                   std::get_if<Fortran::parser::AccClause::Deviceptr>(2945                       &clause.u)) {2946      llvm::SmallVectorImpl<2947          std::pair<mlir::Value, Fortran::semantics::SymbolRef>> *symPairs =2948          enableDevicePtrRemap ? &dataOperandSymbolPairs : nullptr;2949      genDataOperandOperations<mlir::acc::DevicePtrOp>(2950          devicePtrClause->v, converter, semanticsContext, stmtCtx,2951          dataClauseOperands, mlir::acc::DataClause::acc_deviceptr,2952          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,2953          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false, symPairs);2954    } else if (const auto *attachClause =2955                   std::get_if<Fortran::parser::AccClause::Attach>(&clause.u)) {2956      auto crtDataStart = dataClauseOperands.size();2957      genDataOperandOperations<mlir::acc::AttachOp>(2958          attachClause->v, converter, semanticsContext, stmtCtx,2959          dataClauseOperands, mlir::acc::DataClause::acc_attach,2960          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,2961          asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,2962          &dataOperandSymbolPairs);2963      attachEntryOperands.append(dataClauseOperands.begin() + crtDataStart,2964                                 dataClauseOperands.end());2965    } else if (const auto *privateClause =2966                   std::get_if<Fortran::parser::AccClause::Private>(2967                       &clause.u)) {2968      if (!combinedConstructs)2969        genPrivatizationRecipes<mlir::acc::PrivateRecipeOp>(2970            privateClause->v, converter, semanticsContext, stmtCtx,2971            privateOperands, async, asyncDeviceTypes, asyncOnlyDeviceTypes,2972            &dataOperandSymbolPairs);2973    } else if (const auto *firstprivateClause =2974                   std::get_if<Fortran::parser::AccClause::Firstprivate>(2975                       &clause.u)) {2976      genPrivatizationRecipes<mlir::acc::FirstprivateRecipeOp>(2977          firstprivateClause->v, converter, semanticsContext, stmtCtx,2978          firstprivateOperands, async, asyncDeviceTypes, asyncOnlyDeviceTypes,2979          &dataOperandSymbolPairs);2980    } else if (const auto *reductionClause =2981                   std::get_if<Fortran::parser::AccClause::Reduction>(2982                       &clause.u)) {2983      // A reduction clause on a combined construct is treated as if it appeared2984      // on the loop construct. So don't generate a reduction clause when it is2985      // combined - delay it to the loop. However, a reduction clause on a2986      // combined construct implies a copy clause so issue an implicit copy2987      // instead.2988      if (!combinedConstructs) {2989        genReductions(reductionClause->v, converter, semanticsContext, stmtCtx,2990                      reductionOperands, async, asyncDeviceTypes,2991                      asyncOnlyDeviceTypes, &dataOperandSymbolPairs);2992      } else {2993        auto crtDataStart = dataClauseOperands.size();2994        genDataOperandOperations<mlir::acc::CopyinOp>(2995            std::get<Fortran::parser::AccObjectList>(reductionClause->v.t),2996            converter, semanticsContext, stmtCtx, dataClauseOperands,2997            mlir::acc::DataClause::acc_reduction,2998            /*structured=*/true, /*implicit=*/true, async, asyncDeviceTypes,2999            asyncOnlyDeviceTypes, /*setDeclareAttr=*/false,3000            &dataOperandSymbolPairs);3001        copyEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3002                                 dataClauseOperands.end());3003      }3004    } else if (const auto *defaultClause =3005                   std::get_if<Fortran::parser::AccClause::Default>(3006                       &clause.u)) {3007      if ((defaultClause->v).v == llvm::acc::DefaultValue::ACC_Default_none)3008        hasDefaultNone = true;3009      else if ((defaultClause->v).v ==3010               llvm::acc::DefaultValue::ACC_Default_present)3011        hasDefaultPresent = true;3012    }3013  }3014 3015  // Prepare the operand segment size attribute and the operands value range.3016  llvm::SmallVector<mlir::Value, 8> operands;3017  llvm::SmallVector<int32_t, 8> operandSegments;3018  addOperands(operands, operandSegments, async);3019  addOperands(operands, operandSegments, waitOperands);3020  if constexpr (!std::is_same_v<Op, mlir::acc::SerialOp>) {3021    addOperands(operands, operandSegments, numGangs);3022    addOperands(operands, operandSegments, numWorkers);3023    addOperands(operands, operandSegments, vectorLength);3024  }3025  addOperand(operands, operandSegments, ifCond);3026  addOperand(operands, operandSegments, selfCond);3027  if constexpr (!std::is_same_v<Op, mlir::acc::KernelsOp>) {3028    addOperands(operands, operandSegments, reductionOperands);3029    addOperands(operands, operandSegments, privateOperands);3030    addOperands(operands, operandSegments, firstprivateOperands);3031  }3032  addOperands(operands, operandSegments, dataClauseOperands);3033 3034  Op computeOp;3035  if constexpr (std::is_same_v<Op, mlir::acc::KernelsOp>)3036    computeOp = createRegionOp<Op, mlir::acc::TerminatorOp>(3037        builder, currentLocation, currentLocation, eval, operands,3038        operandSegments, /*outerCombined=*/combinedConstructs.has_value());3039  else3040    computeOp = createRegionOp<Op, mlir::acc::YieldOp>(3041        builder, currentLocation, currentLocation, eval, operands,3042        operandSegments, /*outerCombined=*/combinedConstructs.has_value());3043 3044  if (addSelfAttr)3045    computeOp.setSelfAttrAttr(builder.getUnitAttr());3046 3047  if (hasDefaultNone)3048    computeOp.setDefaultAttr(mlir::acc::ClauseDefaultValue::None);3049  if (hasDefaultPresent)3050    computeOp.setDefaultAttr(mlir::acc::ClauseDefaultValue::Present);3051 3052  if constexpr (!std::is_same_v<Op, mlir::acc::SerialOp>) {3053    if (!numWorkersDeviceTypes.empty())3054      computeOp.setNumWorkersDeviceTypeAttr(3055          mlir::ArrayAttr::get(builder.getContext(), numWorkersDeviceTypes));3056    if (!vectorLengthDeviceTypes.empty())3057      computeOp.setVectorLengthDeviceTypeAttr(3058          mlir::ArrayAttr::get(builder.getContext(), vectorLengthDeviceTypes));3059    if (!numGangsDeviceTypes.empty())3060      computeOp.setNumGangsDeviceTypeAttr(3061          mlir::ArrayAttr::get(builder.getContext(), numGangsDeviceTypes));3062    if (!numGangsSegments.empty())3063      computeOp.setNumGangsSegmentsAttr(3064          builder.getDenseI32ArrayAttr(numGangsSegments));3065  }3066  if (!asyncDeviceTypes.empty())3067    computeOp.setAsyncOperandsDeviceTypeAttr(3068        builder.getArrayAttr(asyncDeviceTypes));3069  if (!asyncOnlyDeviceTypes.empty())3070    computeOp.setAsyncOnlyAttr(builder.getArrayAttr(asyncOnlyDeviceTypes));3071 3072  if (!waitOperandsDeviceTypes.empty())3073    computeOp.setWaitOperandsDeviceTypeAttr(3074        builder.getArrayAttr(waitOperandsDeviceTypes));3075  if (!waitOperandsSegments.empty())3076    computeOp.setWaitOperandsSegmentsAttr(3077        builder.getDenseI32ArrayAttr(waitOperandsSegments));3078  if (!hasWaitDevnums.empty())3079    computeOp.setHasWaitDevnumAttr(builder.getBoolArrayAttr(hasWaitDevnums));3080  if (!waitOnlyDeviceTypes.empty())3081    computeOp.setWaitOnlyAttr(builder.getArrayAttr(waitOnlyDeviceTypes));3082 3083  if (combinedConstructs)3084    computeOp.setCombinedAttr(builder.getUnitAttr());3085 3086  auto insPt = builder.saveInsertionPoint();3087 3088  // Remap symbols from data clauses to use data operation results3089  remapDataOperandSymbols(converter, builder, computeOp,3090                          dataOperandSymbolPairs);3091 3092  builder.setInsertionPointAfter(computeOp);3093 3094  // Create the exit operations after the region.3095  genDataExitOperations<mlir::acc::CopyinOp, mlir::acc::CopyoutOp>(3096      builder, copyEntryOperands, /*structured=*/true);3097  genDataExitOperations<mlir::acc::CopyinOp, mlir::acc::DeleteOp>(3098      builder, copyinEntryOperands, /*structured=*/true);3099  genDataExitOperations<mlir::acc::CreateOp, mlir::acc::CopyoutOp>(3100      builder, copyoutEntryOperands, /*structured=*/true);3101  genDataExitOperations<mlir::acc::AttachOp, mlir::acc::DetachOp>(3102      builder, attachEntryOperands, /*structured=*/true);3103  genDataExitOperations<mlir::acc::CreateOp, mlir::acc::DeleteOp>(3104      builder, createEntryOperands, /*structured=*/true);3105  genDataExitOperations<mlir::acc::NoCreateOp, mlir::acc::DeleteOp>(3106      builder, nocreateEntryOperands, /*structured=*/true);3107  genDataExitOperations<mlir::acc::PresentOp, mlir::acc::DeleteOp>(3108      builder, presentEntryOperands, /*structured=*/true);3109 3110  builder.restoreInsertionPoint(insPt);3111  return computeOp;3112}3113 3114static void genACCDataOp(Fortran::lower::AbstractConverter &converter,3115                         mlir::Location currentLocation,3116                         mlir::Location endLocation,3117                         Fortran::lower::pft::Evaluation &eval,3118                         Fortran::semantics::SemanticsContext &semanticsContext,3119                         Fortran::lower::StatementContext &stmtCtx,3120                         const Fortran::parser::AccClauseList &accClauseList) {3121  mlir::Value ifCond;3122  llvm::SmallVector<mlir::Value> attachEntryOperands, createEntryOperands,3123      copyEntryOperands, copyinEntryOperands, copyoutEntryOperands,3124      nocreateEntryOperands, presentEntryOperands, dataClauseOperands,3125      waitOperands, async;3126  llvm::SmallVector<mlir::Attribute> asyncDeviceTypes, asyncOnlyDeviceTypes,3127      waitOperandsDeviceTypes, waitOnlyDeviceTypes;3128  llvm::SmallVector<int32_t> waitOperandsSegments;3129  llvm::SmallVector<bool> hasWaitDevnums;3130 3131  bool hasDefaultNone = false;3132  bool hasDefaultPresent = false;3133 3134  fir::FirOpBuilder &builder = converter.getFirOpBuilder();3135 3136  // device_type attribute is set to `none` until a device_type clause is3137  // encountered.3138  llvm::SmallVector<mlir::Attribute> crtDeviceTypes;3139  crtDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(3140      builder.getContext(), mlir::acc::DeviceType::None));3141 3142  // Lower clauses values mapped to operands and array attributes.3143  // Keep track of each group of operands separately as clauses can appear3144  // more than once.3145 3146  // Process the clauses that may have a specified device_type first.3147  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3148    if (const auto *asyncClause =3149            std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {3150      genAsyncClause(converter, asyncClause, async, asyncDeviceTypes,3151                     asyncOnlyDeviceTypes, crtDeviceTypes, stmtCtx);3152    } else if (const auto *waitClause =3153                   std::get_if<Fortran::parser::AccClause::Wait>(&clause.u)) {3154      genWaitClauseWithDeviceType(converter, waitClause, waitOperands,3155                                  waitOperandsDeviceTypes, waitOnlyDeviceTypes,3156                                  hasWaitDevnums, waitOperandsSegments,3157                                  crtDeviceTypes, stmtCtx);3158    } else if (const auto *deviceTypeClause =3159                   std::get_if<Fortran::parser::AccClause::DeviceType>(3160                       &clause.u)) {3161      crtDeviceTypes.clear();3162      gatherDeviceTypeAttrs(builder, deviceTypeClause, crtDeviceTypes);3163    }3164  }3165 3166  // Process the clauses independent of device_type.3167  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3168    mlir::Location clauseLocation = converter.genLocation(clause.source);3169    if (const auto *ifClause =3170            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3171      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3172    } else if (const auto *copyClause =3173                   std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {3174      auto crtDataStart = dataClauseOperands.size();3175      genDataOperandOperations<mlir::acc::CopyinOp>(3176          copyClause->v, converter, semanticsContext, stmtCtx,3177          dataClauseOperands, mlir::acc::DataClause::acc_copy,3178          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,3179          asyncOnlyDeviceTypes);3180      copyEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3181                               dataClauseOperands.end());3182    } else if (const auto *copyinClause =3183                   std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {3184      auto crtDataStart = dataClauseOperands.size();3185      genDataOperandOperationsWithModifier<mlir::acc::CopyinOp,3186                                           Fortran::parser::AccClause::Copyin>(3187          copyinClause, converter, semanticsContext, stmtCtx,3188          Fortran::parser::AccDataModifier::Modifier::ReadOnly,3189          dataClauseOperands, mlir::acc::DataClause::acc_copyin,3190          mlir::acc::DataClause::acc_copyin_readonly, async, asyncDeviceTypes,3191          asyncOnlyDeviceTypes);3192      copyinEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3193                                 dataClauseOperands.end());3194    } else if (const auto *copyoutClause =3195                   std::get_if<Fortran::parser::AccClause::Copyout>(3196                       &clause.u)) {3197      auto crtDataStart = dataClauseOperands.size();3198      genDataOperandOperationsWithModifier<mlir::acc::CreateOp,3199                                           Fortran::parser::AccClause::Copyout>(3200          copyoutClause, converter, semanticsContext, stmtCtx,3201          Fortran::parser::AccDataModifier::Modifier::Zero, dataClauseOperands,3202          mlir::acc::DataClause::acc_copyout,3203          mlir::acc::DataClause::acc_copyout_zero, async, asyncDeviceTypes,3204          asyncOnlyDeviceTypes);3205      copyoutEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3206                                  dataClauseOperands.end());3207    } else if (const auto *createClause =3208                   std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {3209      auto crtDataStart = dataClauseOperands.size();3210      genDataOperandOperationsWithModifier<mlir::acc::CreateOp,3211                                           Fortran::parser::AccClause::Create>(3212          createClause, converter, semanticsContext, stmtCtx,3213          Fortran::parser::AccDataModifier::Modifier::Zero, dataClauseOperands,3214          mlir::acc::DataClause::acc_create,3215          mlir::acc::DataClause::acc_create_zero, async, asyncDeviceTypes,3216          asyncOnlyDeviceTypes);3217      createEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3218                                 dataClauseOperands.end());3219    } else if (const auto *noCreateClause =3220                   std::get_if<Fortran::parser::AccClause::NoCreate>(3221                       &clause.u)) {3222      auto crtDataStart = dataClauseOperands.size();3223      genDataOperandOperations<mlir::acc::NoCreateOp>(3224          noCreateClause->v, converter, semanticsContext, stmtCtx,3225          dataClauseOperands, mlir::acc::DataClause::acc_no_create,3226          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,3227          asyncOnlyDeviceTypes);3228      nocreateEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3229                                   dataClauseOperands.end());3230    } else if (const auto *presentClause =3231                   std::get_if<Fortran::parser::AccClause::Present>(3232                       &clause.u)) {3233      auto crtDataStart = dataClauseOperands.size();3234      genDataOperandOperations<mlir::acc::PresentOp>(3235          presentClause->v, converter, semanticsContext, stmtCtx,3236          dataClauseOperands, mlir::acc::DataClause::acc_present,3237          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,3238          asyncOnlyDeviceTypes);3239      presentEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3240                                  dataClauseOperands.end());3241    } else if (const auto *deviceptrClause =3242                   std::get_if<Fortran::parser::AccClause::Deviceptr>(3243                       &clause.u)) {3244      genDataOperandOperations<mlir::acc::DevicePtrOp>(3245          deviceptrClause->v, converter, semanticsContext, stmtCtx,3246          dataClauseOperands, mlir::acc::DataClause::acc_deviceptr,3247          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,3248          asyncOnlyDeviceTypes);3249    } else if (const auto *attachClause =3250                   std::get_if<Fortran::parser::AccClause::Attach>(&clause.u)) {3251      auto crtDataStart = dataClauseOperands.size();3252      genDataOperandOperations<mlir::acc::AttachOp>(3253          attachClause->v, converter, semanticsContext, stmtCtx,3254          dataClauseOperands, mlir::acc::DataClause::acc_attach,3255          /*structured=*/true, /*implicit=*/false, async, asyncDeviceTypes,3256          asyncOnlyDeviceTypes);3257      attachEntryOperands.append(dataClauseOperands.begin() + crtDataStart,3258                                 dataClauseOperands.end());3259    } else if (const auto *defaultClause =3260                   std::get_if<Fortran::parser::AccClause::Default>(3261                       &clause.u)) {3262      if ((defaultClause->v).v == llvm::acc::DefaultValue::ACC_Default_none)3263        hasDefaultNone = true;3264      else if ((defaultClause->v).v ==3265               llvm::acc::DefaultValue::ACC_Default_present)3266        hasDefaultPresent = true;3267    }3268  }3269 3270  // Prepare the operand segment size attribute and the operands value range.3271  llvm::SmallVector<mlir::Value> operands;3272  llvm::SmallVector<int32_t> operandSegments;3273  addOperand(operands, operandSegments, ifCond);3274  addOperands(operands, operandSegments, async);3275  addOperands(operands, operandSegments, waitOperands);3276  addOperands(operands, operandSegments, dataClauseOperands);3277 3278  if (dataClauseOperands.empty() && !hasDefaultNone && !hasDefaultPresent)3279    return;3280 3281  auto dataOp = createRegionOp<mlir::acc::DataOp, mlir::acc::TerminatorOp>(3282      builder, currentLocation, currentLocation, eval, operands,3283      operandSegments);3284 3285  if (!asyncDeviceTypes.empty())3286    dataOp.setAsyncOperandsDeviceTypeAttr(3287        builder.getArrayAttr(asyncDeviceTypes));3288  if (!asyncOnlyDeviceTypes.empty())3289    dataOp.setAsyncOnlyAttr(builder.getArrayAttr(asyncOnlyDeviceTypes));3290  if (!waitOperandsDeviceTypes.empty())3291    dataOp.setWaitOperandsDeviceTypeAttr(3292        builder.getArrayAttr(waitOperandsDeviceTypes));3293  if (!waitOperandsSegments.empty())3294    dataOp.setWaitOperandsSegmentsAttr(3295        builder.getDenseI32ArrayAttr(waitOperandsSegments));3296  if (!hasWaitDevnums.empty())3297    dataOp.setHasWaitDevnumAttr(builder.getBoolArrayAttr(hasWaitDevnums));3298  if (!waitOnlyDeviceTypes.empty())3299    dataOp.setWaitOnlyAttr(builder.getArrayAttr(waitOnlyDeviceTypes));3300 3301  if (hasDefaultNone)3302    dataOp.setDefaultAttr(mlir::acc::ClauseDefaultValue::None);3303  if (hasDefaultPresent)3304    dataOp.setDefaultAttr(mlir::acc::ClauseDefaultValue::Present);3305 3306  auto insPt = builder.saveInsertionPoint();3307  builder.setInsertionPointAfter(dataOp);3308 3309  // Create the exit operations after the region.3310  genDataExitOperations<mlir::acc::CopyinOp, mlir::acc::CopyoutOp>(3311      builder, copyEntryOperands, /*structured=*/true, endLocation);3312  genDataExitOperations<mlir::acc::CopyinOp, mlir::acc::DeleteOp>(3313      builder, copyinEntryOperands, /*structured=*/true, endLocation);3314  genDataExitOperations<mlir::acc::CreateOp, mlir::acc::CopyoutOp>(3315      builder, copyoutEntryOperands, /*structured=*/true, endLocation);3316  genDataExitOperations<mlir::acc::AttachOp, mlir::acc::DetachOp>(3317      builder, attachEntryOperands, /*structured=*/true, endLocation);3318  genDataExitOperations<mlir::acc::CreateOp, mlir::acc::DeleteOp>(3319      builder, createEntryOperands, /*structured=*/true, endLocation);3320  genDataExitOperations<mlir::acc::NoCreateOp, mlir::acc::DeleteOp>(3321      builder, nocreateEntryOperands, /*structured=*/true, endLocation);3322  genDataExitOperations<mlir::acc::PresentOp, mlir::acc::DeleteOp>(3323      builder, presentEntryOperands, /*structured=*/true, endLocation);3324 3325  builder.restoreInsertionPoint(insPt);3326}3327 3328static void3329genACCHostDataOp(Fortran::lower::AbstractConverter &converter,3330                 mlir::Location currentLocation,3331                 Fortran::lower::pft::Evaluation &eval,3332                 Fortran::semantics::SemanticsContext &semanticsContext,3333                 Fortran::lower::StatementContext &stmtCtx,3334                 const Fortran::parser::AccClauseList &accClauseList,3335                 Fortran::lower::SymMap &localSymbols) {3336  mlir::Value ifCond;3337  llvm::SmallVector<mlir::Value> dataOperands;3338  bool addIfPresentAttr = false;3339 3340  fir::FirOpBuilder &builder = converter.getFirOpBuilder();3341 3342  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3343    mlir::Location clauseLocation = converter.genLocation(clause.source);3344    if (const auto *ifClause =3345            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3346      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3347    } else if (const auto *useDevice =3348                   std::get_if<Fortran::parser::AccClause::UseDevice>(3349                       &clause.u)) {3350      // When CUDA Fotran is enabled, extra symbols are used in the host_data3351      // region. Look for them and bind their values with the symbols in the3352      // outer scope.3353      if (semanticsContext.IsEnabled(Fortran::common::LanguageFeature::CUDA)) {3354        const Fortran::parser::AccObjectList &objectList{useDevice->v};3355        for (const auto &accObject : objectList.v) {3356          Fortran::semantics::Symbol &symbol =3357              getSymbolFromAccObject(accObject);3358          const Fortran::semantics::Symbol *baseSym =3359              localSymbols.lookupSymbolByName(symbol.name().ToString());3360          localSymbols.copySymbolBinding(*baseSym, symbol);3361        }3362      }3363      genDataOperandOperations<mlir::acc::UseDeviceOp>(3364          useDevice->v, converter, semanticsContext, stmtCtx, dataOperands,3365          mlir::acc::DataClause::acc_use_device,3366          /*structured=*/true, /*implicit=*/false, /*async=*/{},3367          /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});3368    } else if (std::get_if<Fortran::parser::AccClause::IfPresent>(&clause.u)) {3369      addIfPresentAttr = true;3370    }3371  }3372 3373  if (ifCond) {3374    if (auto cst =3375            mlir::dyn_cast<mlir::arith::ConstantOp>(ifCond.getDefiningOp()))3376      if (auto boolAttr = mlir::dyn_cast<mlir::BoolAttr>(cst.getValue())) {3377        if (boolAttr.getValue()) {3378          // get rid of the if condition if it is always true.3379          ifCond = mlir::Value();3380        } else {3381          // Do not generate the acc.host_data op if the if condition is always3382          // false.3383          return;3384        }3385      }3386  }3387 3388  // Prepare the operand segment size attribute and the operands value range.3389  llvm::SmallVector<mlir::Value> operands;3390  llvm::SmallVector<int32_t> operandSegments;3391  addOperand(operands, operandSegments, ifCond);3392  addOperands(operands, operandSegments, dataOperands);3393 3394  auto hostDataOp =3395      createRegionOp<mlir::acc::HostDataOp, mlir::acc::TerminatorOp>(3396          builder, currentLocation, currentLocation, eval, operands,3397          operandSegments);3398 3399  if (addIfPresentAttr)3400    hostDataOp.setIfPresentAttr(builder.getUnitAttr());3401}3402 3403static void genACC(Fortran::lower::AbstractConverter &converter,3404                   Fortran::semantics::SemanticsContext &semanticsContext,3405                   Fortran::lower::pft::Evaluation &eval,3406                   const Fortran::parser::OpenACCBlockConstruct &blockConstruct,3407                   Fortran::lower::SymMap &localSymbols) {3408  const auto &beginBlockDirective =3409      std::get<Fortran::parser::AccBeginBlockDirective>(blockConstruct.t);3410  const auto &blockDirective =3411      std::get<Fortran::parser::AccBlockDirective>(beginBlockDirective.t);3412  const auto &accClauseList =3413      std::get<Fortran::parser::AccClauseList>(beginBlockDirective.t);3414  const auto &endBlockDirective =3415      std::get<Fortran::parser::AccEndBlockDirective>(blockConstruct.t);3416  mlir::Location endLocation = converter.genLocation(endBlockDirective.source);3417  mlir::Location currentLocation = converter.genLocation(blockDirective.source);3418  Fortran::lower::StatementContext stmtCtx;3419 3420  if (blockDirective.v == llvm::acc::ACCD_parallel) {3421    createComputeOp<mlir::acc::ParallelOp>(converter, currentLocation, eval,3422                                           semanticsContext, stmtCtx,3423                                           accClauseList);3424  } else if (blockDirective.v == llvm::acc::ACCD_data) {3425    genACCDataOp(converter, currentLocation, endLocation, eval,3426                 semanticsContext, stmtCtx, accClauseList);3427  } else if (blockDirective.v == llvm::acc::ACCD_serial) {3428    createComputeOp<mlir::acc::SerialOp>(converter, currentLocation, eval,3429                                         semanticsContext, stmtCtx,3430                                         accClauseList);3431  } else if (blockDirective.v == llvm::acc::ACCD_kernels) {3432    createComputeOp<mlir::acc::KernelsOp>(converter, currentLocation, eval,3433                                          semanticsContext, stmtCtx,3434                                          accClauseList);3435  } else if (blockDirective.v == llvm::acc::ACCD_host_data) {3436    genACCHostDataOp(converter, currentLocation, eval, semanticsContext,3437                     stmtCtx, accClauseList, localSymbols);3438  }3439}3440 3441static void3442genACC(Fortran::lower::AbstractConverter &converter,3443       Fortran::semantics::SemanticsContext &semanticsContext,3444       Fortran::lower::pft::Evaluation &eval,3445       const Fortran::parser::OpenACCCombinedConstruct &combinedConstruct) {3446  const auto &beginCombinedDirective =3447      std::get<Fortran::parser::AccBeginCombinedDirective>(combinedConstruct.t);3448  const auto &combinedDirective =3449      std::get<Fortran::parser::AccCombinedDirective>(beginCombinedDirective.t);3450  const auto &accClauseList =3451      std::get<Fortran::parser::AccClauseList>(beginCombinedDirective.t);3452  const auto &outerDoConstruct =3453      std::get<std::optional<Fortran::parser::DoConstruct>>(3454          combinedConstruct.t);3455 3456  mlir::Location currentLocation =3457      converter.genLocation(beginCombinedDirective.source);3458  Fortran::lower::StatementContext stmtCtx;3459 3460  if (combinedDirective.v == llvm::acc::ACCD_kernels_loop) {3461    createComputeOp<mlir::acc::KernelsOp>(3462        converter, currentLocation, eval, semanticsContext, stmtCtx,3463        accClauseList, mlir::acc::CombinedConstructsType::KernelsLoop);3464    createLoopOp(converter, currentLocation, semanticsContext, stmtCtx,3465                 *outerDoConstruct, eval, accClauseList,3466                 mlir::acc::CombinedConstructsType::KernelsLoop);3467  } else if (combinedDirective.v == llvm::acc::ACCD_parallel_loop) {3468    createComputeOp<mlir::acc::ParallelOp>(3469        converter, currentLocation, eval, semanticsContext, stmtCtx,3470        accClauseList, mlir::acc::CombinedConstructsType::ParallelLoop);3471    createLoopOp(converter, currentLocation, semanticsContext, stmtCtx,3472                 *outerDoConstruct, eval, accClauseList,3473                 mlir::acc::CombinedConstructsType::ParallelLoop);3474  } else if (combinedDirective.v == llvm::acc::ACCD_serial_loop) {3475    createComputeOp<mlir::acc::SerialOp>(3476        converter, currentLocation, eval, semanticsContext, stmtCtx,3477        accClauseList, mlir::acc::CombinedConstructsType::SerialLoop);3478    createLoopOp(converter, currentLocation, semanticsContext, stmtCtx,3479                 *outerDoConstruct, eval, accClauseList,3480                 mlir::acc::CombinedConstructsType::SerialLoop);3481  } else {3482    llvm::report_fatal_error("Unknown combined construct encountered");3483  }3484}3485 3486static void3487genACCEnterDataOp(Fortran::lower::AbstractConverter &converter,3488                  mlir::Location currentLocation,3489                  Fortran::semantics::SemanticsContext &semanticsContext,3490                  Fortran::lower::StatementContext &stmtCtx,3491                  const Fortran::parser::AccClauseList &accClauseList) {3492  mlir::Value ifCond, async, waitDevnum;3493  llvm::SmallVector<mlir::Value> waitOperands, dataClauseOperands;3494 3495  // Async, wait and self clause have optional values but can be present with3496  // no value as well. When there is no value, the op has an attribute to3497  // represent the clause.3498  bool addAsyncAttr = false;3499  bool addWaitAttr = false;3500 3501  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();3502 3503  // Lower clauses values mapped to operands.3504  // Keep track of each group of operands separately as clauses can appear3505  // more than once.3506 3507  // Process the async clause first.3508  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3509    if (const auto *asyncClause =3510            std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {3511      genAsyncClause(converter, asyncClause, async, addAsyncAttr, stmtCtx);3512    }3513  }3514 3515  // The async clause of 'enter data' applies to all device types,3516  // so propagate the async clause to copyin/create/attach ops3517  // as if it is an async clause without preceding device_type clause.3518  llvm::SmallVector<mlir::Attribute> asyncDeviceTypes, asyncOnlyDeviceTypes;3519  llvm::SmallVector<mlir::Value> asyncValues;3520  auto noneDeviceTypeAttr = mlir::acc::DeviceTypeAttr::get(3521      firOpBuilder.getContext(), mlir::acc::DeviceType::None);3522  if (addAsyncAttr) {3523    asyncOnlyDeviceTypes.push_back(noneDeviceTypeAttr);3524  } else if (async) {3525    asyncValues.push_back(async);3526    asyncDeviceTypes.push_back(noneDeviceTypeAttr);3527  }3528 3529  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3530    mlir::Location clauseLocation = converter.genLocation(clause.source);3531    if (const auto *ifClause =3532            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3533      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3534    } else if (const auto *waitClause =3535                   std::get_if<Fortran::parser::AccClause::Wait>(&clause.u)) {3536      genWaitClause(converter, waitClause, waitOperands, waitDevnum,3537                    addWaitAttr, stmtCtx);3538    } else if (const auto *copyinClause =3539                   std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {3540      const Fortran::parser::AccObjectListWithModifier &listWithModifier =3541          copyinClause->v;3542      const auto &accObjectList =3543          std::get<Fortran::parser::AccObjectList>(listWithModifier.t);3544      genDataOperandOperations<mlir::acc::CopyinOp>(3545          accObjectList, converter, semanticsContext, stmtCtx,3546          dataClauseOperands, mlir::acc::DataClause::acc_copyin, false,3547          /*implicit=*/false, asyncValues, asyncDeviceTypes,3548          asyncOnlyDeviceTypes);3549    } else if (const auto *createClause =3550                   std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {3551      const Fortran::parser::AccObjectListWithModifier &listWithModifier =3552          createClause->v;3553      const auto &accObjectList =3554          std::get<Fortran::parser::AccObjectList>(listWithModifier.t);3555      const auto &modifier =3556          std::get<std::optional<Fortran::parser::AccDataModifier>>(3557              listWithModifier.t);3558      mlir::acc::DataClause clause = mlir::acc::DataClause::acc_create;3559      if (modifier &&3560          (*modifier).v == Fortran::parser::AccDataModifier::Modifier::Zero)3561        clause = mlir::acc::DataClause::acc_create_zero;3562      genDataOperandOperations<mlir::acc::CreateOp>(3563          accObjectList, converter, semanticsContext, stmtCtx,3564          dataClauseOperands, clause, false, /*implicit=*/false, asyncValues,3565          asyncDeviceTypes, asyncOnlyDeviceTypes);3566    } else if (const auto *attachClause =3567                   std::get_if<Fortran::parser::AccClause::Attach>(&clause.u)) {3568      genDataOperandOperations<mlir::acc::AttachOp>(3569          attachClause->v, converter, semanticsContext, stmtCtx,3570          dataClauseOperands, mlir::acc::DataClause::acc_attach, false,3571          /*implicit=*/false, asyncValues, asyncDeviceTypes,3572          asyncOnlyDeviceTypes);3573    } else if (!std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {3574      llvm::report_fatal_error(3575          "Unknown clause in ENTER DATA directive lowering");3576    }3577  }3578 3579  // Prepare the operand segment size attribute and the operands value range.3580  llvm::SmallVector<mlir::Value, 16> operands;3581  llvm::SmallVector<int32_t, 8> operandSegments;3582  addOperand(operands, operandSegments, ifCond);3583  addOperand(operands, operandSegments, async);3584  addOperand(operands, operandSegments, waitDevnum);3585  addOperands(operands, operandSegments, waitOperands);3586  addOperands(operands, operandSegments, dataClauseOperands);3587 3588  mlir::acc::EnterDataOp enterDataOp = createSimpleOp<mlir::acc::EnterDataOp>(3589      firOpBuilder, currentLocation, operands, operandSegments);3590 3591  if (addAsyncAttr)3592    enterDataOp.setAsyncAttr(firOpBuilder.getUnitAttr());3593  if (addWaitAttr)3594    enterDataOp.setWaitAttr(firOpBuilder.getUnitAttr());3595}3596 3597static void3598genACCExitDataOp(Fortran::lower::AbstractConverter &converter,3599                 mlir::Location currentLocation,3600                 Fortran::semantics::SemanticsContext &semanticsContext,3601                 Fortran::lower::StatementContext &stmtCtx,3602                 const Fortran::parser::AccClauseList &accClauseList) {3603  mlir::Value ifCond, async, waitDevnum;3604  llvm::SmallVector<mlir::Value> waitOperands, dataClauseOperands,3605      copyoutOperands, deleteOperands, detachOperands;3606 3607  // Async and wait clause have optional values but can be present with3608  // no value as well. When there is no value, the op has an attribute to3609  // represent the clause.3610  bool addAsyncAttr = false;3611  bool addWaitAttr = false;3612  bool addFinalizeAttr = false;3613 3614  fir::FirOpBuilder &builder = converter.getFirOpBuilder();3615 3616  // Lower clauses values mapped to operands.3617  // Keep track of each group of operands separately as clauses can appear3618  // more than once.3619 3620  // Process the async clause first.3621  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3622    if (const auto *asyncClause =3623            std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {3624      genAsyncClause(converter, asyncClause, async, addAsyncAttr, stmtCtx);3625    }3626  }3627 3628  // The async clause of 'exit data' applies to all device types,3629  // so propagate the async clause to copyin/create/attach ops3630  // as if it is an async clause without preceding device_type clause.3631  llvm::SmallVector<mlir::Attribute> asyncDeviceTypes, asyncOnlyDeviceTypes;3632  llvm::SmallVector<mlir::Value> asyncValues;3633  auto noneDeviceTypeAttr = mlir::acc::DeviceTypeAttr::get(3634      builder.getContext(), mlir::acc::DeviceType::None);3635  if (addAsyncAttr) {3636    asyncOnlyDeviceTypes.push_back(noneDeviceTypeAttr);3637  } else if (async) {3638    asyncValues.push_back(async);3639    asyncDeviceTypes.push_back(noneDeviceTypeAttr);3640  }3641 3642  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3643    mlir::Location clauseLocation = converter.genLocation(clause.source);3644    if (const auto *ifClause =3645            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3646      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3647    } else if (const auto *waitClause =3648                   std::get_if<Fortran::parser::AccClause::Wait>(&clause.u)) {3649      genWaitClause(converter, waitClause, waitOperands, waitDevnum,3650                    addWaitAttr, stmtCtx);3651    } else if (const auto *copyoutClause =3652                   std::get_if<Fortran::parser::AccClause::Copyout>(3653                       &clause.u)) {3654      const Fortran::parser::AccObjectListWithModifier &listWithModifier =3655          copyoutClause->v;3656      const auto &accObjectList =3657          std::get<Fortran::parser::AccObjectList>(listWithModifier.t);3658      genDataOperandOperations<mlir::acc::GetDevicePtrOp>(3659          accObjectList, converter, semanticsContext, stmtCtx, copyoutOperands,3660          mlir::acc::DataClause::acc_copyout, false, /*implicit=*/false,3661          asyncValues, asyncDeviceTypes, asyncOnlyDeviceTypes);3662    } else if (const auto *deleteClause =3663                   std::get_if<Fortran::parser::AccClause::Delete>(&clause.u)) {3664      genDataOperandOperations<mlir::acc::GetDevicePtrOp>(3665          deleteClause->v, converter, semanticsContext, stmtCtx, deleteOperands,3666          mlir::acc::DataClause::acc_delete, false, /*implicit=*/false,3667          asyncValues, asyncDeviceTypes, asyncOnlyDeviceTypes);3668    } else if (const auto *detachClause =3669                   std::get_if<Fortran::parser::AccClause::Detach>(&clause.u)) {3670      genDataOperandOperations<mlir::acc::GetDevicePtrOp>(3671          detachClause->v, converter, semanticsContext, stmtCtx, detachOperands,3672          mlir::acc::DataClause::acc_detach, false, /*implicit=*/false,3673          asyncValues, asyncDeviceTypes, asyncOnlyDeviceTypes);3674    } else if (std::get_if<Fortran::parser::AccClause::Finalize>(&clause.u)) {3675      addFinalizeAttr = true;3676    }3677  }3678 3679  dataClauseOperands.append(copyoutOperands);3680  dataClauseOperands.append(deleteOperands);3681  dataClauseOperands.append(detachOperands);3682 3683  // Prepare the operand segment size attribute and the operands value range.3684  llvm::SmallVector<mlir::Value, 14> operands;3685  llvm::SmallVector<int32_t, 7> operandSegments;3686  addOperand(operands, operandSegments, ifCond);3687  addOperand(operands, operandSegments, async);3688  addOperand(operands, operandSegments, waitDevnum);3689  addOperands(operands, operandSegments, waitOperands);3690  addOperands(operands, operandSegments, dataClauseOperands);3691 3692  mlir::acc::ExitDataOp exitDataOp = createSimpleOp<mlir::acc::ExitDataOp>(3693      builder, currentLocation, operands, operandSegments);3694 3695  if (addAsyncAttr)3696    exitDataOp.setAsyncAttr(builder.getUnitAttr());3697  if (addWaitAttr)3698    exitDataOp.setWaitAttr(builder.getUnitAttr());3699  if (addFinalizeAttr)3700    exitDataOp.setFinalizeAttr(builder.getUnitAttr());3701 3702  genDataExitOperations<mlir::acc::GetDevicePtrOp, mlir::acc::CopyoutOp>(3703      builder, copyoutOperands, /*structured=*/false);3704  genDataExitOperations<mlir::acc::GetDevicePtrOp, mlir::acc::DeleteOp>(3705      builder, deleteOperands, /*structured=*/false);3706  genDataExitOperations<mlir::acc::GetDevicePtrOp, mlir::acc::DetachOp>(3707      builder, detachOperands, /*structured=*/false);3708}3709 3710template <typename Op>3711static void3712genACCInitShutdownOp(Fortran::lower::AbstractConverter &converter,3713                     mlir::Location currentLocation,3714                     const Fortran::parser::AccClauseList &accClauseList) {3715  mlir::Value ifCond, deviceNum;3716 3717  fir::FirOpBuilder &builder = converter.getFirOpBuilder();3718  Fortran::lower::StatementContext stmtCtx;3719  llvm::SmallVector<mlir::Attribute> deviceTypes;3720 3721  // Lower clauses values mapped to operands.3722  // Keep track of each group of operands separately as clauses can appear3723  // more than once.3724  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3725    mlir::Location clauseLocation = converter.genLocation(clause.source);3726    if (const auto *ifClause =3727            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3728      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3729    } else if (const auto *deviceNumClause =3730                   std::get_if<Fortran::parser::AccClause::DeviceNum>(3731                       &clause.u)) {3732      deviceNum = fir::getBase(converter.genExprValue(3733          *Fortran::semantics::GetExpr(deviceNumClause->v), stmtCtx));3734    } else if (const auto *deviceTypeClause =3735                   std::get_if<Fortran::parser::AccClause::DeviceType>(3736                       &clause.u)) {3737      gatherDeviceTypeAttrs(builder, deviceTypeClause, deviceTypes);3738    }3739  }3740 3741  // Prepare the operand segment size attribute and the operands value range.3742  llvm::SmallVector<mlir::Value, 6> operands;3743  llvm::SmallVector<int32_t, 2> operandSegments;3744 3745  addOperand(operands, operandSegments, deviceNum);3746  addOperand(operands, operandSegments, ifCond);3747 3748  Op op =3749      createSimpleOp<Op>(builder, currentLocation, operands, operandSegments);3750  if (!deviceTypes.empty())3751    op.setDeviceTypesAttr(3752        mlir::ArrayAttr::get(builder.getContext(), deviceTypes));3753}3754 3755void genACCSetOp(Fortran::lower::AbstractConverter &converter,3756                 mlir::Location currentLocation,3757                 const Fortran::parser::AccClauseList &accClauseList) {3758  mlir::Value ifCond, deviceNum, defaultAsync;3759  llvm::SmallVector<mlir::Value> deviceTypeOperands;3760 3761  fir::FirOpBuilder &builder = converter.getFirOpBuilder();3762  Fortran::lower::StatementContext stmtCtx;3763  llvm::SmallVector<mlir::Attribute> deviceTypes;3764 3765  // Lower clauses values mapped to operands.3766  // Keep track of each group of operands separately as clauses can appear3767  // more than once.3768  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3769    mlir::Location clauseLocation = converter.genLocation(clause.source);3770    if (const auto *ifClause =3771            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3772      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3773    } else if (const auto *defaultAsyncClause =3774                   std::get_if<Fortran::parser::AccClause::DefaultAsync>(3775                       &clause.u)) {3776      defaultAsync = fir::getBase(converter.genExprValue(3777          *Fortran::semantics::GetExpr(defaultAsyncClause->v), stmtCtx));3778    } else if (const auto *deviceNumClause =3779                   std::get_if<Fortran::parser::AccClause::DeviceNum>(3780                       &clause.u)) {3781      deviceNum = fir::getBase(converter.genExprValue(3782          *Fortran::semantics::GetExpr(deviceNumClause->v), stmtCtx));3783    } else if (const auto *deviceTypeClause =3784                   std::get_if<Fortran::parser::AccClause::DeviceType>(3785                       &clause.u)) {3786      gatherDeviceTypeAttrs(builder, deviceTypeClause, deviceTypes);3787    }3788  }3789 3790  // Prepare the operand segment size attribute and the operands value range.3791  llvm::SmallVector<mlir::Value> operands;3792  llvm::SmallVector<int32_t, 3> operandSegments;3793  addOperand(operands, operandSegments, defaultAsync);3794  addOperand(operands, operandSegments, deviceNum);3795  addOperand(operands, operandSegments, ifCond);3796 3797  auto op = createSimpleOp<mlir::acc::SetOp>(builder, currentLocation, operands,3798                                             operandSegments);3799  if (!deviceTypes.empty()) {3800    assert(deviceTypes.size() == 1 && "expect only one value for acc.set");3801    op.setDeviceTypeAttr(mlir::cast<mlir::acc::DeviceTypeAttr>(deviceTypes[0]));3802  }3803}3804 3805static inline mlir::ArrayAttr3806getArrayAttr(fir::FirOpBuilder &b,3807             llvm::SmallVector<mlir::Attribute> &attributes) {3808  return attributes.empty() ? nullptr : b.getArrayAttr(attributes);3809}3810 3811static inline mlir::ArrayAttr3812getBoolArrayAttr(fir::FirOpBuilder &b, llvm::SmallVector<bool> &values) {3813  return values.empty() ? nullptr : b.getBoolArrayAttr(values);3814}3815 3816static inline mlir::DenseI32ArrayAttr3817getDenseI32ArrayAttr(fir::FirOpBuilder &builder,3818                     llvm::SmallVector<int32_t> &values) {3819  return values.empty() ? nullptr : builder.getDenseI32ArrayAttr(values);3820}3821 3822static void3823genACCUpdateOp(Fortran::lower::AbstractConverter &converter,3824               mlir::Location currentLocation,3825               Fortran::semantics::SemanticsContext &semanticsContext,3826               Fortran::lower::StatementContext &stmtCtx,3827               const Fortran::parser::AccClauseList &accClauseList) {3828  mlir::Value ifCond;3829  llvm::SmallVector<mlir::Value> dataClauseOperands, updateHostOperands,3830      waitOperands, deviceTypeOperands, asyncOperands;3831  llvm::SmallVector<mlir::Attribute> asyncOperandsDeviceTypes,3832      asyncOnlyDeviceTypes, waitOperandsDeviceTypes, waitOnlyDeviceTypes;3833  llvm::SmallVector<bool> hasWaitDevnums;3834  llvm::SmallVector<int32_t> waitOperandsSegments;3835 3836  fir::FirOpBuilder &builder = converter.getFirOpBuilder();3837 3838  // device_type attribute is set to `none` until a device_type clause is3839  // encountered.3840  llvm::SmallVector<mlir::Attribute> crtDeviceTypes;3841  crtDeviceTypes.push_back(mlir::acc::DeviceTypeAttr::get(3842      builder.getContext(), mlir::acc::DeviceType::None));3843 3844  bool ifPresent = false;3845 3846  // Lower clauses values mapped to operands and array attributes.3847  // Keep track of each group of operands separately as clauses can appear3848  // more than once.3849 3850  // Process the clauses that may have a specified device_type first.3851  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3852    if (const auto *asyncClause =3853            std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {3854      genAsyncClause(converter, asyncClause, asyncOperands,3855                     asyncOperandsDeviceTypes, asyncOnlyDeviceTypes,3856                     crtDeviceTypes, stmtCtx);3857    } else if (const auto *waitClause =3858                   std::get_if<Fortran::parser::AccClause::Wait>(&clause.u)) {3859      genWaitClauseWithDeviceType(converter, waitClause, waitOperands,3860                                  waitOperandsDeviceTypes, waitOnlyDeviceTypes,3861                                  hasWaitDevnums, waitOperandsSegments,3862                                  crtDeviceTypes, stmtCtx);3863    } else if (const auto *deviceTypeClause =3864                   std::get_if<Fortran::parser::AccClause::DeviceType>(3865                       &clause.u)) {3866      crtDeviceTypes.clear();3867      gatherDeviceTypeAttrs(builder, deviceTypeClause, crtDeviceTypes);3868    }3869  }3870 3871  // Process the clauses independent of device_type.3872  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3873    mlir::Location clauseLocation = converter.genLocation(clause.source);3874    if (const auto *ifClause =3875            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {3876      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);3877    } else if (const auto *hostClause =3878                   std::get_if<Fortran::parser::AccClause::Host>(&clause.u)) {3879      genDataOperandOperations<mlir::acc::GetDevicePtrOp>(3880          hostClause->v, converter, semanticsContext, stmtCtx,3881          updateHostOperands, mlir::acc::DataClause::acc_update_host, false,3882          /*implicit=*/false, asyncOperands, asyncOperandsDeviceTypes,3883          asyncOnlyDeviceTypes);3884    } else if (const auto *deviceClause =3885                   std::get_if<Fortran::parser::AccClause::Device>(&clause.u)) {3886      genDataOperandOperations<mlir::acc::UpdateDeviceOp>(3887          deviceClause->v, converter, semanticsContext, stmtCtx,3888          dataClauseOperands, mlir::acc::DataClause::acc_update_device, false,3889          /*implicit=*/false, asyncOperands, asyncOperandsDeviceTypes,3890          asyncOnlyDeviceTypes);3891    } else if (std::get_if<Fortran::parser::AccClause::IfPresent>(&clause.u)) {3892      ifPresent = true;3893    } else if (const auto *selfClause =3894                   std::get_if<Fortran::parser::AccClause::Self>(&clause.u)) {3895      const std::optional<Fortran::parser::AccSelfClause> &accSelfClause =3896          selfClause->v;3897      const auto *accObjectList =3898          std::get_if<Fortran::parser::AccObjectList>(&(*accSelfClause).u);3899      assert(accObjectList && "expect AccObjectList");3900      genDataOperandOperations<mlir::acc::GetDevicePtrOp>(3901          *accObjectList, converter, semanticsContext, stmtCtx,3902          updateHostOperands, mlir::acc::DataClause::acc_update_self, false,3903          /*implicit=*/false, asyncOperands, asyncOperandsDeviceTypes,3904          asyncOnlyDeviceTypes);3905    }3906  }3907 3908  dataClauseOperands.append(updateHostOperands);3909 3910  mlir::acc::UpdateOp::create(3911      builder, currentLocation, ifCond, asyncOperands,3912      getArrayAttr(builder, asyncOperandsDeviceTypes),3913      getArrayAttr(builder, asyncOnlyDeviceTypes), waitOperands,3914      getDenseI32ArrayAttr(builder, waitOperandsSegments),3915      getArrayAttr(builder, waitOperandsDeviceTypes),3916      getBoolArrayAttr(builder, hasWaitDevnums),3917      getArrayAttr(builder, waitOnlyDeviceTypes), dataClauseOperands,3918      ifPresent);3919 3920  genDataExitOperations<mlir::acc::GetDevicePtrOp, mlir::acc::UpdateHostOp>(3921      builder, updateHostOperands, /*structured=*/false);3922}3923 3924static void3925genACC(Fortran::lower::AbstractConverter &converter,3926       Fortran::semantics::SemanticsContext &semanticsContext,3927       const Fortran::parser::OpenACCStandaloneConstruct &standaloneConstruct) {3928  const auto &standaloneDirective =3929      std::get<Fortran::parser::AccStandaloneDirective>(standaloneConstruct.t);3930  const auto &accClauseList =3931      std::get<Fortran::parser::AccClauseList>(standaloneConstruct.t);3932 3933  mlir::Location currentLocation =3934      converter.genLocation(standaloneDirective.source);3935  Fortran::lower::StatementContext stmtCtx;3936 3937  if (standaloneDirective.v == llvm::acc::Directive::ACCD_enter_data) {3938    genACCEnterDataOp(converter, currentLocation, semanticsContext, stmtCtx,3939                      accClauseList);3940  } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_exit_data) {3941    genACCExitDataOp(converter, currentLocation, semanticsContext, stmtCtx,3942                     accClauseList);3943  } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_init) {3944    genACCInitShutdownOp<mlir::acc::InitOp>(converter, currentLocation,3945                                            accClauseList);3946  } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_shutdown) {3947    genACCInitShutdownOp<mlir::acc::ShutdownOp>(converter, currentLocation,3948                                                accClauseList);3949  } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_set) {3950    genACCSetOp(converter, currentLocation, accClauseList);3951  } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_update) {3952    genACCUpdateOp(converter, currentLocation, semanticsContext, stmtCtx,3953                   accClauseList);3954  }3955}3956 3957static void genACC(Fortran::lower::AbstractConverter &converter,3958                   const Fortran::parser::OpenACCWaitConstruct &waitConstruct) {3959 3960  const auto &waitArgument =3961      std::get<std::optional<Fortran::parser::AccWaitArgument>>(3962          waitConstruct.t);3963  const auto &accClauseList =3964      std::get<Fortran::parser::AccClauseList>(waitConstruct.t);3965 3966  mlir::Value ifCond, waitDevnum, async;3967  llvm::SmallVector<mlir::Value> waitOperands;3968 3969  // Async clause have optional values but can be present with3970  // no value as well. When there is no value, the op has an attribute to3971  // represent the clause.3972  bool addAsyncAttr = false;3973 3974  fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();3975  mlir::Location currentLocation = converter.genLocation(waitConstruct.source);3976  Fortran::lower::StatementContext stmtCtx;3977 3978  if (waitArgument) { // wait has a value.3979    const Fortran::parser::AccWaitArgument &waitArg = *waitArgument;3980    const auto &waitList =3981        std::get<std::list<Fortran::parser::ScalarIntExpr>>(waitArg.t);3982    for (const Fortran::parser::ScalarIntExpr &value : waitList) {3983      mlir::Value v = fir::getBase(3984          converter.genExprValue(*Fortran::semantics::GetExpr(value), stmtCtx));3985      waitOperands.push_back(v);3986    }3987 3988    const auto &waitDevnumValue =3989        std::get<std::optional<Fortran::parser::ScalarIntExpr>>(waitArg.t);3990    if (waitDevnumValue)3991      waitDevnum = fir::getBase(converter.genExprValue(3992          *Fortran::semantics::GetExpr(*waitDevnumValue), stmtCtx));3993  }3994 3995  // Lower clauses values mapped to operands.3996  // Keep track of each group of operands separately as clauses can appear3997  // more than once.3998  for (const Fortran::parser::AccClause &clause : accClauseList.v) {3999    mlir::Location clauseLocation = converter.genLocation(clause.source);4000    if (const auto *ifClause =4001            std::get_if<Fortran::parser::AccClause::If>(&clause.u)) {4002      genIfClause(converter, clauseLocation, ifClause, ifCond, stmtCtx);4003    } else if (const auto *asyncClause =4004                   std::get_if<Fortran::parser::AccClause::Async>(&clause.u)) {4005      genAsyncClause(converter, asyncClause, async, addAsyncAttr, stmtCtx);4006    }4007  }4008 4009  // Prepare the operand segment size attribute and the operands value range.4010  llvm::SmallVector<mlir::Value> operands;4011  llvm::SmallVector<int32_t> operandSegments;4012  addOperands(operands, operandSegments, waitOperands);4013  addOperand(operands, operandSegments, async);4014  addOperand(operands, operandSegments, waitDevnum);4015  addOperand(operands, operandSegments, ifCond);4016 4017  mlir::acc::WaitOp waitOp = createSimpleOp<mlir::acc::WaitOp>(4018      firOpBuilder, currentLocation, operands, operandSegments);4019 4020  if (addAsyncAttr)4021    waitOp.setAsyncAttr(firOpBuilder.getUnitAttr());4022}4023 4024template <typename EntryOp>4025static void createDeclareAllocFunc(mlir::OpBuilder &modBuilder,4026                                   fir::FirOpBuilder &builder,4027                                   mlir::Location loc, fir::GlobalOp &globalOp,4028                                   mlir::acc::DataClause clause) {4029  std::stringstream registerFuncName;4030  registerFuncName << globalOp.getSymName().str()4031                   << Fortran::lower::declarePostAllocSuffix.str();4032  auto registerFuncOp =4033      createDeclareFunc(modBuilder, builder, loc, registerFuncName.str());4034 4035  fir::AddrOfOp addrOp = fir::AddrOfOp::create(4036      builder, loc, fir::ReferenceType::get(globalOp.getType()),4037      globalOp.getSymbol());4038 4039  std::stringstream asFortran;4040  asFortran << Fortran::lower::mangle::demangleName(globalOp.getSymName());4041  std::stringstream asFortranDesc;4042  asFortranDesc << asFortran.str();4043  llvm::SmallVector<mlir::Value> bounds;4044 4045  EntryOp descEntryOp = createDataEntryOp<EntryOp>(4046      builder, loc, addrOp, asFortranDesc, bounds,4047      /*structured=*/false, /*implicit=*/true, clause, addrOp.getType(),4048      /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});4049  mlir::acc::DeclareEnterOp::create(4050      builder, loc, mlir::acc::DeclareTokenType::get(descEntryOp.getContext()),4051      mlir::ValueRange(descEntryOp.getAccVar()));4052 4053  modBuilder.setInsertionPointAfter(registerFuncOp);4054}4055 4056/// Action to be performed on deallocation are split in two distinct functions.4057/// - Pre deallocation function includes all the action to be performed before4058///   the actual deallocation is done on the host side.4059/// - Post deallocation function includes update to the descriptor.4060template <typename ExitOp>4061static void createDeclareDeallocFunc(mlir::OpBuilder &modBuilder,4062                                     fir::FirOpBuilder &builder,4063                                     mlir::Location loc,4064                                     fir::GlobalOp &globalOp,4065                                     mlir::acc::DataClause clause) {4066  std::stringstream asFortran;4067  asFortran << Fortran::lower::mangle::demangleName(globalOp.getSymName());4068 4069  std::stringstream postDeallocFuncName;4070  postDeallocFuncName << globalOp.getSymName().str()4071                      << Fortran::lower::declarePostDeallocSuffix.str();4072  auto postDeallocOp =4073      createDeclareFunc(modBuilder, builder, loc, postDeallocFuncName.str());4074 4075  fir::AddrOfOp addrOp = fir::AddrOfOp::create(4076      builder, loc, fir::ReferenceType::get(globalOp.getType()),4077      globalOp.getSymbol());4078  llvm::SmallVector<mlir::Value> bounds;4079  // End the structured declare region using declare_exit.4080  mlir::acc::GetDevicePtrOp descEntryOp =4081      createDataEntryOp<mlir::acc::GetDevicePtrOp>(4082          builder, loc, addrOp, asFortran, bounds,4083          /*structured=*/false, /*implicit=*/true, clause, addrOp.getType(),4084          /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{});4085  mlir::acc::DeclareExitOp::create(builder, loc, mlir::Value{},4086                                   mlir::ValueRange(descEntryOp.getAccVar()));4087  modBuilder.setInsertionPointAfter(postDeallocOp);4088}4089 4090template <typename EntryOp, typename ExitOp>4091static void genGlobalCtors(Fortran::lower::AbstractConverter &converter,4092                           mlir::OpBuilder &modBuilder,4093                           const Fortran::parser::AccObjectList &accObjectList,4094                           mlir::acc::DataClause clause) {4095  fir::FirOpBuilder &builder = converter.getFirOpBuilder();4096  auto genCtors = [&](const mlir::Location operandLocation,4097                      const Fortran::semantics::Symbol &symbol) {4098    std::string globalName = converter.mangleName(symbol);4099    fir::GlobalOp globalOp = builder.getNamedGlobal(globalName);4100    std::stringstream declareGlobalCtorName;4101    declareGlobalCtorName << globalName << "_acc_ctor";4102    std::stringstream declareGlobalDtorName;4103    declareGlobalDtorName << globalName << "_acc_dtor";4104    std::stringstream asFortran;4105    asFortran << symbol.name().ToString();4106 4107    if (builder.getModule().lookupSymbol<mlir::acc::GlobalConstructorOp>(4108            declareGlobalCtorName.str()))4109      return;4110 4111    if (!globalOp) {4112      if (Fortran::semantics::FindEquivalenceSet(symbol)) {4113        for (Fortran::semantics::EquivalenceObject eqObj :4114             *Fortran::semantics::FindEquivalenceSet(symbol)) {4115          std::string eqName = converter.mangleName(eqObj.symbol);4116          globalOp = builder.getNamedGlobal(eqName);4117          if (globalOp)4118            break;4119        }4120 4121        if (!globalOp)4122          llvm::report_fatal_error("could not retrieve global symbol");4123      } else {4124        llvm::report_fatal_error("could not retrieve global symbol");4125      }4126    }4127 4128    addDeclareAttr(builder, globalOp.getOperation(), clause);4129    auto crtPos = builder.saveInsertionPoint();4130    modBuilder.setInsertionPointAfter(globalOp);4131    if (mlir::isa<fir::BaseBoxType>(fir::unwrapRefType(globalOp.getType()))) {4132      createDeclareGlobalOp<mlir::acc::GlobalConstructorOp, mlir::acc::CopyinOp,4133                            mlir::acc::DeclareEnterOp, ExitOp>(4134          modBuilder, builder, operandLocation, globalOp, clause,4135          declareGlobalCtorName.str(), /*implicit=*/true, asFortran);4136      createDeclareAllocFunc<EntryOp>(modBuilder, builder, operandLocation,4137                                      globalOp, clause);4138      if constexpr (!std::is_same_v<EntryOp, ExitOp>)4139        createDeclareDeallocFunc<ExitOp>(modBuilder, builder, operandLocation,4140                                         globalOp, clause);4141    } else {4142      createDeclareGlobalOp<mlir::acc::GlobalConstructorOp, EntryOp,4143                            mlir::acc::DeclareEnterOp, ExitOp>(4144          modBuilder, builder, operandLocation, globalOp, clause,4145          declareGlobalCtorName.str(), /*implicit=*/false, asFortran);4146    }4147    if constexpr (!std::is_same_v<EntryOp, ExitOp>) {4148      createDeclareGlobalOp<mlir::acc::GlobalDestructorOp,4149                            mlir::acc::GetDevicePtrOp, mlir::acc::DeclareExitOp,4150                            ExitOp>(4151          modBuilder, builder, operandLocation, globalOp, clause,4152          declareGlobalDtorName.str(), /*implicit=*/false, asFortran);4153    }4154    builder.restoreInsertionPoint(crtPos);4155  };4156  for (const auto &accObject : accObjectList.v) {4157    mlir::Location operandLocation = genOperandLocation(converter, accObject);4158    Fortran::common::visit(4159        Fortran::common::visitors{4160            [&](const Fortran::parser::Designator &designator) {4161              if (const auto *name =4162                      Fortran::parser::GetDesignatorNameIfDataRef(designator)) {4163                genCtors(operandLocation, *name->symbol);4164              }4165            },4166            [&](const Fortran::parser::Name &name) {4167              if (const auto *symbol = name.symbol) {4168                if (symbol4169                        ->detailsIf<Fortran::semantics::CommonBlockDetails>()) {4170                  genCtors(operandLocation, *symbol);4171                } else {4172                  TODO(operandLocation,4173                       "OpenACC Global Ctor from parser::Name");4174                }4175              }4176            }},4177        accObject.u);4178  }4179}4180 4181template <typename Clause, typename EntryOp, typename ExitOp>4182static void4183genGlobalCtorsWithModifier(Fortran::lower::AbstractConverter &converter,4184                           mlir::OpBuilder &modBuilder, const Clause *x,4185                           Fortran::parser::AccDataModifier::Modifier mod,4186                           const mlir::acc::DataClause clause,4187                           const mlir::acc::DataClause clauseWithModifier) {4188  const Fortran::parser::AccObjectListWithModifier &listWithModifier = x->v;4189  const auto &accObjectList =4190      std::get<Fortran::parser::AccObjectList>(listWithModifier.t);4191  const auto &modifier =4192      std::get<std::optional<Fortran::parser::AccDataModifier>>(4193          listWithModifier.t);4194  mlir::acc::DataClause dataClause =4195      (modifier && (*modifier).v == mod) ? clauseWithModifier : clause;4196  genGlobalCtors<EntryOp, ExitOp>(converter, modBuilder, accObjectList,4197                                  dataClause);4198}4199 4200static fir::GlobalOp4201lookupGlobalBySymbolOrEquivalence(Fortran::lower::AbstractConverter &converter,4202                                  fir::FirOpBuilder &builder,4203                                  const Fortran::semantics::Symbol &sym) {4204  const Fortran::semantics::Symbol *commonBlock =4205      Fortran::semantics::FindCommonBlockContaining(sym);4206  std::string globalName = commonBlock ? converter.mangleName(*commonBlock)4207                                       : converter.mangleName(sym);4208  if (fir::GlobalOp g = builder.getNamedGlobal(globalName)) {4209    return g;4210  }4211  // Not found: if not a COMMON member, try equivalence members4212  if (!commonBlock) {4213    if (const Fortran::semantics::EquivalenceSet *eqSet =4214            Fortran::semantics::FindEquivalenceSet(sym)) {4215      for (const Fortran::semantics::EquivalenceObject &eqObj : *eqSet) {4216        std::string eqName = converter.mangleName(eqObj.symbol);4217        if (fir::GlobalOp g = builder.getNamedGlobal(eqName))4218          return g;4219      }4220    }4221  }4222  return {};4223}4224 4225template <typename EmitterFn>4226static void emitCommonGlobal(Fortran::lower::AbstractConverter &converter,4227                             fir::FirOpBuilder &builder,4228                             const Fortran::parser::AccObject &obj,4229                             mlir::acc::DataClause clause,4230                             EmitterFn &&emitCtorDtor) {4231  Fortran::semantics::Symbol &sym = getSymbolFromAccObject(obj);4232  if (!(sym.detailsIf<Fortran::semantics::CommonBlockDetails>() ||4233        Fortran::semantics::FindCommonBlockContaining(sym)))4234    return;4235 4236  fir::GlobalOp globalOp =4237      lookupGlobalBySymbolOrEquivalence(converter, builder, sym);4238  if (!globalOp)4239    llvm::report_fatal_error("could not retrieve global symbol");4240 4241  std::stringstream ctorName;4242  ctorName << globalOp.getSymName().str() << "_acc_ctor";4243  if (builder.getModule().lookupSymbol<mlir::acc::GlobalConstructorOp>(4244          ctorName.str()))4245    return;4246 4247  mlir::Location operandLocation = genOperandLocation(converter, obj);4248  addDeclareAttr(builder, globalOp.getOperation(), clause);4249  mlir::OpBuilder modBuilder(builder.getModule().getBodyRegion());4250  modBuilder.setInsertionPointAfter(globalOp);4251  std::stringstream asFortran;4252  asFortran << sym.name().ToString();4253 4254  auto savedIP = builder.saveInsertionPoint();4255  emitCtorDtor(modBuilder, operandLocation, globalOp, clause, asFortran,4256               ctorName.str());4257  builder.restoreInsertionPoint(savedIP);4258}4259 4260static void4261genDeclareInFunction(Fortran::lower::AbstractConverter &converter,4262                     Fortran::semantics::SemanticsContext &semanticsContext,4263                     Fortran::lower::StatementContext &openAccCtx,4264                     mlir::Location loc,4265                     const Fortran::parser::AccClauseList &accClauseList) {4266  llvm::SmallVector<mlir::Value> dataClauseOperands, copyEntryOperands,4267      copyinEntryOperands, createEntryOperands, copyoutEntryOperands,4268      presentEntryOperands, deviceResidentEntryOperands;4269  Fortran::lower::StatementContext stmtCtx;4270  fir::FirOpBuilder &builder = converter.getFirOpBuilder();4271 4272  for (const Fortran::parser::AccClause &clause : accClauseList.v) {4273    if (const auto *copyClause =4274            std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {4275      auto crtDataStart = dataClauseOperands.size();4276      genDeclareDataOperandOperations<mlir::acc::CopyinOp,4277                                      mlir::acc::CopyoutOp>(4278          copyClause->v, converter, semanticsContext, stmtCtx,4279          dataClauseOperands, mlir::acc::DataClause::acc_copy,4280          /*structured=*/true, /*implicit=*/false);4281      copyEntryOperands.append(dataClauseOperands.begin() + crtDataStart,4282                               dataClauseOperands.end());4283    } else if (const auto *createClause =4284                   std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {4285      auto crtDataStart = dataClauseOperands.size();4286      const auto &accObjectList =4287          std::get<Fortran::parser::AccObjectList>(createClause->v.t);4288      genDeclareDataOperandOperations<mlir::acc::CreateOp, mlir::acc::DeleteOp>(4289          accObjectList, converter, semanticsContext, stmtCtx,4290          dataClauseOperands, mlir::acc::DataClause::acc_create,4291          /*structured=*/true, /*implicit=*/false);4292      createEntryOperands.append(dataClauseOperands.begin() + crtDataStart,4293                                 dataClauseOperands.end());4294    } else if (const auto *presentClause =4295                   std::get_if<Fortran::parser::AccClause::Present>(4296                       &clause.u)) {4297      auto crtDataStart = dataClauseOperands.size();4298      genDeclareDataOperandOperations<mlir::acc::PresentOp,4299                                      mlir::acc::DeleteOp>(4300          presentClause->v, converter, semanticsContext, stmtCtx,4301          dataClauseOperands, mlir::acc::DataClause::acc_present,4302          /*structured=*/true, /*implicit=*/false);4303      presentEntryOperands.append(dataClauseOperands.begin() + crtDataStart,4304                                  dataClauseOperands.end());4305    } else if (const auto *copyinClause =4306                   std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {4307      auto crtDataStart = dataClauseOperands.size();4308      genDeclareDataOperandOperationsWithModifier<mlir::acc::CopyinOp,4309                                                  mlir::acc::DeleteOp>(4310          copyinClause, converter, semanticsContext, stmtCtx,4311          Fortran::parser::AccDataModifier::Modifier::ReadOnly,4312          dataClauseOperands, mlir::acc::DataClause::acc_copyin,4313          mlir::acc::DataClause::acc_copyin_readonly);4314      copyinEntryOperands.append(dataClauseOperands.begin() + crtDataStart,4315                                 dataClauseOperands.end());4316    } else if (const auto *copyoutClause =4317                   std::get_if<Fortran::parser::AccClause::Copyout>(4318                       &clause.u)) {4319      auto crtDataStart = dataClauseOperands.size();4320      const auto &accObjectList =4321          std::get<Fortran::parser::AccObjectList>(copyoutClause->v.t);4322      genDeclareDataOperandOperations<mlir::acc::CreateOp,4323                                      mlir::acc::CopyoutOp>(4324          accObjectList, converter, semanticsContext, stmtCtx,4325          dataClauseOperands, mlir::acc::DataClause::acc_copyout,4326          /*structured=*/true, /*implicit=*/false);4327      copyoutEntryOperands.append(dataClauseOperands.begin() + crtDataStart,4328                                  dataClauseOperands.end());4329    } else if (const auto *devicePtrClause =4330                   std::get_if<Fortran::parser::AccClause::Deviceptr>(4331                       &clause.u)) {4332      genDeclareDataOperandOperations<mlir::acc::DevicePtrOp,4333                                      mlir::acc::DevicePtrOp>(4334          devicePtrClause->v, converter, semanticsContext, stmtCtx,4335          dataClauseOperands, mlir::acc::DataClause::acc_deviceptr,4336          /*structured=*/true, /*implicit=*/false);4337    } else if (const auto *linkClause =4338                   std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) {4339      genDeclareDataOperandOperations<mlir::acc::DeclareLinkOp,4340                                      mlir::acc::DeclareLinkOp>(4341          linkClause->v, converter, semanticsContext, stmtCtx,4342          dataClauseOperands, mlir::acc::DataClause::acc_declare_link,4343          /*structured=*/true, /*implicit=*/false);4344    } else if (const auto *deviceResidentClause =4345                   std::get_if<Fortran::parser::AccClause::DeviceResident>(4346                       &clause.u)) {4347      auto crtDataStart = dataClauseOperands.size();4348      genDeclareDataOperandOperations<mlir::acc::DeclareDeviceResidentOp,4349                                      mlir::acc::DeleteOp>(4350          deviceResidentClause->v, converter, semanticsContext, stmtCtx,4351          dataClauseOperands,4352          mlir::acc::DataClause::acc_declare_device_resident,4353          /*structured=*/true, /*implicit=*/false);4354      deviceResidentEntryOperands.append(4355          dataClauseOperands.begin() + crtDataStart, dataClauseOperands.end());4356    } else {4357      mlir::Location clauseLocation = converter.genLocation(clause.source);4358      TODO(clauseLocation, "clause on declare directive");4359    }4360  }4361 4362  // If no structured operands were generated (all objects were COMMON),4363  // do not create a declare region.4364  if (dataClauseOperands.empty())4365    return;4366 4367  mlir::func::FuncOp funcOp = builder.getFunction();4368  auto ops = funcOp.getOps<mlir::acc::DeclareEnterOp>();4369  mlir::Value declareToken;4370  if (ops.empty()) {4371    declareToken = mlir::acc::DeclareEnterOp::create(4372        builder, loc, mlir::acc::DeclareTokenType::get(builder.getContext()),4373        dataClauseOperands);4374  } else {4375    auto declareOp = *ops.begin();4376    auto newDeclareOp = mlir::acc::DeclareEnterOp::create(4377        builder, loc, mlir::acc::DeclareTokenType::get(builder.getContext()),4378        declareOp.getDataClauseOperands());4379    newDeclareOp.getDataClauseOperandsMutable().append(dataClauseOperands);4380    declareToken = newDeclareOp.getToken();4381    declareOp.erase();4382  }4383 4384  openAccCtx.attachCleanup([&builder, loc, createEntryOperands,4385                            copyEntryOperands, copyinEntryOperands,4386                            copyoutEntryOperands, presentEntryOperands,4387                            deviceResidentEntryOperands, declareToken]() {4388    llvm::SmallVector<mlir::Value> operands;4389    operands.append(createEntryOperands);4390    operands.append(deviceResidentEntryOperands);4391    operands.append(copyEntryOperands);4392    operands.append(copyinEntryOperands);4393    operands.append(copyoutEntryOperands);4394    operands.append(presentEntryOperands);4395 4396    mlir::func::FuncOp funcOp = builder.getFunction();4397    auto ops = funcOp.getOps<mlir::acc::DeclareExitOp>();4398    if (ops.empty()) {4399      mlir::acc::DeclareExitOp::create(builder, loc, declareToken, operands);4400    } else {4401      auto declareOp = *ops.begin();4402      declareOp.getDataClauseOperandsMutable().append(operands);4403    }4404 4405    genDataExitOperations<mlir::acc::CreateOp, mlir::acc::DeleteOp>(4406        builder, createEntryOperands, /*structured=*/true);4407    genDataExitOperations<mlir::acc::DeclareDeviceResidentOp,4408                          mlir::acc::DeleteOp>(4409        builder, deviceResidentEntryOperands, /*structured=*/true);4410    genDataExitOperations<mlir::acc::CopyinOp, mlir::acc::CopyoutOp>(4411        builder, copyEntryOperands, /*structured=*/true);4412    genDataExitOperations<mlir::acc::CopyinOp, mlir::acc::DeleteOp>(4413        builder, copyinEntryOperands, /*structured=*/true);4414    genDataExitOperations<mlir::acc::CreateOp, mlir::acc::CopyoutOp>(4415        builder, copyoutEntryOperands, /*structured=*/true);4416    genDataExitOperations<mlir::acc::PresentOp, mlir::acc::DeleteOp>(4417        builder, presentEntryOperands, /*structured=*/true);4418  });4419}4420 4421static void4422genDeclareInModule(Fortran::lower::AbstractConverter &converter,4423                   mlir::ModuleOp moduleOp,4424                   const Fortran::parser::AccClauseList &accClauseList) {4425  mlir::OpBuilder modBuilder(moduleOp.getBodyRegion());4426  for (const Fortran::parser::AccClause &clause : accClauseList.v) {4427    if (const auto *createClause =4428            std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {4429      const Fortran::parser::AccObjectListWithModifier &listWithModifier =4430          createClause->v;4431      const auto &accObjectList =4432          std::get<Fortran::parser::AccObjectList>(listWithModifier.t);4433      genGlobalCtors<mlir::acc::CreateOp, mlir::acc::DeleteOp>(4434          converter, modBuilder, accObjectList,4435          mlir::acc::DataClause::acc_create);4436    } else if (const auto *copyinClause =4437                   std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {4438      genGlobalCtorsWithModifier<Fortran::parser::AccClause::Copyin,4439                                 mlir::acc::CopyinOp, mlir::acc::DeleteOp>(4440          converter, modBuilder, copyinClause,4441          Fortran::parser::AccDataModifier::Modifier::ReadOnly,4442          mlir::acc::DataClause::acc_copyin,4443          mlir::acc::DataClause::acc_copyin_readonly);4444    } else if (const auto *deviceResidentClause =4445                   std::get_if<Fortran::parser::AccClause::DeviceResident>(4446                       &clause.u)) {4447      genGlobalCtors<mlir::acc::DeclareDeviceResidentOp, mlir::acc::DeleteOp>(4448          converter, modBuilder, deviceResidentClause->v,4449          mlir::acc::DataClause::acc_declare_device_resident);4450    } else if (const auto *linkClause =4451                   std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) {4452      genGlobalCtors<mlir::acc::DeclareLinkOp, mlir::acc::DeclareLinkOp>(4453          converter, modBuilder, linkClause->v,4454          mlir::acc::DataClause::acc_declare_link);4455    } else {4456      llvm::report_fatal_error("unsupported clause on DECLARE directive");4457    }4458  }4459}4460 4461static void genACC(Fortran::lower::AbstractConverter &converter,4462                   Fortran::semantics::SemanticsContext &semanticsContext,4463                   Fortran::lower::StatementContext &openAccCtx,4464                   const Fortran::parser::OpenACCStandaloneDeclarativeConstruct4465                       &declareConstruct) {4466 4467  const auto &declarativeDir =4468      std::get<Fortran::parser::AccDeclarativeDirective>(declareConstruct.t);4469  mlir::Location directiveLocation =4470      converter.genLocation(declarativeDir.source);4471  const auto &accClauseList =4472      std::get<Fortran::parser::AccClauseList>(declareConstruct.t);4473 4474  if (declarativeDir.v == llvm::acc::Directive::ACCD_declare) {4475    fir::FirOpBuilder &builder = converter.getFirOpBuilder();4476    auto moduleOp =4477        builder.getBlock()->getParent()->getParentOfType<mlir::ModuleOp>();4478    auto funcOp =4479        builder.getBlock()->getParent()->getParentOfType<mlir::func::FuncOp>();4480    if (funcOp)4481      genDeclareInFunction(converter, semanticsContext, openAccCtx,4482                           directiveLocation, accClauseList);4483    else if (moduleOp)4484      genDeclareInModule(converter, moduleOp, accClauseList);4485    return;4486  }4487  llvm_unreachable("unsupported declarative directive");4488}4489 4490static bool hasDeviceType(llvm::SmallVector<mlir::Attribute> &arrayAttr,4491                          mlir::acc::DeviceType deviceType) {4492  for (auto attr : arrayAttr) {4493    auto deviceTypeAttr = mlir::dyn_cast<mlir::acc::DeviceTypeAttr>(attr);4494    if (deviceTypeAttr.getValue() == deviceType)4495      return true;4496  }4497  return false;4498}4499 4500template <typename RetTy, typename AttrTy>4501static std::optional<RetTy>4502getAttributeValueByDeviceType(llvm::SmallVector<mlir::Attribute> &attributes,4503                              llvm::SmallVector<mlir::Attribute> &deviceTypes,4504                              mlir::acc::DeviceType deviceType) {4505  assert(attributes.size() == deviceTypes.size() &&4506         "expect same number of attributes");4507  for (auto it : llvm::enumerate(deviceTypes)) {4508    auto deviceTypeAttr = mlir::dyn_cast<mlir::acc::DeviceTypeAttr>(it.value());4509    if (deviceTypeAttr.getValue() == deviceType) {4510      if constexpr (std::is_same_v<mlir::StringAttr, AttrTy>) {4511        auto strAttr = mlir::dyn_cast<AttrTy>(attributes[it.index()]);4512        return strAttr.getValue();4513      } else if constexpr (std::is_same_v<mlir::IntegerAttr, AttrTy>) {4514        auto intAttr =4515            mlir::dyn_cast<mlir::IntegerAttr>(attributes[it.index()]);4516        return intAttr.getInt();4517      }4518    }4519  }4520  return std::nullopt;4521}4522 4523// Helper function to extract string value from bind name variant4524static std::optional<llvm::StringRef> getBindNameStringValue(4525    const std::optional<std::variant<mlir::SymbolRefAttr, mlir::StringAttr>>4526        &bindNameValue) {4527  if (!bindNameValue.has_value())4528    return std::nullopt;4529 4530  return std::visit(4531      [](const auto &attr) -> std::optional<llvm::StringRef> {4532        if constexpr (std::is_same_v<std::decay_t<decltype(attr)>,4533                                     mlir::StringAttr>) {4534          return attr.getValue();4535        } else if constexpr (std::is_same_v<std::decay_t<decltype(attr)>,4536                                            mlir::SymbolRefAttr>) {4537          return attr.getLeafReference();4538        } else {4539          return std::nullopt;4540        }4541      },4542      bindNameValue.value());4543}4544 4545static bool compareDeviceTypeInfo(4546    mlir::acc::RoutineOp op,4547    llvm::SmallVector<mlir::Attribute> &bindIdNameArrayAttr,4548    llvm::SmallVector<mlir::Attribute> &bindStrNameArrayAttr,4549    llvm::SmallVector<mlir::Attribute> &bindIdNameDeviceTypeArrayAttr,4550    llvm::SmallVector<mlir::Attribute> &bindStrNameDeviceTypeArrayAttr,4551    llvm::SmallVector<mlir::Attribute> &gangArrayAttr,4552    llvm::SmallVector<mlir::Attribute> &gangDimArrayAttr,4553    llvm::SmallVector<mlir::Attribute> &gangDimDeviceTypeArrayAttr,4554    llvm::SmallVector<mlir::Attribute> &seqArrayAttr,4555    llvm::SmallVector<mlir::Attribute> &workerArrayAttr,4556    llvm::SmallVector<mlir::Attribute> &vectorArrayAttr) {4557  for (uint32_t dtypeInt = 0;4558       dtypeInt != mlir::acc::getMaxEnumValForDeviceType(); ++dtypeInt) {4559    auto dtype = static_cast<mlir::acc::DeviceType>(dtypeInt);4560    auto bindNameValue = getBindNameStringValue(op.getBindNameValue(dtype));4561    if (bindNameValue !=4562            getAttributeValueByDeviceType<llvm::StringRef, mlir::StringAttr>(4563                bindIdNameArrayAttr, bindIdNameDeviceTypeArrayAttr, dtype) &&4564        bindNameValue !=4565            getAttributeValueByDeviceType<llvm::StringRef, mlir::StringAttr>(4566                bindStrNameArrayAttr, bindStrNameDeviceTypeArrayAttr, dtype))4567      return false;4568    if (op.hasGang(dtype) != hasDeviceType(gangArrayAttr, dtype))4569      return false;4570    if (op.getGangDimValue(dtype) !=4571        getAttributeValueByDeviceType<int64_t, mlir::IntegerAttr>(4572            gangDimArrayAttr, gangDimDeviceTypeArrayAttr, dtype))4573      return false;4574    if (op.hasSeq(dtype) != hasDeviceType(seqArrayAttr, dtype))4575      return false;4576    if (op.hasWorker(dtype) != hasDeviceType(workerArrayAttr, dtype))4577      return false;4578    if (op.hasVector(dtype) != hasDeviceType(vectorArrayAttr, dtype))4579      return false;4580  }4581  return true;4582}4583 4584static void attachRoutineInfo(mlir::func::FuncOp func,4585                              mlir::SymbolRefAttr routineAttr) {4586  llvm::SmallVector<mlir::SymbolRefAttr> routines;4587  if (func.getOperation()->hasAttr(mlir::acc::getRoutineInfoAttrName())) {4588    auto routineInfo =4589        func.getOperation()->getAttrOfType<mlir::acc::RoutineInfoAttr>(4590            mlir::acc::getRoutineInfoAttrName());4591    routines.append(routineInfo.getAccRoutines().begin(),4592                    routineInfo.getAccRoutines().end());4593  }4594  routines.push_back(routineAttr);4595  func.getOperation()->setAttr(4596      mlir::acc::getRoutineInfoAttrName(),4597      mlir::acc::RoutineInfoAttr::get(func.getContext(), routines));4598}4599 4600static mlir::ArrayAttr4601getArrayAttrOrNull(fir::FirOpBuilder &builder,4602                   llvm::SmallVector<mlir::Attribute> &attributes) {4603  if (attributes.empty()) {4604    return nullptr;4605  } else {4606    return builder.getArrayAttr(attributes);4607  }4608}4609 4610void createOpenACCRoutineConstruct(4611    Fortran::lower::AbstractConverter &converter, mlir::Location loc,4612    mlir::ModuleOp mod, mlir::func::FuncOp funcOp, std::string funcName,4613    bool hasNohost, llvm::SmallVector<mlir::Attribute> &bindIdNames,4614    llvm::SmallVector<mlir::Attribute> &bindStrNames,4615    llvm::SmallVector<mlir::Attribute> &bindIdNameDeviceTypes,4616    llvm::SmallVector<mlir::Attribute> &bindStrNameDeviceTypes,4617    llvm::SmallVector<mlir::Attribute> &gangDeviceTypes,4618    llvm::SmallVector<mlir::Attribute> &gangDimValues,4619    llvm::SmallVector<mlir::Attribute> &gangDimDeviceTypes,4620    llvm::SmallVector<mlir::Attribute> &seqDeviceTypes,4621    llvm::SmallVector<mlir::Attribute> &workerDeviceTypes,4622    llvm::SmallVector<mlir::Attribute> &vectorDeviceTypes) {4623 4624  for (auto routineOp : mod.getOps<mlir::acc::RoutineOp>()) {4625    if (routineOp.getFuncName().getLeafReference().str().compare(funcName) ==4626        0) {4627      // If the routine is already specified with the same clauses, just skip4628      // the operation creation.4629      if (compareDeviceTypeInfo(routineOp, bindIdNames, bindStrNames,4630                                bindIdNameDeviceTypes, bindStrNameDeviceTypes,4631                                gangDeviceTypes, gangDimValues,4632                                gangDimDeviceTypes, seqDeviceTypes,4633                                workerDeviceTypes, vectorDeviceTypes) &&4634          routineOp.getNohost() == hasNohost)4635        return;4636      mlir::emitError(loc, "Routine already specified with different clauses");4637    }4638  }4639  std::stringstream routineOpName;4640  routineOpName << accRoutinePrefix.str() << routineCounter++;4641  std::string routineOpStr = routineOpName.str();4642  mlir::OpBuilder modBuilder(mod.getBodyRegion());4643  fir::FirOpBuilder &builder = converter.getFirOpBuilder();4644  mlir::acc::RoutineOp::create(4645      modBuilder, loc, routineOpStr,4646      mlir::SymbolRefAttr::get(builder.getContext(), funcName),4647      getArrayAttrOrNull(builder, bindIdNames),4648      getArrayAttrOrNull(builder, bindStrNames),4649      getArrayAttrOrNull(builder, bindIdNameDeviceTypes),4650      getArrayAttrOrNull(builder, bindStrNameDeviceTypes),4651      getArrayAttrOrNull(builder, workerDeviceTypes),4652      getArrayAttrOrNull(builder, vectorDeviceTypes),4653      getArrayAttrOrNull(builder, seqDeviceTypes), hasNohost,4654      /*implicit=*/false, getArrayAttrOrNull(builder, gangDeviceTypes),4655      getArrayAttrOrNull(builder, gangDimValues),4656      getArrayAttrOrNull(builder, gangDimDeviceTypes));4657 4658  attachRoutineInfo(funcOp, builder.getSymbolRefAttr(routineOpStr));4659}4660 4661static void interpretRoutineDeviceInfo(4662    Fortran::lower::AbstractConverter &converter,4663    const Fortran::semantics::OpenACCRoutineDeviceTypeInfo &dinfo,4664    llvm::SmallVector<mlir::Attribute> &seqDeviceTypes,4665    llvm::SmallVector<mlir::Attribute> &vectorDeviceTypes,4666    llvm::SmallVector<mlir::Attribute> &workerDeviceTypes,4667    llvm::SmallVector<mlir::Attribute> &bindIdNameDeviceTypes,4668    llvm::SmallVector<mlir::Attribute> &bindStrNameDeviceTypes,4669    llvm::SmallVector<mlir::Attribute> &bindIdNames,4670    llvm::SmallVector<mlir::Attribute> &bindStrNames,4671    llvm::SmallVector<mlir::Attribute> &gangDeviceTypes,4672    llvm::SmallVector<mlir::Attribute> &gangDimValues,4673    llvm::SmallVector<mlir::Attribute> &gangDimDeviceTypes) {4674  fir::FirOpBuilder &builder = converter.getFirOpBuilder();4675  auto getDeviceTypeAttr = [&]() -> mlir::Attribute {4676    auto context = builder.getContext();4677    auto value = getDeviceType(dinfo.dType());4678    return mlir::acc::DeviceTypeAttr::get(context, value);4679  };4680  if (dinfo.isSeq()) {4681    seqDeviceTypes.push_back(getDeviceTypeAttr());4682  }4683  if (dinfo.isVector()) {4684    vectorDeviceTypes.push_back(getDeviceTypeAttr());4685  }4686  if (dinfo.isWorker()) {4687    workerDeviceTypes.push_back(getDeviceTypeAttr());4688  }4689  if (dinfo.isGang()) {4690    unsigned gangDim = dinfo.gangDim();4691    auto deviceType = getDeviceTypeAttr();4692    if (!gangDim) {4693      gangDeviceTypes.push_back(deviceType);4694    } else {4695      gangDimValues.push_back(4696          builder.getIntegerAttr(builder.getI64Type(), gangDim));4697      gangDimDeviceTypes.push_back(deviceType);4698    }4699  }4700  if (dinfo.bindNameOpt().has_value()) {4701    const auto &bindName = dinfo.bindNameOpt().value();4702    mlir::Attribute bindNameAttr;4703    if (const auto &bindSym{4704            std::get_if<Fortran::semantics::SymbolRef>(&bindName)}) {4705      bindNameAttr = builder.getSymbolRefAttr(converter.mangleName(*bindSym));4706      bindIdNames.push_back(bindNameAttr);4707      bindIdNameDeviceTypes.push_back(getDeviceTypeAttr());4708    } else if (const auto &bindStr{std::get_if<std::string>(&bindName)}) {4709      bindNameAttr = builder.getStringAttr(*bindStr);4710      bindStrNames.push_back(bindNameAttr);4711      bindStrNameDeviceTypes.push_back(getDeviceTypeAttr());4712    } else {4713      llvm_unreachable("Unsupported bind name type");4714    }4715  }4716}4717 4718void Fortran::lower::genOpenACCRoutineConstruct(4719    Fortran::lower::AbstractConverter &converter, mlir::ModuleOp mod,4720    mlir::func::FuncOp funcOp,4721    const std::vector<Fortran::semantics::OpenACCRoutineInfo> &routineInfos) {4722  CHECK(funcOp && "Expected a valid function operation");4723  mlir::Location loc{funcOp.getLoc()};4724  std::string funcName{funcOp.getName()};4725 4726  // Collect the routine clauses4727  bool hasNohost{false};4728 4729  llvm::SmallVector<mlir::Attribute> seqDeviceTypes, vectorDeviceTypes,4730      workerDeviceTypes, bindIdNameDeviceTypes, bindStrNameDeviceTypes,4731      bindIdNames, bindStrNames, gangDeviceTypes, gangDimDeviceTypes,4732      gangDimValues;4733 4734  for (const Fortran::semantics::OpenACCRoutineInfo &info : routineInfos) {4735    // Device Independent Attributes4736    if (info.isNohost()) {4737      hasNohost = true;4738    }4739    // Note: Device Independent Attributes are set to the4740    // none device type in `info`.4741    interpretRoutineDeviceInfo(4742        converter, info, seqDeviceTypes, vectorDeviceTypes, workerDeviceTypes,4743        bindIdNameDeviceTypes, bindStrNameDeviceTypes, bindIdNames,4744        bindStrNames, gangDeviceTypes, gangDimValues, gangDimDeviceTypes);4745 4746    // Device Dependent Attributes4747    for (const Fortran::semantics::OpenACCRoutineDeviceTypeInfo &dinfo :4748         info.deviceTypeInfos()) {4749      interpretRoutineDeviceInfo(converter, dinfo, seqDeviceTypes,4750                                 vectorDeviceTypes, workerDeviceTypes,4751                                 bindIdNameDeviceTypes, bindStrNameDeviceTypes,4752                                 bindIdNames, bindStrNames, gangDeviceTypes,4753                                 gangDimValues, gangDimDeviceTypes);4754    }4755  }4756  createOpenACCRoutineConstruct(4757      converter, loc, mod, funcOp, funcName, hasNohost, bindIdNames,4758      bindStrNames, bindIdNameDeviceTypes, bindStrNameDeviceTypes,4759      gangDeviceTypes, gangDimValues, gangDimDeviceTypes, seqDeviceTypes,4760      workerDeviceTypes, vectorDeviceTypes);4761}4762 4763static void4764genACC(Fortran::lower::AbstractConverter &converter,4765       Fortran::lower::pft::Evaluation &eval,4766       const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) {4767 4768  mlir::Location loc = converter.genLocation(atomicConstruct.source);4769  Fortran::common::visit(4770      Fortran::common::visitors{4771          [&](const Fortran::parser::AccAtomicRead &atomicRead) {4772            genAtomicRead(converter, atomicRead, loc);4773          },4774          [&](const Fortran::parser::AccAtomicWrite &atomicWrite) {4775            genAtomicWrite(converter, atomicWrite, loc);4776          },4777          [&](const Fortran::parser::AccAtomicUpdate &atomicUpdate) {4778            genAtomicUpdate(converter, atomicUpdate, loc);4779          },4780          [&](const Fortran::parser::AccAtomicCapture &atomicCapture) {4781            genAtomicCapture(converter, atomicCapture, loc);4782          },4783      },4784      atomicConstruct.u);4785}4786 4787static void4788genACC(Fortran::lower::AbstractConverter &converter,4789       Fortran::semantics::SemanticsContext &semanticsContext,4790       const Fortran::parser::OpenACCCacheConstruct &cacheConstruct) {4791  fir::FirOpBuilder &builder = converter.getFirOpBuilder();4792  auto loopOp = builder.getRegion().getParentOfType<mlir::acc::LoopOp>();4793  auto crtPos = builder.saveInsertionPoint();4794  if (loopOp) {4795    builder.setInsertionPoint(loopOp);4796    Fortran::lower::StatementContext stmtCtx;4797    llvm::SmallVector<mlir::Value> cacheOperands;4798    const Fortran::parser::AccObjectListWithModifier &listWithModifier =4799        std::get<Fortran::parser::AccObjectListWithModifier>(cacheConstruct.t);4800    const auto &accObjectList =4801        std::get<Fortran::parser::AccObjectList>(listWithModifier.t);4802    const auto &modifier =4803        std::get<std::optional<Fortran::parser::AccDataModifier>>(4804            listWithModifier.t);4805 4806    mlir::acc::DataClause dataClause = mlir::acc::DataClause::acc_cache;4807    if (modifier &&4808        (*modifier).v == Fortran::parser::AccDataModifier::Modifier::ReadOnly)4809      dataClause = mlir::acc::DataClause::acc_cache_readonly;4810    genDataOperandOperations<mlir::acc::CacheOp>(4811        accObjectList, converter, semanticsContext, stmtCtx, cacheOperands,4812        dataClause,4813        /*structured=*/true, /*implicit=*/false,4814        /*async=*/{}, /*asyncDeviceTypes=*/{}, /*asyncOnlyDeviceTypes=*/{},4815        /*setDeclareAttr*/ false);4816    loopOp.getCacheOperandsMutable().append(cacheOperands);4817  } else {4818    llvm::report_fatal_error(4819        "could not find loop to attach OpenACC cache information.");4820  }4821  builder.restoreInsertionPoint(crtPos);4822}4823 4824mlir::Value Fortran::lower::genOpenACCConstruct(4825    Fortran::lower::AbstractConverter &converter,4826    Fortran::semantics::SemanticsContext &semanticsContext,4827    Fortran::lower::pft::Evaluation &eval,4828    const Fortran::parser::OpenACCConstruct &accConstruct,4829    Fortran::lower::SymMap &localSymbols) {4830 4831  mlir::Value exitCond;4832  Fortran::common::visit(4833      common::visitors{4834          [&](const Fortran::parser::OpenACCBlockConstruct &blockConstruct) {4835            genACC(converter, semanticsContext, eval, blockConstruct,4836                   localSymbols);4837          },4838          [&](const Fortran::parser::OpenACCCombinedConstruct4839                  &combinedConstruct) {4840            genACC(converter, semanticsContext, eval, combinedConstruct);4841          },4842          [&](const Fortran::parser::OpenACCLoopConstruct &loopConstruct) {4843            exitCond = genACC(converter, semanticsContext, eval, loopConstruct);4844          },4845          [&](const Fortran::parser::OpenACCStandaloneConstruct4846                  &standaloneConstruct) {4847            genACC(converter, semanticsContext, standaloneConstruct);4848          },4849          [&](const Fortran::parser::OpenACCCacheConstruct &cacheConstruct) {4850            genACC(converter, semanticsContext, cacheConstruct);4851          },4852          [&](const Fortran::parser::OpenACCWaitConstruct &waitConstruct) {4853            genACC(converter, waitConstruct);4854          },4855          [&](const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) {4856            genACC(converter, eval, atomicConstruct);4857          },4858          [&](const Fortran::parser::OpenACCEndConstruct &) {4859            // No op4860          },4861      },4862      accConstruct.u);4863  return exitCond;4864}4865 4866void Fortran::lower::genOpenACCDeclarativeConstruct(4867    Fortran::lower::AbstractConverter &converter,4868    Fortran::semantics::SemanticsContext &semanticsContext,4869    Fortran::lower::StatementContext &openAccCtx,4870    const Fortran::parser::OpenACCDeclarativeConstruct &accDeclConstruct) {4871 4872  Fortran::common::visit(4873      common::visitors{4874          [&](const Fortran::parser::OpenACCStandaloneDeclarativeConstruct4875                  &standaloneDeclarativeConstruct) {4876            genACC(converter, semanticsContext, openAccCtx,4877                   standaloneDeclarativeConstruct);4878          },4879          [&](const Fortran::parser::OpenACCRoutineConstruct &x) {},4880      },4881      accDeclConstruct.u);4882}4883 4884void Fortran::lower::attachDeclarePostAllocAction(4885    AbstractConverter &converter, fir::FirOpBuilder &builder,4886    const Fortran::semantics::Symbol &sym) {4887  std::stringstream fctName;4888  fctName << converter.mangleName(sym) << declarePostAllocSuffix.str();4889  mlir::Operation *op = &builder.getInsertionBlock()->back();4890 4891  if (auto resOp = mlir::dyn_cast<fir::ResultOp>(*op)) {4892    assert(resOp.getOperands().size() == 0 &&4893           "expect only fir.result op with no operand");4894    op = op->getPrevNode();4895  }4896  assert(op && "expect operation to attach the post allocation action");4897 4898  if (op->hasAttr(mlir::acc::getDeclareActionAttrName())) {4899    auto attr = op->getAttrOfType<mlir::acc::DeclareActionAttr>(4900        mlir::acc::getDeclareActionAttrName());4901    op->setAttr(mlir::acc::getDeclareActionAttrName(),4902                mlir::acc::DeclareActionAttr::get(4903                    builder.getContext(), attr.getPreAlloc(),4904                    /*postAlloc=*/builder.getSymbolRefAttr(fctName.str()),4905                    attr.getPreDealloc(), attr.getPostDealloc()));4906  } else {4907    op->setAttr(mlir::acc::getDeclareActionAttrName(),4908                mlir::acc::DeclareActionAttr::get(4909                    builder.getContext(),4910                    /*preAlloc=*/{},4911                    /*postAlloc=*/builder.getSymbolRefAttr(fctName.str()),4912                    /*preDealloc=*/{}, /*postDealloc=*/{}));4913  }4914}4915 4916void Fortran::lower::attachDeclarePreDeallocAction(4917    AbstractConverter &converter, fir::FirOpBuilder &builder,4918    mlir::Value beginOpValue, const Fortran::semantics::Symbol &sym) {4919  if (!sym.test(Fortran::semantics::Symbol::Flag::AccCreate) &&4920      !sym.test(Fortran::semantics::Symbol::Flag::AccCopyIn) &&4921      !sym.test(Fortran::semantics::Symbol::Flag::AccCopyInReadOnly) &&4922      !sym.test(Fortran::semantics::Symbol::Flag::AccCopy) &&4923      !sym.test(Fortran::semantics::Symbol::Flag::AccCopyOut) &&4924      !sym.test(Fortran::semantics::Symbol::Flag::AccDeviceResident))4925    return;4926 4927  std::stringstream fctName;4928  fctName << converter.mangleName(sym) << declarePreDeallocSuffix.str();4929 4930  auto *op = beginOpValue.getDefiningOp();4931  if (op->hasAttr(mlir::acc::getDeclareActionAttrName())) {4932    auto attr = op->getAttrOfType<mlir::acc::DeclareActionAttr>(4933        mlir::acc::getDeclareActionAttrName());4934    op->setAttr(mlir::acc::getDeclareActionAttrName(),4935                mlir::acc::DeclareActionAttr::get(4936                    builder.getContext(), attr.getPreAlloc(),4937                    attr.getPostAlloc(),4938                    /*preDealloc=*/builder.getSymbolRefAttr(fctName.str()),4939                    attr.getPostDealloc()));4940  } else {4941    op->setAttr(mlir::acc::getDeclareActionAttrName(),4942                mlir::acc::DeclareActionAttr::get(4943                    builder.getContext(),4944                    /*preAlloc=*/{}, /*postAlloc=*/{},4945                    /*preDealloc=*/builder.getSymbolRefAttr(fctName.str()),4946                    /*postDealloc=*/{}));4947  }4948}4949 4950void Fortran::lower::attachDeclarePostDeallocAction(4951    AbstractConverter &converter, fir::FirOpBuilder &builder,4952    const Fortran::semantics::Symbol &sym) {4953  if (!sym.test(Fortran::semantics::Symbol::Flag::AccCreate) &&4954      !sym.test(Fortran::semantics::Symbol::Flag::AccCopyIn) &&4955      !sym.test(Fortran::semantics::Symbol::Flag::AccCopyInReadOnly) &&4956      !sym.test(Fortran::semantics::Symbol::Flag::AccCopy) &&4957      !sym.test(Fortran::semantics::Symbol::Flag::AccCopyOut) &&4958      !sym.test(Fortran::semantics::Symbol::Flag::AccDeviceResident))4959    return;4960 4961  std::stringstream fctName;4962  fctName << converter.mangleName(sym) << declarePostDeallocSuffix.str();4963  mlir::Operation *op = &builder.getInsertionBlock()->back();4964  if (auto resOp = mlir::dyn_cast<fir::ResultOp>(*op)) {4965    assert(resOp.getOperands().size() == 0 &&4966           "expect only fir.result op with no operand");4967    op = op->getPrevNode();4968  }4969  assert(op && "expect operation to attach the post deallocation action");4970  if (op->hasAttr(mlir::acc::getDeclareActionAttrName())) {4971    auto attr = op->getAttrOfType<mlir::acc::DeclareActionAttr>(4972        mlir::acc::getDeclareActionAttrName());4973    op->setAttr(mlir::acc::getDeclareActionAttrName(),4974                mlir::acc::DeclareActionAttr::get(4975                    builder.getContext(), attr.getPreAlloc(),4976                    attr.getPostAlloc(), attr.getPreDealloc(),4977                    /*postDealloc=*/builder.getSymbolRefAttr(fctName.str())));4978  } else {4979    op->setAttr(mlir::acc::getDeclareActionAttrName(),4980                mlir::acc::DeclareActionAttr::get(4981                    builder.getContext(),4982                    /*preAlloc=*/{}, /*postAlloc=*/{}, /*preDealloc=*/{},4983                    /*postDealloc=*/builder.getSymbolRefAttr(fctName.str())));4984  }4985}4986 4987void Fortran::lower::genOpenACCTerminator(fir::FirOpBuilder &builder,4988                                          mlir::Operation *op,4989                                          mlir::Location loc) {4990  if (mlir::isa<mlir::acc::ParallelOp, mlir::acc::LoopOp>(op))4991    mlir::acc::YieldOp::create(builder, loc);4992  else4993    mlir::acc::TerminatorOp::create(builder, loc);4994}4995 4996bool Fortran::lower::isInOpenACCLoop(fir::FirOpBuilder &builder) {4997  if (builder.getBlock()->getParent()->getParentOfType<mlir::acc::LoopOp>())4998    return true;4999  return false;5000}5001 5002bool Fortran::lower::isInsideOpenACCComputeConstruct(5003    fir::FirOpBuilder &builder) {5004  return mlir::isa_and_nonnull<ACC_COMPUTE_CONSTRUCT_OPS>(5005      mlir::acc::getEnclosingComputeOp(builder.getRegion()));5006}5007 5008void Fortran::lower::setInsertionPointAfterOpenACCLoopIfInside(5009    fir::FirOpBuilder &builder) {5010  if (auto loopOp =5011          builder.getBlock()->getParent()->getParentOfType<mlir::acc::LoopOp>())5012    builder.setInsertionPointAfter(loopOp);5013}5014 5015void Fortran::lower::genEarlyReturnInOpenACCLoop(fir::FirOpBuilder &builder,5016                                                 mlir::Location loc) {5017  mlir::Value yieldValue =5018      builder.createIntegerConstant(loc, builder.getI1Type(), 1);5019  mlir::acc::YieldOp::create(builder, loc, yieldValue);5020}5021 5022uint64_t Fortran::lower::getLoopCountForCollapseAndTile(5023    const Fortran::parser::AccClauseList &clauseList) {5024  uint64_t collapseLoopCount = getCollapseSizeAndForce(clauseList).first;5025  uint64_t tileLoopCount = 1;5026  for (const Fortran::parser::AccClause &clause : clauseList.v) {5027    if (const auto *tileClause =5028            std::get_if<Fortran::parser::AccClause::Tile>(&clause.u)) {5029      const parser::AccTileExprList &tileExprList = tileClause->v;5030      tileLoopCount = tileExprList.v.size();5031    }5032  }5033  return tileLoopCount > collapseLoopCount ? tileLoopCount : collapseLoopCount;5034}5035 5036std::pair<uint64_t, bool> Fortran::lower::getCollapseSizeAndForce(5037    const Fortran::parser::AccClauseList &clauseList) {5038  uint64_t size = 1;5039  bool force = false;5040  for (const Fortran::parser::AccClause &clause : clauseList.v) {5041    if (const auto *collapseClause =5042            std::get_if<Fortran::parser::AccClause::Collapse>(&clause.u)) {5043      const Fortran::parser::AccCollapseArg &arg = collapseClause->v;5044      force = std::get<bool>(arg.t);5045      const auto &collapseValue =5046          std::get<Fortran::parser::ScalarIntConstantExpr>(arg.t);5047      size = *Fortran::semantics::GetIntValue(collapseValue);5048      break;5049    }5050  }5051  return {size, force};5052}5053 5054/// Create an ACC loop operation for a DO construct when inside ACC compute5055/// constructs This serves as a bridge between regular DO construct handling and5056/// ACC loop creation5057mlir::Operation *Fortran::lower::genOpenACCLoopFromDoConstruct(5058    AbstractConverter &converter,5059    Fortran::semantics::SemanticsContext &semanticsContext,5060    Fortran::lower::SymMap &localSymbols,5061    const Fortran::parser::DoConstruct &doConstruct, pft::Evaluation &eval) {5062  if (!lowerDoLoopToAccLoop)5063    return nullptr;5064 5065  // Only convert loops which have induction variables that need privatized.5066  if (!doConstruct.IsDoNormal() && !doConstruct.IsDoConcurrent())5067    return nullptr;5068 5069  // If the evaluation is unstructured, then we cannot convert the loop5070  // because acc loop does not have an unstructured form.5071  // TODO: There may be other strategies that can be employed such5072  // as generating acc.private for the loop variables without attaching5073  // them to acc.loop.5074  // For now - generate a not-yet-implemented message because without5075  // privatizing the induction variable, the loop may not execute correctly.5076  // Only do this for `acc kernels` because in `acc parallel`, scalars end5077  // up as implicitly firstprivate.5078  if (eval.lowerAsUnstructured()) {5079    if (mlir::isa_and_present<mlir::acc::KernelsOp>(5080            mlir::acc::getEnclosingComputeOp(5081                converter.getFirOpBuilder().getRegion())))5082      TODO(converter.getCurrentLocation(),5083           "unstructured do loop in acc kernels");5084    return nullptr;5085  }5086 5087  // Prepare empty operand vectors since there are no associated `acc loop`5088  // clauses with the Fortran do loops being handled here.5089  llvm::SmallVector<mlir::Value> privateOperands, gangOperands,5090      workerNumOperands, vectorOperands, tileOperands, cacheOperands,5091      reductionOperands;5092  llvm::SmallVector<mlir::Type> retTy;5093  llvm::SmallVector<std::pair<mlir::Value, Fortran::semantics::SymbolRef>>5094      dataOperandSymbolPairs;5095  mlir::Value yieldValue;5096  uint64_t loopsToProcess = 1; // Single loop construct5097 5098  // Use same mechanism that handles `acc loop` contained do loops to handle5099  // the implicit loop case.5100  Fortran::lower::StatementContext stmtCtx;5101  auto loopOp = buildACCLoopOp(5102      converter, converter.getCurrentLocation(), semanticsContext, stmtCtx,5103      doConstruct, eval, privateOperands, dataOperandSymbolPairs, gangOperands,5104      workerNumOperands, vectorOperands, tileOperands, cacheOperands,5105      reductionOperands, retTy, yieldValue, loopsToProcess);5106 5107  // Normal do loops which are not annotated with `acc loop` should be5108  // left for analysis by marking with `auto`. This is the case even in the case5109  // of `acc parallel` region because the normal rules of applying `independent`5110  // is only for loops marked with `acc loop`.5111  // For do concurrent loops, the spec says in section 2.17.2:5112  // "When do concurrent appears without a loop construct in a kernels construct5113  // it is treated as if it is annotated with loop auto. If it appears in a5114  // parallel construct or an accelerator routine then it is treated as if it is5115  // annotated with loop independent."5116  // So this means that in all cases we mark with `auto` unless it is a5117  // `do concurrent` in an `acc parallel` construct or it must be `seq` because5118  // it is in an `acc serial` construct.5119  fir::FirOpBuilder &builder = converter.getFirOpBuilder();5120  mlir::Operation *accRegionOp =5121      mlir::acc::getEnclosingComputeOp(builder.getRegion());5122  mlir::acc::LoopParMode parMode =5123      mlir::isa_and_present<mlir::acc::ParallelOp>(accRegionOp) &&5124              doConstruct.IsDoConcurrent()5125          ? mlir::acc::LoopParMode::loop_independent5126      : mlir::isa_and_present<mlir::acc::SerialOp>(accRegionOp)5127          ? mlir::acc::LoopParMode::loop_seq5128          : mlir::acc::LoopParMode::loop_auto;5129 5130  // Set the parallel mode based on the computed parMode5131  auto deviceNoneAttr = mlir::acc::DeviceTypeAttr::get(5132      builder.getContext(), mlir::acc::DeviceType::None);5133  auto arrOfDeviceNone =5134      mlir::ArrayAttr::get(builder.getContext(), deviceNoneAttr);5135  if (parMode == mlir::acc::LoopParMode::loop_independent) {5136    loopOp.setIndependentAttr(arrOfDeviceNone);5137  } else if (parMode == mlir::acc::LoopParMode::loop_seq) {5138    loopOp.setSeqAttr(arrOfDeviceNone);5139  } else if (parMode == mlir::acc::LoopParMode::loop_auto) {5140    loopOp.setAuto_Attr(arrOfDeviceNone);5141  } else {5142    llvm_unreachable("Unexpected loop par mode");5143  }5144 5145  return loopOp;5146}5147