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