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