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