1 //===-- OpenMP.cpp -- Open MP 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/OpenMP.h"
14 #include "flang/Common/idioms.h"
15 #include "flang/Lower/Bridge.h"
16 #include "flang/Lower/ConvertExpr.h"
17 #include "flang/Lower/PFTBuilder.h"
18 #include "flang/Lower/StatementContext.h"
19 #include "flang/Optimizer/Builder/BoxValue.h"
20 #include "flang/Optimizer/Builder/FIRBuilder.h"
21 #include "flang/Optimizer/Builder/Todo.h"
22 #include "flang/Parser/parse-tree.h"
23 #include "flang/Semantics/tools.h"
24 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
25 #include "llvm/Frontend/OpenMP/OMPConstants.h"
26 
27 using namespace mlir;
28 
29 int64_t Fortran::lower::getCollapseValue(
30     const Fortran::parser::OmpClauseList &clauseList) {
31   for (const auto &clause : clauseList.v) {
32     if (const auto &collapseClause =
33             std::get_if<Fortran::parser::OmpClause::Collapse>(&clause.u)) {
34       const auto *expr = Fortran::semantics::GetExpr(collapseClause->v);
35       return Fortran::evaluate::ToInt64(*expr).value();
36     }
37   }
38   return 1;
39 }
40 
41 static const Fortran::parser::Name *
42 getDesignatorNameIfDataRef(const Fortran::parser::Designator &designator) {
43   const auto *dataRef = std::get_if<Fortran::parser::DataRef>(&designator.u);
44   return dataRef ? std::get_if<Fortran::parser::Name>(&dataRef->u) : nullptr;
45 }
46 
47 static Fortran::semantics::Symbol *
48 getOmpObjectSymbol(const Fortran::parser::OmpObject &ompObject) {
49   Fortran::semantics::Symbol *sym = nullptr;
50   std::visit(Fortran::common::visitors{
51                  [&](const Fortran::parser::Designator &designator) {
52                    if (const Fortran::parser::Name *name =
53                            getDesignatorNameIfDataRef(designator)) {
54                      sym = name->symbol;
55                    }
56                  },
57                  [&](const Fortran::parser::Name &name) { sym = name.symbol; }},
58              ompObject.u);
59   return sym;
60 }
61 
62 template <typename T>
63 static void createPrivateVarSyms(Fortran::lower::AbstractConverter &converter,
64                                  const T *clause) {
65   const Fortran::parser::OmpObjectList &ompObjectList = clause->v;
66   for (const Fortran::parser::OmpObject &ompObject : ompObjectList.v) {
67     Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject);
68     // Privatization for symbols which are pre-determined (like loop index
69     // variables) happen separately, for everything else privatize here.
70     if (sym->test(Fortran::semantics::Symbol::Flag::OmpPreDetermined))
71       continue;
72     if constexpr (std::is_same_v<T, Fortran::parser::OmpClause::Firstprivate>) {
73       converter.copyHostAssociateVar(*sym);
74     } else {
75       bool success = converter.createHostAssociateVarClone(*sym);
76       (void)success;
77       assert(success && "Privatization failed due to existing binding");
78     }
79   }
80 }
81 
82 static void privatizeVars(Fortran::lower::AbstractConverter &converter,
83                           const Fortran::parser::OmpClauseList &opClauseList) {
84   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
85   auto insPt = firOpBuilder.saveInsertionPoint();
86   firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
87   bool hasFirstPrivateOp = false;
88   for (const Fortran::parser::OmpClause &clause : opClauseList.v) {
89     if (const auto &privateClause =
90             std::get_if<Fortran::parser::OmpClause::Private>(&clause.u)) {
91       createPrivateVarSyms(converter, privateClause);
92     } else if (const auto &firstPrivateClause =
93                    std::get_if<Fortran::parser::OmpClause::Firstprivate>(
94                        &clause.u)) {
95       createPrivateVarSyms(converter, firstPrivateClause);
96       hasFirstPrivateOp = true;
97     }
98   }
99   if (hasFirstPrivateOp)
100     firOpBuilder.create<mlir::omp::BarrierOp>(converter.getCurrentLocation());
101   firOpBuilder.restoreInsertionPoint(insPt);
102 }
103 
104 /// The COMMON block is a global structure. \p commonValue is the base address
105 /// of the the COMMON block. As the offset from the symbol \p sym, generate the
106 /// COMMON block member value (commonValue + offset) for the symbol.
107 /// FIXME: Share the code with `instantiateCommon` in ConvertVariable.cpp.
108 static mlir::Value
109 genCommonBlockMember(Fortran::lower::AbstractConverter &converter,
110                      const Fortran::semantics::Symbol &sym,
111                      mlir::Value commonValue) {
112   auto &firOpBuilder = converter.getFirOpBuilder();
113   mlir::Location currentLocation = converter.getCurrentLocation();
114   mlir::IntegerType i8Ty = firOpBuilder.getIntegerType(8);
115   mlir::Type i8Ptr = firOpBuilder.getRefType(i8Ty);
116   mlir::Type seqTy = firOpBuilder.getRefType(firOpBuilder.getVarLenSeqTy(i8Ty));
117   mlir::Value base =
118       firOpBuilder.createConvert(currentLocation, seqTy, commonValue);
119   std::size_t byteOffset = sym.GetUltimate().offset();
120   mlir::Value offs = firOpBuilder.createIntegerConstant(
121       currentLocation, firOpBuilder.getIndexType(), byteOffset);
122   mlir::Value varAddr = firOpBuilder.create<fir::CoordinateOp>(
123       currentLocation, i8Ptr, base, mlir::ValueRange{offs});
124   mlir::Type symType = converter.genType(sym);
125   return firOpBuilder.createConvert(currentLocation,
126                                     firOpBuilder.getRefType(symType), varAddr);
127 }
128 
129 // Get the extended value for \p val by extracting additional variable
130 // information from \p base.
131 static fir::ExtendedValue getExtendedValue(fir::ExtendedValue base,
132                                            mlir::Value val) {
133   return base.match(
134       [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
135         return fir::MutableBoxValue(val, box.nonDeferredLenParams(), {});
136       },
137       [&](const auto &) -> fir::ExtendedValue {
138         return fir::substBase(base, val);
139       });
140 }
141 
142 static void threadPrivatizeVars(Fortran::lower::AbstractConverter &converter,
143                                 Fortran::lower::pft::Evaluation &eval) {
144   auto &firOpBuilder = converter.getFirOpBuilder();
145   mlir::Location currentLocation = converter.getCurrentLocation();
146   auto insPt = firOpBuilder.saveInsertionPoint();
147   firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
148 
149   // Get the original ThreadprivateOp corresponding to the symbol and use the
150   // symbol value from that opeartion to create one ThreadprivateOp copy
151   // operation inside the parallel region.
152   auto genThreadprivateOp = [&](Fortran::lower::SymbolRef sym) -> mlir::Value {
153     mlir::Value symOriThreadprivateValue = converter.getSymbolAddress(sym);
154     mlir::Operation *op = symOriThreadprivateValue.getDefiningOp();
155     assert(mlir::isa<mlir::omp::ThreadprivateOp>(op) &&
156            "The threadprivate operation not created");
157     mlir::Value symValue =
158         mlir::dyn_cast<mlir::omp::ThreadprivateOp>(op).sym_addr();
159     return firOpBuilder.create<mlir::omp::ThreadprivateOp>(
160         currentLocation, symValue.getType(), symValue);
161   };
162 
163   llvm::SetVector<const Fortran::semantics::Symbol *> threadprivateSyms;
164   converter.collectSymbolSet(
165       eval, threadprivateSyms,
166       Fortran::semantics::Symbol::Flag::OmpThreadprivate);
167 
168   // For a COMMON block, the ThreadprivateOp is generated for itself instead of
169   // its members, so only bind the value of the new copied ThreadprivateOp
170   // inside the parallel region to the common block symbol only once for
171   // multiple members in one COMMON block.
172   llvm::SetVector<const Fortran::semantics::Symbol *> commonSyms;
173   for (std::size_t i = 0; i < threadprivateSyms.size(); i++) {
174     auto sym = threadprivateSyms[i];
175     mlir::Value symThreadprivateValue;
176     if (const Fortran::semantics::Symbol *common =
177             Fortran::semantics::FindCommonBlockContaining(sym->GetUltimate())) {
178       mlir::Value commonThreadprivateValue;
179       if (commonSyms.contains(common)) {
180         commonThreadprivateValue = converter.getSymbolAddress(*common);
181       } else {
182         commonThreadprivateValue = genThreadprivateOp(*common);
183         converter.bindSymbol(*common, commonThreadprivateValue);
184         commonSyms.insert(common);
185       }
186       symThreadprivateValue =
187           genCommonBlockMember(converter, *sym, commonThreadprivateValue);
188     } else {
189       symThreadprivateValue = genThreadprivateOp(*sym);
190     }
191 
192     fir::ExtendedValue sexv = converter.getSymbolExtendedValue(*sym);
193     fir::ExtendedValue symThreadprivateExv =
194         getExtendedValue(sexv, symThreadprivateValue);
195     converter.bindSymbol(*sym, symThreadprivateExv);
196   }
197 
198   firOpBuilder.restoreInsertionPoint(insPt);
199 }
200 
201 static void genObjectList(const Fortran::parser::OmpObjectList &objectList,
202                           Fortran::lower::AbstractConverter &converter,
203                           llvm::SmallVectorImpl<Value> &operands) {
204   auto addOperands = [&](Fortran::lower::SymbolRef sym) {
205     const mlir::Value variable = converter.getSymbolAddress(sym);
206     if (variable) {
207       operands.push_back(variable);
208     } else {
209       if (const auto *details =
210               sym->detailsIf<Fortran::semantics::HostAssocDetails>()) {
211         operands.push_back(converter.getSymbolAddress(details->symbol()));
212         converter.copySymbolBinding(details->symbol(), sym);
213       }
214     }
215   };
216   for (const Fortran::parser::OmpObject &ompObject : objectList.v) {
217     Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject);
218     addOperands(*sym);
219   }
220 }
221 
222 static mlir::Type getLoopVarType(Fortran::lower::AbstractConverter &converter,
223                                  std::size_t loopVarTypeSize) {
224   // OpenMP runtime requires 32-bit or 64-bit loop variables.
225   loopVarTypeSize = loopVarTypeSize * 8;
226   if (loopVarTypeSize < 32) {
227     loopVarTypeSize = 32;
228   } else if (loopVarTypeSize > 64) {
229     loopVarTypeSize = 64;
230     mlir::emitWarning(converter.getCurrentLocation(),
231                       "OpenMP loop iteration variable cannot have more than 64 "
232                       "bits size and will be narrowed into 64 bits.");
233   }
234   assert((loopVarTypeSize == 32 || loopVarTypeSize == 64) &&
235          "OpenMP loop iteration variable size must be transformed into 32-bit "
236          "or 64-bit");
237   return converter.getFirOpBuilder().getIntegerType(loopVarTypeSize);
238 }
239 
240 /// Create empty blocks for the current region.
241 /// These blocks replace blocks parented to an enclosing region.
242 void createEmptyRegionBlocks(
243     fir::FirOpBuilder &firOpBuilder,
244     std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
245   auto *region = &firOpBuilder.getRegion();
246   for (auto &eval : evaluationList) {
247     if (eval.block) {
248       if (eval.block->empty()) {
249         eval.block->erase();
250         eval.block = firOpBuilder.createBlock(region);
251       } else {
252         [[maybe_unused]] auto &terminatorOp = eval.block->back();
253         assert((mlir::isa<mlir::omp::TerminatorOp>(terminatorOp) ||
254                 mlir::isa<mlir::omp::YieldOp>(terminatorOp)) &&
255                "expected terminator op");
256       }
257     }
258     if (!eval.isDirective() && eval.hasNestedEvaluations())
259       createEmptyRegionBlocks(firOpBuilder, eval.getNestedEvaluations());
260   }
261 }
262 
263 /// Create the body (block) for an OpenMP Operation.
264 ///
265 /// \param [in]    op - the operation the body belongs to.
266 /// \param [inout] converter - converter to use for the clauses.
267 /// \param [in]    loc - location in source code.
268 /// \param [in]    eval - current PFT node/evaluation.
269 /// \oaran [in]    clauses - list of clauses to process.
270 /// \param [in]    args - block arguments (induction variable[s]) for the
271 ////                      region.
272 /// \param [in]    outerCombined - is this an outer operation - prevents
273 ///                                privatization.
274 template <typename Op>
275 static void
276 createBodyOfOp(Op &op, Fortran::lower::AbstractConverter &converter,
277                mlir::Location &loc, Fortran::lower::pft::Evaluation &eval,
278                const Fortran::parser::OmpClauseList *clauses = nullptr,
279                const SmallVector<const Fortran::semantics::Symbol *> &args = {},
280                bool outerCombined = false) {
281   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
282   // If an argument for the region is provided then create the block with that
283   // argument. Also update the symbol's address with the mlir argument value.
284   // e.g. For loops the argument is the induction variable. And all further
285   // uses of the induction variable should use this mlir value.
286   mlir::Operation *storeOp = nullptr;
287   if (args.size()) {
288     std::size_t loopVarTypeSize = 0;
289     for (const Fortran::semantics::Symbol *arg : args)
290       loopVarTypeSize = std::max(loopVarTypeSize, arg->GetUltimate().size());
291     mlir::Type loopVarType = getLoopVarType(converter, loopVarTypeSize);
292     SmallVector<Type> tiv;
293     SmallVector<Location> locs;
294     for (int i = 0; i < (int)args.size(); i++) {
295       tiv.push_back(loopVarType);
296       locs.push_back(loc);
297     }
298     firOpBuilder.createBlock(&op.getRegion(), {}, tiv, locs);
299     int argIndex = 0;
300     // The argument is not currently in memory, so make a temporary for the
301     // argument, and store it there, then bind that location to the argument.
302     for (const Fortran::semantics::Symbol *arg : args) {
303       mlir::Value val =
304           fir::getBase(op.getRegion().front().getArgument(argIndex));
305       mlir::Value temp = firOpBuilder.createTemporary(
306           loc, loopVarType,
307           llvm::ArrayRef<mlir::NamedAttribute>{
308               Fortran::lower::getAdaptToByRefAttr(firOpBuilder)});
309       storeOp = firOpBuilder.create<fir::StoreOp>(loc, val, temp);
310       converter.bindSymbol(*arg, temp);
311       argIndex++;
312     }
313   } else {
314     firOpBuilder.createBlock(&op.getRegion());
315   }
316   // Set the insert for the terminator operation to go at the end of the
317   // block - this is either empty or the block with the stores above,
318   // the end of the block works for both.
319   mlir::Block &block = op.getRegion().back();
320   firOpBuilder.setInsertionPointToEnd(&block);
321 
322   // If it is an unstructured region and is not the outer region of a combined
323   // construct, create empty blocks for all evaluations.
324   if (eval.lowerAsUnstructured() && !outerCombined)
325     createEmptyRegionBlocks(firOpBuilder, eval.getNestedEvaluations());
326 
327   // Insert the terminator.
328   if constexpr (std::is_same_v<Op, omp::WsLoopOp> ||
329                 std::is_same_v<Op, omp::SimdLoopOp>) {
330     mlir::ValueRange results;
331     firOpBuilder.create<mlir::omp::YieldOp>(loc, results);
332   } else {
333     firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
334   }
335 
336   // Reset the insert point to before the terminator.
337   if (storeOp)
338     firOpBuilder.setInsertionPointAfter(storeOp);
339   else
340     firOpBuilder.setInsertionPointToStart(&block);
341 
342   // Handle privatization. Do not privatize if this is the outer operation.
343   if (clauses && !outerCombined)
344     privatizeVars(converter, *clauses);
345 
346   if (std::is_same_v<Op, omp::ParallelOp>)
347     threadPrivatizeVars(converter, eval);
348 }
349 
350 static void genOMP(Fortran::lower::AbstractConverter &converter,
351                    Fortran::lower::pft::Evaluation &eval,
352                    const Fortran::parser::OpenMPSimpleStandaloneConstruct
353                        &simpleStandaloneConstruct) {
354   const auto &directive =
355       std::get<Fortran::parser::OmpSimpleStandaloneDirective>(
356           simpleStandaloneConstruct.t);
357   switch (directive.v) {
358   default:
359     break;
360   case llvm::omp::Directive::OMPD_barrier:
361     converter.getFirOpBuilder().create<mlir::omp::BarrierOp>(
362         converter.getCurrentLocation());
363     break;
364   case llvm::omp::Directive::OMPD_taskwait:
365     converter.getFirOpBuilder().create<mlir::omp::TaskwaitOp>(
366         converter.getCurrentLocation());
367     break;
368   case llvm::omp::Directive::OMPD_taskyield:
369     converter.getFirOpBuilder().create<mlir::omp::TaskyieldOp>(
370         converter.getCurrentLocation());
371     break;
372   case llvm::omp::Directive::OMPD_target_enter_data:
373     TODO(converter.getCurrentLocation(), "OMPD_target_enter_data");
374   case llvm::omp::Directive::OMPD_target_exit_data:
375     TODO(converter.getCurrentLocation(), "OMPD_target_exit_data");
376   case llvm::omp::Directive::OMPD_target_update:
377     TODO(converter.getCurrentLocation(), "OMPD_target_update");
378   case llvm::omp::Directive::OMPD_ordered:
379     TODO(converter.getCurrentLocation(), "OMPD_ordered");
380   }
381 }
382 
383 static void
384 genAllocateClause(Fortran::lower::AbstractConverter &converter,
385                   const Fortran::parser::OmpAllocateClause &ompAllocateClause,
386                   SmallVector<Value> &allocatorOperands,
387                   SmallVector<Value> &allocateOperands) {
388   auto &firOpBuilder = converter.getFirOpBuilder();
389   auto currentLocation = converter.getCurrentLocation();
390   Fortran::lower::StatementContext stmtCtx;
391 
392   mlir::Value allocatorOperand;
393   const Fortran::parser::OmpObjectList &ompObjectList =
394       std::get<Fortran::parser::OmpObjectList>(ompAllocateClause.t);
395   const auto &allocatorValue =
396       std::get<std::optional<Fortran::parser::OmpAllocateClause::Allocator>>(
397           ompAllocateClause.t);
398   // Check if allocate clause has allocator specified. If so, add it
399   // to list of allocators, otherwise, add default allocator to
400   // list of allocators.
401   if (allocatorValue) {
402     allocatorOperand = fir::getBase(converter.genExprValue(
403         *Fortran::semantics::GetExpr(allocatorValue->v), stmtCtx));
404     allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(),
405                              allocatorOperand);
406   } else {
407     allocatorOperand = firOpBuilder.createIntegerConstant(
408         currentLocation, firOpBuilder.getI32Type(), 1);
409     allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(),
410                              allocatorOperand);
411   }
412   genObjectList(ompObjectList, converter, allocateOperands);
413 }
414 
415 static void
416 genOMP(Fortran::lower::AbstractConverter &converter,
417        Fortran::lower::pft::Evaluation &eval,
418        const Fortran::parser::OpenMPStandaloneConstruct &standaloneConstruct) {
419   std::visit(
420       Fortran::common::visitors{
421           [&](const Fortran::parser::OpenMPSimpleStandaloneConstruct
422                   &simpleStandaloneConstruct) {
423             genOMP(converter, eval, simpleStandaloneConstruct);
424           },
425           [&](const Fortran::parser::OpenMPFlushConstruct &flushConstruct) {
426             SmallVector<Value, 4> operandRange;
427             if (const auto &ompObjectList =
428                     std::get<std::optional<Fortran::parser::OmpObjectList>>(
429                         flushConstruct.t))
430               genObjectList(*ompObjectList, converter, operandRange);
431             const auto &memOrderClause = std::get<std::optional<
432                 std::list<Fortran::parser::OmpMemoryOrderClause>>>(
433                 flushConstruct.t);
434             if (memOrderClause.has_value() && memOrderClause->size() > 0)
435               TODO(converter.getCurrentLocation(),
436                    "Handle OmpMemoryOrderClause");
437             converter.getFirOpBuilder().create<mlir::omp::FlushOp>(
438                 converter.getCurrentLocation(), operandRange);
439           },
440           [&](const Fortran::parser::OpenMPCancelConstruct &cancelConstruct) {
441             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
442           },
443           [&](const Fortran::parser::OpenMPCancellationPointConstruct
444                   &cancellationPointConstruct) {
445             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
446           },
447       },
448       standaloneConstruct.u);
449 }
450 
451 static omp::ClauseProcBindKindAttr genProcBindKindAttr(
452     fir::FirOpBuilder &firOpBuilder,
453     const Fortran::parser::OmpClause::ProcBind *procBindClause) {
454   omp::ClauseProcBindKind pbKind;
455   switch (procBindClause->v.v) {
456   case Fortran::parser::OmpProcBindClause::Type::Master:
457     pbKind = omp::ClauseProcBindKind::Master;
458     break;
459   case Fortran::parser::OmpProcBindClause::Type::Close:
460     pbKind = omp::ClauseProcBindKind::Close;
461     break;
462   case Fortran::parser::OmpProcBindClause::Type::Spread:
463     pbKind = omp::ClauseProcBindKind::Spread;
464     break;
465   case Fortran::parser::OmpProcBindClause::Type::Primary:
466     pbKind = omp::ClauseProcBindKind::Primary;
467     break;
468   }
469   return omp::ClauseProcBindKindAttr::get(firOpBuilder.getContext(), pbKind);
470 }
471 
472 /* When parallel is used in a combined construct, then use this function to
473  * create the parallel operation. It handles the parallel specific clauses
474  * and leaves the rest for handling at the inner operations.
475  * TODO: Refactor clause handling
476  */
477 template <typename Directive>
478 static void
479 createCombinedParallelOp(Fortran::lower::AbstractConverter &converter,
480                          Fortran::lower::pft::Evaluation &eval,
481                          const Directive &directive) {
482   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
483   mlir::Location currentLocation = converter.getCurrentLocation();
484   Fortran::lower::StatementContext stmtCtx;
485   llvm::ArrayRef<mlir::Type> argTy;
486   mlir::Value ifClauseOperand, numThreadsClauseOperand;
487   SmallVector<Value> allocatorOperands, allocateOperands;
488   mlir::omp::ClauseProcBindKindAttr procBindKindAttr;
489   const auto &opClauseList =
490       std::get<Fortran::parser::OmpClauseList>(directive.t);
491   // TODO: Handle the following clauses
492   // 1. default
493   // 2. copyin
494   // Note: rest of the clauses are handled when the inner operation is created
495   for (const Fortran::parser::OmpClause &clause : opClauseList.v) {
496     if (const auto &ifClause =
497             std::get_if<Fortran::parser::OmpClause::If>(&clause.u)) {
498       auto &expr = std::get<Fortran::parser::ScalarLogicalExpr>(ifClause->v.t);
499       mlir::Value ifVal = fir::getBase(
500           converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
501       ifClauseOperand = firOpBuilder.createConvert(
502           currentLocation, firOpBuilder.getI1Type(), ifVal);
503     } else if (const auto &numThreadsClause =
504                    std::get_if<Fortran::parser::OmpClause::NumThreads>(
505                        &clause.u)) {
506       numThreadsClauseOperand = fir::getBase(converter.genExprValue(
507           *Fortran::semantics::GetExpr(numThreadsClause->v), stmtCtx));
508     } else if (const auto &procBindClause =
509                    std::get_if<Fortran::parser::OmpClause::ProcBind>(
510                        &clause.u)) {
511       procBindKindAttr = genProcBindKindAttr(firOpBuilder, procBindClause);
512     }
513   }
514   // Create and insert the operation.
515   auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
516       currentLocation, argTy, ifClauseOperand, numThreadsClauseOperand,
517       allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(),
518       /*reductions=*/nullptr, procBindKindAttr);
519 
520   createBodyOfOp<omp::ParallelOp>(parallelOp, converter, currentLocation, eval,
521                                   &opClauseList, /*iv=*/{},
522                                   /*isCombined=*/true);
523 }
524 
525 static void
526 genOMP(Fortran::lower::AbstractConverter &converter,
527        Fortran::lower::pft::Evaluation &eval,
528        const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
529   const auto &beginBlockDirective =
530       std::get<Fortran::parser::OmpBeginBlockDirective>(blockConstruct.t);
531   const auto &blockDirective =
532       std::get<Fortran::parser::OmpBlockDirective>(beginBlockDirective.t);
533   const auto &endBlockDirective =
534       std::get<Fortran::parser::OmpEndBlockDirective>(blockConstruct.t);
535   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
536   mlir::Location currentLocation = converter.getCurrentLocation();
537 
538   Fortran::lower::StatementContext stmtCtx;
539   llvm::ArrayRef<mlir::Type> argTy;
540   mlir::Value ifClauseOperand, numThreadsClauseOperand, finalClauseOperand,
541       priorityClauseOperand;
542   mlir::omp::ClauseProcBindKindAttr procBindKindAttr;
543   SmallVector<Value> allocateOperands, allocatorOperands;
544   mlir::UnitAttr nowaitAttr, untiedAttr, mergeableAttr;
545 
546   const auto &opClauseList =
547       std::get<Fortran::parser::OmpClauseList>(beginBlockDirective.t);
548   for (const auto &clause : opClauseList.v) {
549     if (const auto &ifClause =
550             std::get_if<Fortran::parser::OmpClause::If>(&clause.u)) {
551       auto &expr = std::get<Fortran::parser::ScalarLogicalExpr>(ifClause->v.t);
552       mlir::Value ifVal = fir::getBase(
553           converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
554       ifClauseOperand = firOpBuilder.createConvert(
555           currentLocation, firOpBuilder.getI1Type(), ifVal);
556     } else if (const auto &numThreadsClause =
557                    std::get_if<Fortran::parser::OmpClause::NumThreads>(
558                        &clause.u)) {
559       // OMPIRBuilder expects `NUM_THREAD` clause as a `Value`.
560       numThreadsClauseOperand = fir::getBase(converter.genExprValue(
561           *Fortran::semantics::GetExpr(numThreadsClause->v), stmtCtx));
562     } else if (const auto &procBindClause =
563                    std::get_if<Fortran::parser::OmpClause::ProcBind>(
564                        &clause.u)) {
565       procBindKindAttr = genProcBindKindAttr(firOpBuilder, procBindClause);
566     } else if (const auto &allocateClause =
567                    std::get_if<Fortran::parser::OmpClause::Allocate>(
568                        &clause.u)) {
569       genAllocateClause(converter, allocateClause->v, allocatorOperands,
570                         allocateOperands);
571     } else if (std::get_if<Fortran::parser::OmpClause::Private>(&clause.u) ||
572                std::get_if<Fortran::parser::OmpClause::Firstprivate>(
573                    &clause.u)) {
574       // Privatisation clauses are handled elsewhere.
575       continue;
576     } else if (std::get_if<Fortran::parser::OmpClause::Threads>(&clause.u)) {
577       // Nothing needs to be done for threads clause.
578       continue;
579     } else if (const auto &finalClause =
580                    std::get_if<Fortran::parser::OmpClause::Final>(&clause.u)) {
581       mlir::Value finalVal = fir::getBase(converter.genExprValue(
582           *Fortran::semantics::GetExpr(finalClause->v), stmtCtx));
583       finalClauseOperand = firOpBuilder.createConvert(
584           currentLocation, firOpBuilder.getI1Type(), finalVal);
585     } else if (std::get_if<Fortran::parser::OmpClause::Untied>(&clause.u)) {
586       untiedAttr = firOpBuilder.getUnitAttr();
587     } else if (std::get_if<Fortran::parser::OmpClause::Mergeable>(&clause.u)) {
588       mergeableAttr = firOpBuilder.getUnitAttr();
589     } else if (const auto &priorityClause =
590                    std::get_if<Fortran::parser::OmpClause::Priority>(
591                        &clause.u)) {
592       priorityClauseOperand = fir::getBase(converter.genExprValue(
593           *Fortran::semantics::GetExpr(priorityClause->v), stmtCtx));
594     } else {
595       TODO(currentLocation, "OpenMP Block construct clauses");
596     }
597   }
598 
599   for (const auto &clause :
600        std::get<Fortran::parser::OmpClauseList>(endBlockDirective.t).v) {
601     if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u))
602       nowaitAttr = firOpBuilder.getUnitAttr();
603   }
604 
605   if (blockDirective.v == llvm::omp::OMPD_parallel) {
606     // Create and insert the operation.
607     auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
608         currentLocation, argTy, ifClauseOperand, numThreadsClauseOperand,
609         allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(),
610         /*reductions=*/nullptr, procBindKindAttr);
611     createBodyOfOp<omp::ParallelOp>(parallelOp, converter, currentLocation,
612                                     eval, &opClauseList);
613   } else if (blockDirective.v == llvm::omp::OMPD_master) {
614     auto masterOp =
615         firOpBuilder.create<mlir::omp::MasterOp>(currentLocation, argTy);
616     createBodyOfOp<omp::MasterOp>(masterOp, converter, currentLocation, eval);
617   } else if (blockDirective.v == llvm::omp::OMPD_single) {
618     auto singleOp = firOpBuilder.create<mlir::omp::SingleOp>(
619         currentLocation, allocateOperands, allocatorOperands, nowaitAttr);
620     createBodyOfOp<omp::SingleOp>(singleOp, converter, currentLocation, eval);
621   } else if (blockDirective.v == llvm::omp::OMPD_ordered) {
622     auto orderedOp = firOpBuilder.create<mlir::omp::OrderedRegionOp>(
623         currentLocation, /*simd=*/nullptr);
624     createBodyOfOp<omp::OrderedRegionOp>(orderedOp, converter, currentLocation,
625                                          eval);
626   } else if (blockDirective.v == llvm::omp::OMPD_task) {
627     auto taskOp = firOpBuilder.create<mlir::omp::TaskOp>(
628         currentLocation, ifClauseOperand, finalClauseOperand, untiedAttr,
629         mergeableAttr, /*in_reduction_vars=*/ValueRange(),
630         /*in_reductions=*/nullptr, priorityClauseOperand, allocateOperands,
631         allocatorOperands);
632     createBodyOfOp(taskOp, converter, currentLocation, eval, &opClauseList);
633   } else {
634     TODO(converter.getCurrentLocation(), "Unhandled block directive");
635   }
636 }
637 
638 static mlir::omp::ScheduleModifier
639 translateModifier(const Fortran::parser::OmpScheduleModifierType &m) {
640   switch (m.v) {
641   case Fortran::parser::OmpScheduleModifierType::ModType::Monotonic:
642     return mlir::omp::ScheduleModifier::monotonic;
643   case Fortran::parser::OmpScheduleModifierType::ModType::Nonmonotonic:
644     return mlir::omp::ScheduleModifier::nonmonotonic;
645   case Fortran::parser::OmpScheduleModifierType::ModType::Simd:
646     return mlir::omp::ScheduleModifier::simd;
647   }
648   return mlir::omp::ScheduleModifier::none;
649 }
650 
651 static mlir::omp::ScheduleModifier
652 getScheduleModifier(const Fortran::parser::OmpScheduleClause &x) {
653   const auto &modifier =
654       std::get<std::optional<Fortran::parser::OmpScheduleModifier>>(x.t);
655   // The input may have the modifier any order, so we look for one that isn't
656   // SIMD. If modifier is not set at all, fall down to the bottom and return
657   // "none".
658   if (modifier) {
659     const auto &modType1 =
660         std::get<Fortran::parser::OmpScheduleModifier::Modifier1>(modifier->t);
661     if (modType1.v.v ==
662         Fortran::parser::OmpScheduleModifierType::ModType::Simd) {
663       const auto &modType2 = std::get<
664           std::optional<Fortran::parser::OmpScheduleModifier::Modifier2>>(
665           modifier->t);
666       if (modType2 &&
667           modType2->v.v !=
668               Fortran::parser::OmpScheduleModifierType::ModType::Simd)
669         return translateModifier(modType2->v);
670 
671       return mlir::omp::ScheduleModifier::none;
672     }
673 
674     return translateModifier(modType1.v);
675   }
676   return mlir::omp::ScheduleModifier::none;
677 }
678 
679 static mlir::omp::ScheduleModifier
680 getSIMDModifier(const Fortran::parser::OmpScheduleClause &x) {
681   const auto &modifier =
682       std::get<std::optional<Fortran::parser::OmpScheduleModifier>>(x.t);
683   // Either of the two possible modifiers in the input can be the SIMD modifier,
684   // so look in either one, and return simd if we find one. Not found = return
685   // "none".
686   if (modifier) {
687     const auto &modType1 =
688         std::get<Fortran::parser::OmpScheduleModifier::Modifier1>(modifier->t);
689     if (modType1.v.v == Fortran::parser::OmpScheduleModifierType::ModType::Simd)
690       return mlir::omp::ScheduleModifier::simd;
691 
692     const auto &modType2 = std::get<
693         std::optional<Fortran::parser::OmpScheduleModifier::Modifier2>>(
694         modifier->t);
695     if (modType2 && modType2->v.v ==
696                         Fortran::parser::OmpScheduleModifierType::ModType::Simd)
697       return mlir::omp::ScheduleModifier::simd;
698   }
699   return mlir::omp::ScheduleModifier::none;
700 }
701 
702 static void genOMP(Fortran::lower::AbstractConverter &converter,
703                    Fortran::lower::pft::Evaluation &eval,
704                    const Fortran::parser::OpenMPLoopConstruct &loopConstruct) {
705 
706   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
707   mlir::Location currentLocation = converter.getCurrentLocation();
708   llvm::SmallVector<mlir::Value> lowerBound, upperBound, step, linearVars,
709       linearStepVars, reductionVars;
710   mlir::Value scheduleChunkClauseOperand;
711   mlir::Attribute scheduleClauseOperand, collapseClauseOperand,
712       noWaitClauseOperand, orderedClauseOperand, orderClauseOperand;
713   const auto &loopOpClauseList = std::get<Fortran::parser::OmpClauseList>(
714       std::get<Fortran::parser::OmpBeginLoopDirective>(loopConstruct.t).t);
715 
716   const auto ompDirective =
717       std::get<Fortran::parser::OmpLoopDirective>(
718           std::get<Fortran::parser::OmpBeginLoopDirective>(loopConstruct.t).t)
719           .v;
720   if (llvm::omp::OMPD_parallel_do == ompDirective) {
721     createCombinedParallelOp<Fortran::parser::OmpBeginLoopDirective>(
722         converter, eval,
723         std::get<Fortran::parser::OmpBeginLoopDirective>(loopConstruct.t));
724   } else if (llvm::omp::OMPD_do != ompDirective &&
725              llvm::omp::OMPD_simd != ompDirective) {
726     TODO(converter.getCurrentLocation(), "Construct enclosing do loop");
727   }
728 
729   // Collect the loops to collapse.
730   auto *doConstructEval = &eval.getFirstNestedEvaluation();
731 
732   std::int64_t collapseValue =
733       Fortran::lower::getCollapseValue(loopOpClauseList);
734   std::size_t loopVarTypeSize = 0;
735   SmallVector<const Fortran::semantics::Symbol *> iv;
736   do {
737     auto *doLoop = &doConstructEval->getFirstNestedEvaluation();
738     auto *doStmt = doLoop->getIf<Fortran::parser::NonLabelDoStmt>();
739     assert(doStmt && "Expected do loop to be in the nested evaluation");
740     const auto &loopControl =
741         std::get<std::optional<Fortran::parser::LoopControl>>(doStmt->t);
742     const Fortran::parser::LoopControl::Bounds *bounds =
743         std::get_if<Fortran::parser::LoopControl::Bounds>(&loopControl->u);
744     assert(bounds && "Expected bounds for worksharing do loop");
745     Fortran::lower::StatementContext stmtCtx;
746     lowerBound.push_back(fir::getBase(converter.genExprValue(
747         *Fortran::semantics::GetExpr(bounds->lower), stmtCtx)));
748     upperBound.push_back(fir::getBase(converter.genExprValue(
749         *Fortran::semantics::GetExpr(bounds->upper), stmtCtx)));
750     if (bounds->step) {
751       step.push_back(fir::getBase(converter.genExprValue(
752           *Fortran::semantics::GetExpr(bounds->step), stmtCtx)));
753     } else { // If `step` is not present, assume it as `1`.
754       step.push_back(firOpBuilder.createIntegerConstant(
755           currentLocation, firOpBuilder.getIntegerType(32), 1));
756     }
757     iv.push_back(bounds->name.thing.symbol);
758     loopVarTypeSize = std::max(loopVarTypeSize,
759                                bounds->name.thing.symbol->GetUltimate().size());
760 
761     collapseValue--;
762     doConstructEval =
763         &*std::next(doConstructEval->getNestedEvaluations().begin());
764   } while (collapseValue > 0);
765 
766   for (const auto &clause : loopOpClauseList.v) {
767     if (const auto &scheduleClause =
768             std::get_if<Fortran::parser::OmpClause::Schedule>(&clause.u)) {
769       if (const auto &chunkExpr =
770               std::get<std::optional<Fortran::parser::ScalarIntExpr>>(
771                   scheduleClause->v.t)) {
772         if (const auto *expr = Fortran::semantics::GetExpr(*chunkExpr)) {
773           Fortran::lower::StatementContext stmtCtx;
774           scheduleChunkClauseOperand =
775               fir::getBase(converter.genExprValue(*expr, stmtCtx));
776         }
777       }
778     }
779   }
780 
781   // The types of lower bound, upper bound, and step are converted into the
782   // type of the loop variable if necessary.
783   mlir::Type loopVarType = getLoopVarType(converter, loopVarTypeSize);
784   for (unsigned it = 0; it < (unsigned)lowerBound.size(); it++) {
785     lowerBound[it] = firOpBuilder.createConvert(currentLocation, loopVarType,
786                                                 lowerBound[it]);
787     upperBound[it] = firOpBuilder.createConvert(currentLocation, loopVarType,
788                                                 upperBound[it]);
789     step[it] =
790         firOpBuilder.createConvert(currentLocation, loopVarType, step[it]);
791   }
792 
793   // 2.9.3.1 SIMD construct
794   // TODO: Support all the clauses
795   if (llvm::omp::OMPD_simd == ompDirective) {
796     TypeRange resultType;
797     auto SimdLoopOp = firOpBuilder.create<mlir::omp::SimdLoopOp>(
798         currentLocation, resultType, lowerBound, upperBound, step);
799     createBodyOfOp<omp::SimdLoopOp>(SimdLoopOp, converter, currentLocation,
800                                     eval, &loopOpClauseList, iv);
801     return;
802   }
803 
804   // FIXME: Add support for following clauses:
805   // 1. linear
806   // 2. order
807   auto wsLoopOp = firOpBuilder.create<mlir::omp::WsLoopOp>(
808       currentLocation, lowerBound, upperBound, step, linearVars, linearStepVars,
809       reductionVars, /*reductions=*/nullptr,
810       scheduleClauseOperand.dyn_cast_or_null<omp::ClauseScheduleKindAttr>(),
811       scheduleChunkClauseOperand, /*schedule_modifiers=*/nullptr,
812       /*simd_modifier=*/nullptr,
813       collapseClauseOperand.dyn_cast_or_null<IntegerAttr>(),
814       noWaitClauseOperand.dyn_cast_or_null<UnitAttr>(),
815       orderedClauseOperand.dyn_cast_or_null<IntegerAttr>(),
816       orderClauseOperand.dyn_cast_or_null<omp::ClauseOrderKindAttr>(),
817       /*inclusive=*/firOpBuilder.getUnitAttr());
818 
819   // Handle attribute based clauses.
820   for (const Fortran::parser::OmpClause &clause : loopOpClauseList.v) {
821     if (const auto &orderedClause =
822             std::get_if<Fortran::parser::OmpClause::Ordered>(&clause.u)) {
823       if (orderedClause->v.has_value()) {
824         const auto *expr = Fortran::semantics::GetExpr(orderedClause->v);
825         const std::optional<std::int64_t> orderedClauseValue =
826             Fortran::evaluate::ToInt64(*expr);
827         wsLoopOp.ordered_valAttr(
828             firOpBuilder.getI64IntegerAttr(*orderedClauseValue));
829       } else {
830         wsLoopOp.ordered_valAttr(firOpBuilder.getI64IntegerAttr(0));
831       }
832     } else if (const auto &collapseClause =
833                    std::get_if<Fortran::parser::OmpClause::Collapse>(
834                        &clause.u)) {
835       const auto *expr = Fortran::semantics::GetExpr(collapseClause->v);
836       const std::optional<std::int64_t> collapseValue =
837           Fortran::evaluate::ToInt64(*expr);
838       wsLoopOp.collapse_valAttr(firOpBuilder.getI64IntegerAttr(*collapseValue));
839     } else if (const auto &scheduleClause =
840                    std::get_if<Fortran::parser::OmpClause::Schedule>(
841                        &clause.u)) {
842       mlir::MLIRContext *context = firOpBuilder.getContext();
843       const auto &scheduleType = scheduleClause->v;
844       const auto &scheduleKind =
845           std::get<Fortran::parser::OmpScheduleClause::ScheduleType>(
846               scheduleType.t);
847       switch (scheduleKind) {
848       case Fortran::parser::OmpScheduleClause::ScheduleType::Static:
849         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
850             context, omp::ClauseScheduleKind::Static));
851         break;
852       case Fortran::parser::OmpScheduleClause::ScheduleType::Dynamic:
853         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
854             context, omp::ClauseScheduleKind::Dynamic));
855         break;
856       case Fortran::parser::OmpScheduleClause::ScheduleType::Guided:
857         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
858             context, omp::ClauseScheduleKind::Guided));
859         break;
860       case Fortran::parser::OmpScheduleClause::ScheduleType::Auto:
861         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
862             context, omp::ClauseScheduleKind::Auto));
863         break;
864       case Fortran::parser::OmpScheduleClause::ScheduleType::Runtime:
865         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
866             context, omp::ClauseScheduleKind::Runtime));
867         break;
868       }
869       mlir::omp::ScheduleModifier scheduleModifier =
870           getScheduleModifier(scheduleClause->v);
871       if (scheduleModifier != mlir::omp::ScheduleModifier::none)
872         wsLoopOp.schedule_modifierAttr(
873             omp::ScheduleModifierAttr::get(context, scheduleModifier));
874       if (getSIMDModifier(scheduleClause->v) !=
875           mlir::omp::ScheduleModifier::none)
876         wsLoopOp.simd_modifierAttr(firOpBuilder.getUnitAttr());
877     }
878   }
879   // In FORTRAN `nowait` clause occur at the end of `omp do` directive.
880   // i.e
881   // !$omp do
882   // <...>
883   // !$omp end do nowait
884   if (const auto &endClauseList =
885           std::get<std::optional<Fortran::parser::OmpEndLoopDirective>>(
886               loopConstruct.t)) {
887     const auto &clauseList =
888         std::get<Fortran::parser::OmpClauseList>((*endClauseList).t);
889     for (const Fortran::parser::OmpClause &clause : clauseList.v)
890       if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u))
891         wsLoopOp.nowaitAttr(firOpBuilder.getUnitAttr());
892   }
893 
894   createBodyOfOp<omp::WsLoopOp>(wsLoopOp, converter, currentLocation, eval,
895                                 &loopOpClauseList, iv);
896 }
897 
898 static void
899 genOMP(Fortran::lower::AbstractConverter &converter,
900        Fortran::lower::pft::Evaluation &eval,
901        const Fortran::parser::OpenMPCriticalConstruct &criticalConstruct) {
902   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
903   mlir::Location currentLocation = converter.getCurrentLocation();
904   std::string name;
905   const Fortran::parser::OmpCriticalDirective &cd =
906       std::get<Fortran::parser::OmpCriticalDirective>(criticalConstruct.t);
907   if (std::get<std::optional<Fortran::parser::Name>>(cd.t).has_value()) {
908     name =
909         std::get<std::optional<Fortran::parser::Name>>(cd.t).value().ToString();
910   }
911 
912   uint64_t hint = 0;
913   const auto &clauseList = std::get<Fortran::parser::OmpClauseList>(cd.t);
914   for (const Fortran::parser::OmpClause &clause : clauseList.v)
915     if (auto hintClause =
916             std::get_if<Fortran::parser::OmpClause::Hint>(&clause.u)) {
917       const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
918       hint = *Fortran::evaluate::ToInt64(*expr);
919       break;
920     }
921 
922   mlir::omp::CriticalOp criticalOp = [&]() {
923     if (name.empty()) {
924       return firOpBuilder.create<mlir::omp::CriticalOp>(currentLocation,
925                                                         FlatSymbolRefAttr());
926     } else {
927       mlir::ModuleOp module = firOpBuilder.getModule();
928       mlir::OpBuilder modBuilder(module.getBodyRegion());
929       auto global = module.lookupSymbol<mlir::omp::CriticalDeclareOp>(name);
930       if (!global)
931         global = modBuilder.create<mlir::omp::CriticalDeclareOp>(
932             currentLocation, name, hint);
933       return firOpBuilder.create<mlir::omp::CriticalOp>(
934           currentLocation, mlir::FlatSymbolRefAttr::get(
935                                firOpBuilder.getContext(), global.sym_name()));
936     }
937   }();
938   createBodyOfOp<omp::CriticalOp>(criticalOp, converter, currentLocation, eval);
939 }
940 
941 static void
942 genOMP(Fortran::lower::AbstractConverter &converter,
943        Fortran::lower::pft::Evaluation &eval,
944        const Fortran::parser::OpenMPSectionConstruct &sectionConstruct) {
945 
946   auto &firOpBuilder = converter.getFirOpBuilder();
947   auto currentLocation = converter.getCurrentLocation();
948   mlir::omp::SectionOp sectionOp =
949       firOpBuilder.create<mlir::omp::SectionOp>(currentLocation);
950   createBodyOfOp<omp::SectionOp>(sectionOp, converter, currentLocation, eval);
951 }
952 
953 // TODO: Add support for reduction
954 static void
955 genOMP(Fortran::lower::AbstractConverter &converter,
956        Fortran::lower::pft::Evaluation &eval,
957        const Fortran::parser::OpenMPSectionsConstruct &sectionsConstruct) {
958   auto &firOpBuilder = converter.getFirOpBuilder();
959   auto currentLocation = converter.getCurrentLocation();
960   SmallVector<Value> reductionVars, allocateOperands, allocatorOperands;
961   mlir::UnitAttr noWaitClauseOperand;
962   const auto &sectionsClauseList = std::get<Fortran::parser::OmpClauseList>(
963       std::get<Fortran::parser::OmpBeginSectionsDirective>(sectionsConstruct.t)
964           .t);
965   for (const Fortran::parser::OmpClause &clause : sectionsClauseList.v) {
966 
967     // Reduction Clause
968     if (std::get_if<Fortran::parser::OmpClause::Reduction>(&clause.u)) {
969       TODO(currentLocation, "OMPC_Reduction");
970 
971       // Allocate clause
972     } else if (const auto &allocateClause =
973                    std::get_if<Fortran::parser::OmpClause::Allocate>(
974                        &clause.u)) {
975       genAllocateClause(converter, allocateClause->v, allocatorOperands,
976                         allocateOperands);
977     }
978   }
979   const auto &endSectionsClauseList =
980       std::get<Fortran::parser::OmpEndSectionsDirective>(sectionsConstruct.t);
981   const auto &clauseList =
982       std::get<Fortran::parser::OmpClauseList>(endSectionsClauseList.t);
983   for (const auto &clause : clauseList.v) {
984     // Nowait clause
985     if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u)) {
986       noWaitClauseOperand = firOpBuilder.getUnitAttr();
987     }
988   }
989 
990   llvm::omp::Directive dir =
991       std::get<Fortran::parser::OmpSectionsDirective>(
992           std::get<Fortran::parser::OmpBeginSectionsDirective>(
993               sectionsConstruct.t)
994               .t)
995           .v;
996 
997   // Parallel Sections Construct
998   if (dir == llvm::omp::Directive::OMPD_parallel_sections) {
999     createCombinedParallelOp<Fortran::parser::OmpBeginSectionsDirective>(
1000         converter, eval,
1001         std::get<Fortran::parser::OmpBeginSectionsDirective>(
1002             sectionsConstruct.t));
1003     auto sectionsOp = firOpBuilder.create<mlir::omp::SectionsOp>(
1004         currentLocation, /*reduction_vars*/ ValueRange(),
1005         /*reductions=*/nullptr, allocateOperands, allocatorOperands,
1006         /*nowait=*/nullptr);
1007     createBodyOfOp(sectionsOp, converter, currentLocation, eval);
1008 
1009     // Sections Construct
1010   } else if (dir == llvm::omp::Directive::OMPD_sections) {
1011     auto sectionsOp = firOpBuilder.create<mlir::omp::SectionsOp>(
1012         currentLocation, reductionVars, /*reductions = */ nullptr,
1013         allocateOperands, allocatorOperands, noWaitClauseOperand);
1014     createBodyOfOp<omp::SectionsOp>(sectionsOp, converter, currentLocation,
1015                                     eval);
1016   }
1017 }
1018 
1019 static void genOmpAtomicHintAndMemoryOrderClauses(
1020     Fortran::lower::AbstractConverter &converter,
1021     const Fortran::parser::OmpAtomicClauseList &clauseList,
1022     mlir::IntegerAttr &hint,
1023     mlir::omp::ClauseMemoryOrderKindAttr &memory_order) {
1024   auto &firOpBuilder = converter.getFirOpBuilder();
1025   for (const auto &clause : clauseList.v) {
1026     if (auto ompClause = std::get_if<Fortran::parser::OmpClause>(&clause.u)) {
1027       if (auto hintClause =
1028               std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u)) {
1029         const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
1030         uint64_t hintExprValue = *Fortran::evaluate::ToInt64(*expr);
1031         hint = firOpBuilder.getI64IntegerAttr(hintExprValue);
1032       }
1033     } else if (auto ompMemoryOrderClause =
1034                    std::get_if<Fortran::parser::OmpMemoryOrderClause>(
1035                        &clause.u)) {
1036       if (std::get_if<Fortran::parser::OmpClause::Acquire>(
1037               &ompMemoryOrderClause->v.u)) {
1038         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
1039             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Acquire);
1040       } else if (std::get_if<Fortran::parser::OmpClause::Relaxed>(
1041                      &ompMemoryOrderClause->v.u)) {
1042         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
1043             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Relaxed);
1044       } else if (std::get_if<Fortran::parser::OmpClause::SeqCst>(
1045                      &ompMemoryOrderClause->v.u)) {
1046         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
1047             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Seq_cst);
1048       } else if (std::get_if<Fortran::parser::OmpClause::Release>(
1049                      &ompMemoryOrderClause->v.u)) {
1050         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
1051             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Release);
1052       }
1053     }
1054   }
1055 }
1056 
1057 static void
1058 genOmpAtomicWrite(Fortran::lower::AbstractConverter &converter,
1059                   Fortran::lower::pft::Evaluation &eval,
1060                   const Fortran::parser::OmpAtomicWrite &atomicWrite) {
1061   auto &firOpBuilder = converter.getFirOpBuilder();
1062   auto currentLocation = converter.getCurrentLocation();
1063   // Get the value and address of atomic write operands.
1064   const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
1065       std::get<2>(atomicWrite.t);
1066   const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
1067       std::get<0>(atomicWrite.t);
1068   const auto &assignmentStmtExpr =
1069       std::get<Fortran::parser::Expr>(std::get<3>(atomicWrite.t).statement.t);
1070   const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
1071       std::get<3>(atomicWrite.t).statement.t);
1072   Fortran::lower::StatementContext stmtCtx;
1073   mlir::Value value = fir::getBase(converter.genExprValue(
1074       *Fortran::semantics::GetExpr(assignmentStmtExpr), stmtCtx));
1075   mlir::Value address = fir::getBase(converter.genExprAddr(
1076       *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));
1077   // If no hint clause is specified, the effect is as if
1078   // hint(omp_sync_hint_none) had been specified.
1079   mlir::IntegerAttr hint = nullptr;
1080   mlir::omp::ClauseMemoryOrderKindAttr memory_order = nullptr;
1081   genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
1082                                         memory_order);
1083   genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
1084                                         memory_order);
1085   firOpBuilder.create<mlir::omp::AtomicWriteOp>(currentLocation, address, value,
1086                                                 hint, memory_order);
1087 }
1088 
1089 static void genOmpAtomicRead(Fortran::lower::AbstractConverter &converter,
1090                              Fortran::lower::pft::Evaluation &eval,
1091                              const Fortran::parser::OmpAtomicRead &atomicRead) {
1092   auto &firOpBuilder = converter.getFirOpBuilder();
1093   auto currentLocation = converter.getCurrentLocation();
1094   // Get the address of atomic read operands.
1095   const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
1096       std::get<2>(atomicRead.t);
1097   const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
1098       std::get<0>(atomicRead.t);
1099   const auto &assignmentStmtExpr =
1100       std::get<Fortran::parser::Expr>(std::get<3>(atomicRead.t).statement.t);
1101   const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
1102       std::get<3>(atomicRead.t).statement.t);
1103   Fortran::lower::StatementContext stmtCtx;
1104   mlir::Value from_address = fir::getBase(converter.genExprAddr(
1105       *Fortran::semantics::GetExpr(assignmentStmtExpr), stmtCtx));
1106   mlir::Value to_address = fir::getBase(converter.genExprAddr(
1107       *Fortran::semantics::GetExpr(assignmentStmtVariable), stmtCtx));
1108   // If no hint clause is specified, the effect is as if
1109   // hint(omp_sync_hint_none) had been specified.
1110   mlir::IntegerAttr hint = nullptr;
1111   mlir::omp::ClauseMemoryOrderKindAttr memory_order = nullptr;
1112   genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
1113                                         memory_order);
1114   genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
1115                                         memory_order);
1116   firOpBuilder.create<mlir::omp::AtomicReadOp>(currentLocation, from_address,
1117                                                to_address, hint, memory_order);
1118 }
1119 
1120 static void
1121 genOMP(Fortran::lower::AbstractConverter &converter,
1122        Fortran::lower::pft::Evaluation &eval,
1123        const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
1124   std::visit(Fortran::common::visitors{
1125                  [&](const Fortran::parser::OmpAtomicRead &atomicRead) {
1126                    genOmpAtomicRead(converter, eval, atomicRead);
1127                  },
1128                  [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) {
1129                    genOmpAtomicWrite(converter, eval, atomicWrite);
1130                  },
1131                  [&](const auto &) {
1132                    TODO(converter.getCurrentLocation(),
1133                         "Atomic update & capture");
1134                  },
1135              },
1136              atomicConstruct.u);
1137 }
1138 
1139 void Fortran::lower::genOpenMPConstruct(
1140     Fortran::lower::AbstractConverter &converter,
1141     Fortran::lower::pft::Evaluation &eval,
1142     const Fortran::parser::OpenMPConstruct &ompConstruct) {
1143 
1144   std::visit(
1145       common::visitors{
1146           [&](const Fortran::parser::OpenMPStandaloneConstruct
1147                   &standaloneConstruct) {
1148             genOMP(converter, eval, standaloneConstruct);
1149           },
1150           [&](const Fortran::parser::OpenMPSectionsConstruct
1151                   &sectionsConstruct) {
1152             genOMP(converter, eval, sectionsConstruct);
1153           },
1154           [&](const Fortran::parser::OpenMPSectionConstruct &sectionConstruct) {
1155             genOMP(converter, eval, sectionConstruct);
1156           },
1157           [&](const Fortran::parser::OpenMPLoopConstruct &loopConstruct) {
1158             genOMP(converter, eval, loopConstruct);
1159           },
1160           [&](const Fortran::parser::OpenMPDeclarativeAllocate
1161                   &execAllocConstruct) {
1162             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
1163           },
1164           [&](const Fortran::parser::OpenMPExecutableAllocate
1165                   &execAllocConstruct) {
1166             TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate");
1167           },
1168           [&](const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
1169             genOMP(converter, eval, blockConstruct);
1170           },
1171           [&](const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
1172             genOMP(converter, eval, atomicConstruct);
1173           },
1174           [&](const Fortran::parser::OpenMPCriticalConstruct
1175                   &criticalConstruct) {
1176             genOMP(converter, eval, criticalConstruct);
1177           },
1178       },
1179       ompConstruct.u);
1180 }
1181 
1182 void Fortran::lower::genThreadprivateOp(
1183     Fortran::lower::AbstractConverter &converter,
1184     const Fortran::lower::pft::Variable &var) {
1185   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
1186   mlir::Location currentLocation = converter.getCurrentLocation();
1187 
1188   const Fortran::semantics::Symbol &sym = var.getSymbol();
1189   mlir::Value symThreadprivateValue;
1190   if (const Fortran::semantics::Symbol *common =
1191           Fortran::semantics::FindCommonBlockContaining(sym.GetUltimate())) {
1192     mlir::Value commonValue = converter.getSymbolAddress(*common);
1193     if (mlir::isa<mlir::omp::ThreadprivateOp>(commonValue.getDefiningOp())) {
1194       // Generate ThreadprivateOp for a common block instead of its members and
1195       // only do it once for a common block.
1196       return;
1197     }
1198     // Generate ThreadprivateOp and rebind the common block.
1199     mlir::Value commonThreadprivateValue =
1200         firOpBuilder.create<mlir::omp::ThreadprivateOp>(
1201             currentLocation, commonValue.getType(), commonValue);
1202     converter.bindSymbol(*common, commonThreadprivateValue);
1203     // Generate the threadprivate value for the common block member.
1204     symThreadprivateValue =
1205         genCommonBlockMember(converter, sym, commonThreadprivateValue);
1206   } else {
1207     mlir::Value symValue = converter.getSymbolAddress(sym);
1208     symThreadprivateValue = firOpBuilder.create<mlir::omp::ThreadprivateOp>(
1209         currentLocation, symValue.getType(), symValue);
1210   }
1211 
1212   fir::ExtendedValue sexv = converter.getSymbolExtendedValue(sym);
1213   fir::ExtendedValue symThreadprivateExv =
1214       getExtendedValue(sexv, symThreadprivateValue);
1215   converter.bindSymbol(sym, symThreadprivateExv);
1216 }
1217 
1218 void Fortran::lower::genOpenMPDeclarativeConstruct(
1219     Fortran::lower::AbstractConverter &converter,
1220     Fortran::lower::pft::Evaluation &eval,
1221     const Fortran::parser::OpenMPDeclarativeConstruct &ompDeclConstruct) {
1222 
1223   std::visit(
1224       common::visitors{
1225           [&](const Fortran::parser::OpenMPDeclarativeAllocate
1226                   &declarativeAllocate) {
1227             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
1228           },
1229           [&](const Fortran::parser::OpenMPDeclareReductionConstruct
1230                   &declareReductionConstruct) {
1231             TODO(converter.getCurrentLocation(),
1232                  "OpenMPDeclareReductionConstruct");
1233           },
1234           [&](const Fortran::parser::OpenMPDeclareSimdConstruct
1235                   &declareSimdConstruct) {
1236             TODO(converter.getCurrentLocation(), "OpenMPDeclareSimdConstruct");
1237           },
1238           [&](const Fortran::parser::OpenMPDeclareTargetConstruct
1239                   &declareTargetConstruct) {
1240             TODO(converter.getCurrentLocation(),
1241                  "OpenMPDeclareTargetConstruct");
1242           },
1243           [&](const Fortran::parser::OpenMPThreadprivate &threadprivate) {
1244             // The directive is lowered when instantiating the variable to
1245             // support the case of threadprivate variable declared in module.
1246           },
1247       },
1248       ompDeclConstruct.u);
1249 }
1250