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