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