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

source code of flang/lib/Lower/OpenACC.cpp