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