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/PFTBuilder.h"
17 #include "flang/Lower/StatementContext.h"
18 #include "flang/Lower/Todo.h"
19 #include "flang/Optimizer/Builder/BoxValue.h"
20 #include "flang/Optimizer/Builder/FIRBuilder.h"
21 #include "flang/Parser/parse-tree.h"
22 #include "flang/Semantics/tools.h"
23 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
24 #include "llvm/Frontend/OpenMP/OMPConstants.h"
25 
26 using namespace mlir;
27 
28 static const Fortran::parser::Name *
29 getDesignatorNameIfDataRef(const Fortran::parser::Designator &designator) {
30   const auto *dataRef = std::get_if<Fortran::parser::DataRef>(&designator.u);
31   return dataRef ? std::get_if<Fortran::parser::Name>(&dataRef->u) : nullptr;
32 }
33 
34 template <typename T>
35 static void createPrivateVarSyms(Fortran::lower::AbstractConverter &converter,
36                                  const T *clause) {
37   Fortran::semantics::Symbol *sym = nullptr;
38   const Fortran::parser::OmpObjectList &ompObjectList = clause->v;
39   for (const Fortran::parser::OmpObject &ompObject : ompObjectList.v) {
40     std::visit(
41         Fortran::common::visitors{
42             [&](const Fortran::parser::Designator &designator) {
43               if (const Fortran::parser::Name *name =
44                       getDesignatorNameIfDataRef(designator)) {
45                 sym = name->symbol;
46               }
47             },
48             [&](const Fortran::parser::Name &name) { sym = name.symbol; }},
49         ompObject.u);
50 
51     // Privatization for symbols which are pre-determined (like loop index
52     // variables) happen separately, for everything else privatize here
53     if constexpr (std::is_same_v<T, Fortran::parser::OmpClause::Firstprivate>) {
54       converter.copyHostAssociateVar(*sym);
55     } else {
56       bool success = converter.createHostAssociateVarClone(*sym);
57       (void)success;
58       assert(success && "Privatization failed due to existing binding");
59     }
60   }
61 }
62 
63 static void privatizeVars(Fortran::lower::AbstractConverter &converter,
64                           const Fortran::parser::OmpClauseList &opClauseList) {
65   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
66   auto insPt = firOpBuilder.saveInsertionPoint();
67   firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
68   for (const Fortran::parser::OmpClause &clause : opClauseList.v) {
69     if (const auto &privateClause =
70             std::get_if<Fortran::parser::OmpClause::Private>(&clause.u)) {
71       createPrivateVarSyms(converter, privateClause);
72     } else if (const auto &firstPrivateClause =
73                    std::get_if<Fortran::parser::OmpClause::Firstprivate>(
74                        &clause.u)) {
75       createPrivateVarSyms(converter, firstPrivateClause);
76     }
77   }
78   firOpBuilder.restoreInsertionPoint(insPt);
79 }
80 
81 static void genObjectList(const Fortran::parser::OmpObjectList &objectList,
82                           Fortran::lower::AbstractConverter &converter,
83                           llvm::SmallVectorImpl<Value> &operands) {
84   auto addOperands = [&](Fortran::lower::SymbolRef sym) {
85     const mlir::Value variable = converter.getSymbolAddress(sym);
86     if (variable) {
87       operands.push_back(variable);
88     } else {
89       if (const auto *details =
90               sym->detailsIf<Fortran::semantics::HostAssocDetails>()) {
91         operands.push_back(converter.getSymbolAddress(details->symbol()));
92         converter.copySymbolBinding(details->symbol(), sym);
93       }
94     }
95   };
96   for (const Fortran::parser::OmpObject &ompObject : objectList.v) {
97     std::visit(Fortran::common::visitors{
98                    [&](const Fortran::parser::Designator &designator) {
99                      if (const Fortran::parser::Name *name =
100                              getDesignatorNameIfDataRef(designator)) {
101                        addOperands(*name->symbol);
102                      }
103                    },
104                    [&](const Fortran::parser::Name &name) {
105                      addOperands(*name.symbol);
106                    }},
107                ompObject.u);
108   }
109 }
110 
111 template <typename Op>
112 static void
113 createBodyOfOp(Op &op, Fortran::lower::AbstractConverter &converter,
114                mlir::Location &loc,
115                const Fortran::parser::OmpClauseList *clauses = nullptr,
116                const Fortran::semantics::Symbol *arg = nullptr,
117                bool outerCombined = false) {
118   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
119   // If an argument for the region is provided then create the block with that
120   // argument. Also update the symbol's address with the mlir argument value.
121   // e.g. For loops the argument is the induction variable. And all further
122   // uses of the induction variable should use this mlir value.
123   if (arg) {
124     firOpBuilder.createBlock(&op.getRegion(), {}, {converter.genType(*arg)},
125                              {loc});
126     converter.bindSymbol(*arg, op.getRegion().front().getArgument(0));
127   } else {
128     firOpBuilder.createBlock(&op.getRegion());
129   }
130   auto &block = op.getRegion().back();
131   firOpBuilder.setInsertionPointToStart(&block);
132 
133   // Insert the terminator.
134   if constexpr (std::is_same_v<Op, omp::WsLoopOp>) {
135     mlir::ValueRange results;
136     firOpBuilder.create<mlir::omp::YieldOp>(loc, results);
137   } else {
138     firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
139   }
140 
141   // Reset the insertion point to the start of the first block.
142   firOpBuilder.setInsertionPointToStart(&block);
143   // Handle privatization. Do not privatize if this is the outer operation.
144   if (clauses && !outerCombined)
145     privatizeVars(converter, *clauses);
146 }
147 
148 static void genOMP(Fortran::lower::AbstractConverter &converter,
149                    Fortran::lower::pft::Evaluation &eval,
150                    const Fortran::parser::OpenMPSimpleStandaloneConstruct
151                        &simpleStandaloneConstruct) {
152   const auto &directive =
153       std::get<Fortran::parser::OmpSimpleStandaloneDirective>(
154           simpleStandaloneConstruct.t);
155   switch (directive.v) {
156   default:
157     break;
158   case llvm::omp::Directive::OMPD_barrier:
159     converter.getFirOpBuilder().create<mlir::omp::BarrierOp>(
160         converter.getCurrentLocation());
161     break;
162   case llvm::omp::Directive::OMPD_taskwait:
163     converter.getFirOpBuilder().create<mlir::omp::TaskwaitOp>(
164         converter.getCurrentLocation());
165     break;
166   case llvm::omp::Directive::OMPD_taskyield:
167     converter.getFirOpBuilder().create<mlir::omp::TaskyieldOp>(
168         converter.getCurrentLocation());
169     break;
170   case llvm::omp::Directive::OMPD_target_enter_data:
171     TODO(converter.getCurrentLocation(), "OMPD_target_enter_data");
172   case llvm::omp::Directive::OMPD_target_exit_data:
173     TODO(converter.getCurrentLocation(), "OMPD_target_exit_data");
174   case llvm::omp::Directive::OMPD_target_update:
175     TODO(converter.getCurrentLocation(), "OMPD_target_update");
176   case llvm::omp::Directive::OMPD_ordered:
177     TODO(converter.getCurrentLocation(), "OMPD_ordered");
178   }
179 }
180 
181 static void
182 genAllocateClause(Fortran::lower::AbstractConverter &converter,
183                   const Fortran::parser::OmpAllocateClause &ompAllocateClause,
184                   SmallVector<Value> &allocatorOperands,
185                   SmallVector<Value> &allocateOperands) {
186   auto &firOpBuilder = converter.getFirOpBuilder();
187   auto currentLocation = converter.getCurrentLocation();
188   Fortran::lower::StatementContext stmtCtx;
189 
190   mlir::Value allocatorOperand;
191   const Fortran::parser::OmpObjectList &ompObjectList =
192       std::get<Fortran::parser::OmpObjectList>(ompAllocateClause.t);
193   const auto &allocatorValue =
194       std::get<std::optional<Fortran::parser::OmpAllocateClause::Allocator>>(
195           ompAllocateClause.t);
196   // Check if allocate clause has allocator specified. If so, add it
197   // to list of allocators, otherwise, add default allocator to
198   // list of allocators.
199   if (allocatorValue) {
200     allocatorOperand = fir::getBase(converter.genExprValue(
201         *Fortran::semantics::GetExpr(allocatorValue->v), stmtCtx));
202     allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(),
203                              allocatorOperand);
204   } else {
205     allocatorOperand = firOpBuilder.createIntegerConstant(
206         currentLocation, firOpBuilder.getI32Type(), 1);
207     allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(),
208                              allocatorOperand);
209   }
210   genObjectList(ompObjectList, converter, allocateOperands);
211 }
212 
213 static void
214 genOMP(Fortran::lower::AbstractConverter &converter,
215        Fortran::lower::pft::Evaluation &eval,
216        const Fortran::parser::OpenMPStandaloneConstruct &standaloneConstruct) {
217   std::visit(
218       Fortran::common::visitors{
219           [&](const Fortran::parser::OpenMPSimpleStandaloneConstruct
220                   &simpleStandaloneConstruct) {
221             genOMP(converter, eval, simpleStandaloneConstruct);
222           },
223           [&](const Fortran::parser::OpenMPFlushConstruct &flushConstruct) {
224             SmallVector<Value, 4> operandRange;
225             if (const auto &ompObjectList =
226                     std::get<std::optional<Fortran::parser::OmpObjectList>>(
227                         flushConstruct.t))
228               genObjectList(*ompObjectList, converter, operandRange);
229             const auto &memOrderClause = std::get<std::optional<
230                 std::list<Fortran::parser::OmpMemoryOrderClause>>>(
231                 flushConstruct.t);
232             if (memOrderClause.has_value() && memOrderClause->size() > 0)
233               TODO(converter.getCurrentLocation(),
234                    "Handle OmpMemoryOrderClause");
235             converter.getFirOpBuilder().create<mlir::omp::FlushOp>(
236                 converter.getCurrentLocation(), operandRange);
237           },
238           [&](const Fortran::parser::OpenMPCancelConstruct &cancelConstruct) {
239             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
240           },
241           [&](const Fortran::parser::OpenMPCancellationPointConstruct
242                   &cancellationPointConstruct) {
243             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
244           },
245       },
246       standaloneConstruct.u);
247 }
248 
249 static void
250 genOMP(Fortran::lower::AbstractConverter &converter,
251        Fortran::lower::pft::Evaluation &eval,
252        const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
253   const auto &beginBlockDirective =
254       std::get<Fortran::parser::OmpBeginBlockDirective>(blockConstruct.t);
255   const auto &blockDirective =
256       std::get<Fortran::parser::OmpBlockDirective>(beginBlockDirective.t);
257   const auto &endBlockDirective =
258       std::get<Fortran::parser::OmpEndBlockDirective>(blockConstruct.t);
259   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
260   mlir::Location currentLocation = converter.getCurrentLocation();
261 
262   Fortran::lower::StatementContext stmtCtx;
263   llvm::ArrayRef<mlir::Type> argTy;
264   mlir::Value ifClauseOperand, numThreadsClauseOperand, finalClauseOperand,
265       priorityClauseOperand;
266   mlir::omp::ClauseProcBindKindAttr procBindKindAttr;
267   SmallVector<Value> allocateOperands, allocatorOperands;
268   mlir::UnitAttr nowaitAttr, untiedAttr, mergeableAttr;
269 
270   const auto &opClauseList =
271       std::get<Fortran::parser::OmpClauseList>(beginBlockDirective.t);
272   for (const auto &clause : opClauseList.v) {
273     if (const auto &ifClause =
274             std::get_if<Fortran::parser::OmpClause::If>(&clause.u)) {
275       auto &expr = std::get<Fortran::parser::ScalarLogicalExpr>(ifClause->v.t);
276       mlir::Value ifVal = fir::getBase(
277           converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
278       ifClauseOperand = firOpBuilder.createConvert(
279           currentLocation, firOpBuilder.getI1Type(), ifVal);
280     } else if (const auto &numThreadsClause =
281                    std::get_if<Fortran::parser::OmpClause::NumThreads>(
282                        &clause.u)) {
283       // OMPIRBuilder expects `NUM_THREAD` clause as a `Value`.
284       numThreadsClauseOperand = fir::getBase(converter.genExprValue(
285           *Fortran::semantics::GetExpr(numThreadsClause->v), stmtCtx));
286     } else if (const auto &procBindClause =
287                    std::get_if<Fortran::parser::OmpClause::ProcBind>(
288                        &clause.u)) {
289       omp::ClauseProcBindKind pbKind;
290       switch (procBindClause->v.v) {
291       case Fortran::parser::OmpProcBindClause::Type::Master:
292         pbKind = omp::ClauseProcBindKind::Master;
293         break;
294       case Fortran::parser::OmpProcBindClause::Type::Close:
295         pbKind = omp::ClauseProcBindKind::Close;
296         break;
297       case Fortran::parser::OmpProcBindClause::Type::Spread:
298         pbKind = omp::ClauseProcBindKind::Spread;
299         break;
300       case Fortran::parser::OmpProcBindClause::Type::Primary:
301         pbKind = omp::ClauseProcBindKind::Primary;
302         break;
303       }
304       procBindKindAttr =
305           omp::ClauseProcBindKindAttr::get(firOpBuilder.getContext(), pbKind);
306     } else if (const auto &allocateClause =
307                    std::get_if<Fortran::parser::OmpClause::Allocate>(
308                        &clause.u)) {
309       genAllocateClause(converter, allocateClause->v, allocatorOperands,
310                         allocateOperands);
311     } else if (std::get_if<Fortran::parser::OmpClause::Private>(&clause.u) ||
312                std::get_if<Fortran::parser::OmpClause::Firstprivate>(
313                    &clause.u)) {
314       // Privatisation clauses are handled elsewhere.
315       continue;
316     } else if (std::get_if<Fortran::parser::OmpClause::Threads>(&clause.u)) {
317       // Nothing needs to be done for threads clause.
318       continue;
319     } else if (const auto &finalClause =
320                    std::get_if<Fortran::parser::OmpClause::Final>(&clause.u)) {
321       mlir::Value finalVal = fir::getBase(converter.genExprValue(
322           *Fortran::semantics::GetExpr(finalClause->v), stmtCtx));
323       finalClauseOperand = firOpBuilder.createConvert(
324           currentLocation, firOpBuilder.getI1Type(), finalVal);
325     } else if (std::get_if<Fortran::parser::OmpClause::Untied>(&clause.u)) {
326       untiedAttr = firOpBuilder.getUnitAttr();
327     } else if (std::get_if<Fortran::parser::OmpClause::Mergeable>(&clause.u)) {
328       mergeableAttr = firOpBuilder.getUnitAttr();
329     } else if (const auto &priorityClause =
330                    std::get_if<Fortran::parser::OmpClause::Priority>(
331                        &clause.u)) {
332       priorityClauseOperand = fir::getBase(converter.genExprValue(
333           *Fortran::semantics::GetExpr(priorityClause->v), stmtCtx));
334     } else {
335       TODO(currentLocation, "OpenMP Block construct clauses");
336     }
337   }
338 
339   for (const auto &clause :
340        std::get<Fortran::parser::OmpClauseList>(endBlockDirective.t).v) {
341     if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u))
342       nowaitAttr = firOpBuilder.getUnitAttr();
343   }
344 
345   if (blockDirective.v == llvm::omp::OMPD_parallel) {
346     // Create and insert the operation.
347     auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
348         currentLocation, argTy, ifClauseOperand, numThreadsClauseOperand,
349         allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(),
350         /*reductions=*/nullptr, procBindKindAttr);
351     createBodyOfOp<omp::ParallelOp>(parallelOp, converter, currentLocation,
352                                     &opClauseList);
353   } else if (blockDirective.v == llvm::omp::OMPD_master) {
354     auto masterOp =
355         firOpBuilder.create<mlir::omp::MasterOp>(currentLocation, argTy);
356     createBodyOfOp<omp::MasterOp>(masterOp, converter, currentLocation);
357   } else if (blockDirective.v == llvm::omp::OMPD_single) {
358     auto singleOp = firOpBuilder.create<mlir::omp::SingleOp>(
359         currentLocation, allocateOperands, allocatorOperands, nowaitAttr);
360     createBodyOfOp<omp::SingleOp>(singleOp, converter, currentLocation);
361   } else if (blockDirective.v == llvm::omp::OMPD_ordered) {
362     auto orderedOp = firOpBuilder.create<mlir::omp::OrderedRegionOp>(
363         currentLocation, /*simd=*/nullptr);
364     createBodyOfOp<omp::OrderedRegionOp>(orderedOp, converter, currentLocation);
365   } else if (blockDirective.v == llvm::omp::OMPD_task) {
366     auto taskOp = firOpBuilder.create<mlir::omp::TaskOp>(
367         currentLocation, ifClauseOperand, finalClauseOperand, untiedAttr,
368         mergeableAttr, /*in_reduction_vars=*/ValueRange(),
369         /*in_reductions=*/nullptr, priorityClauseOperand, allocateOperands,
370         allocatorOperands);
371     createBodyOfOp(taskOp, converter, currentLocation, &opClauseList);
372   } else {
373     TODO(converter.getCurrentLocation(), "Unhandled block directive");
374   }
375 }
376 
377 static void genOMP(Fortran::lower::AbstractConverter &converter,
378                    Fortran::lower::pft::Evaluation &eval,
379                    const Fortran::parser::OpenMPLoopConstruct &loopConstruct) {
380 
381   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
382   mlir::Location currentLocation = converter.getCurrentLocation();
383   llvm::SmallVector<mlir::Value> lowerBound, upperBound, step, linearVars,
384       linearStepVars, reductionVars;
385   mlir::Value scheduleChunkClauseOperand;
386   mlir::Attribute scheduleClauseOperand, collapseClauseOperand,
387       noWaitClauseOperand, orderedClauseOperand, orderClauseOperand;
388   const auto &wsLoopOpClauseList = std::get<Fortran::parser::OmpClauseList>(
389       std::get<Fortran::parser::OmpBeginLoopDirective>(loopConstruct.t).t);
390   if (llvm::omp::OMPD_do !=
391       std::get<Fortran::parser::OmpLoopDirective>(
392           std::get<Fortran::parser::OmpBeginLoopDirective>(loopConstruct.t).t)
393           .v) {
394     TODO(converter.getCurrentLocation(), "Combined worksharing loop construct");
395   }
396 
397   Fortran::lower::pft::Evaluation *doConstructEval =
398       &eval.getFirstNestedEvaluation();
399 
400   Fortran::lower::pft::Evaluation *doLoop =
401       &doConstructEval->getFirstNestedEvaluation();
402   auto *doStmt = doLoop->getIf<Fortran::parser::NonLabelDoStmt>();
403   assert(doStmt && "Expected do loop to be in the nested evaluation");
404   const auto &loopControl =
405       std::get<std::optional<Fortran::parser::LoopControl>>(doStmt->t);
406   const Fortran::parser::LoopControl::Bounds *bounds =
407       std::get_if<Fortran::parser::LoopControl::Bounds>(&loopControl->u);
408   assert(bounds && "Expected bounds for worksharing do loop");
409   Fortran::semantics::Symbol *iv = nullptr;
410   Fortran::lower::StatementContext stmtCtx;
411   lowerBound.push_back(fir::getBase(converter.genExprValue(
412       *Fortran::semantics::GetExpr(bounds->lower), stmtCtx)));
413   upperBound.push_back(fir::getBase(converter.genExprValue(
414       *Fortran::semantics::GetExpr(bounds->upper), stmtCtx)));
415   if (bounds->step) {
416     step.push_back(fir::getBase(converter.genExprValue(
417         *Fortran::semantics::GetExpr(bounds->step), stmtCtx)));
418   } else { // If `step` is not present, assume it as `1`.
419     step.push_back(firOpBuilder.createIntegerConstant(
420         currentLocation, firOpBuilder.getIntegerType(32), 1));
421   }
422   iv = bounds->name.thing.symbol;
423 
424   // FIXME: Add support for following clauses:
425   // 1. linear
426   // 2. order
427   // 3. collapse
428   // 4. schedule (with chunk)
429   auto wsLoopOp = firOpBuilder.create<mlir::omp::WsLoopOp>(
430       currentLocation, lowerBound, upperBound, step, linearVars, linearStepVars,
431       reductionVars, /*reductions=*/nullptr,
432       scheduleClauseOperand.dyn_cast_or_null<omp::ClauseScheduleKindAttr>(),
433       scheduleChunkClauseOperand, /*schedule_modifiers=*/nullptr,
434       /*simd_modifier=*/nullptr,
435       collapseClauseOperand.dyn_cast_or_null<IntegerAttr>(),
436       noWaitClauseOperand.dyn_cast_or_null<UnitAttr>(),
437       orderedClauseOperand.dyn_cast_or_null<IntegerAttr>(),
438       orderClauseOperand.dyn_cast_or_null<omp::ClauseOrderKindAttr>(),
439       /*inclusive=*/firOpBuilder.getUnitAttr());
440 
441   // Handle attribute based clauses.
442   for (const Fortran::parser::OmpClause &clause : wsLoopOpClauseList.v) {
443     if (const auto &orderedClause =
444             std::get_if<Fortran::parser::OmpClause::Ordered>(&clause.u)) {
445       if (orderedClause->v.has_value()) {
446         const auto *expr = Fortran::semantics::GetExpr(orderedClause->v);
447         const std::optional<std::int64_t> orderedClauseValue =
448             Fortran::evaluate::ToInt64(*expr);
449         wsLoopOp.ordered_valAttr(
450             firOpBuilder.getI64IntegerAttr(*orderedClauseValue));
451       } else {
452         wsLoopOp.ordered_valAttr(firOpBuilder.getI64IntegerAttr(0));
453       }
454     } else if (const auto &scheduleClause =
455                    std::get_if<Fortran::parser::OmpClause::Schedule>(
456                        &clause.u)) {
457       mlir::MLIRContext *context = firOpBuilder.getContext();
458       const auto &scheduleType = scheduleClause->v;
459       const auto &scheduleKind =
460           std::get<Fortran::parser::OmpScheduleClause::ScheduleType>(
461               scheduleType.t);
462       switch (scheduleKind) {
463       case Fortran::parser::OmpScheduleClause::ScheduleType::Static:
464         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
465             context, omp::ClauseScheduleKind::Static));
466         break;
467       case Fortran::parser::OmpScheduleClause::ScheduleType::Dynamic:
468         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
469             context, omp::ClauseScheduleKind::Dynamic));
470         break;
471       case Fortran::parser::OmpScheduleClause::ScheduleType::Guided:
472         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
473             context, omp::ClauseScheduleKind::Guided));
474         break;
475       case Fortran::parser::OmpScheduleClause::ScheduleType::Auto:
476         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
477             context, omp::ClauseScheduleKind::Auto));
478         break;
479       case Fortran::parser::OmpScheduleClause::ScheduleType::Runtime:
480         wsLoopOp.schedule_valAttr(omp::ClauseScheduleKindAttr::get(
481             context, omp::ClauseScheduleKind::Runtime));
482         break;
483       }
484     }
485   }
486   // In FORTRAN `nowait` clause occur at the end of `omp do` directive.
487   // i.e
488   // !$omp do
489   // <...>
490   // !$omp end do nowait
491   if (const auto &endClauseList =
492           std::get<std::optional<Fortran::parser::OmpEndLoopDirective>>(
493               loopConstruct.t)) {
494     const auto &clauseList =
495         std::get<Fortran::parser::OmpClauseList>((*endClauseList).t);
496     for (const Fortran::parser::OmpClause &clause : clauseList.v)
497       if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u))
498         wsLoopOp.nowaitAttr(firOpBuilder.getUnitAttr());
499   }
500 
501   createBodyOfOp<omp::WsLoopOp>(wsLoopOp, converter, currentLocation,
502                                 &wsLoopOpClauseList, iv);
503 }
504 
505 static void
506 genOMP(Fortran::lower::AbstractConverter &converter,
507        Fortran::lower::pft::Evaluation &eval,
508        const Fortran::parser::OpenMPCriticalConstruct &criticalConstruct) {
509   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
510   mlir::Location currentLocation = converter.getCurrentLocation();
511   std::string name;
512   const Fortran::parser::OmpCriticalDirective &cd =
513       std::get<Fortran::parser::OmpCriticalDirective>(criticalConstruct.t);
514   if (std::get<std::optional<Fortran::parser::Name>>(cd.t).has_value()) {
515     name =
516         std::get<std::optional<Fortran::parser::Name>>(cd.t).value().ToString();
517   }
518 
519   uint64_t hint = 0;
520   const auto &clauseList = std::get<Fortran::parser::OmpClauseList>(cd.t);
521   for (const Fortran::parser::OmpClause &clause : clauseList.v)
522     if (auto hintClause =
523             std::get_if<Fortran::parser::OmpClause::Hint>(&clause.u)) {
524       const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
525       hint = *Fortran::evaluate::ToInt64(*expr);
526       break;
527     }
528 
529   mlir::omp::CriticalOp criticalOp = [&]() {
530     if (name.empty()) {
531       return firOpBuilder.create<mlir::omp::CriticalOp>(currentLocation,
532                                                         FlatSymbolRefAttr());
533     } else {
534       mlir::ModuleOp module = firOpBuilder.getModule();
535       mlir::OpBuilder modBuilder(module.getBodyRegion());
536       auto global = module.lookupSymbol<mlir::omp::CriticalDeclareOp>(name);
537       if (!global)
538         global = modBuilder.create<mlir::omp::CriticalDeclareOp>(
539             currentLocation, name, hint);
540       return firOpBuilder.create<mlir::omp::CriticalOp>(
541           currentLocation, mlir::FlatSymbolRefAttr::get(
542                                firOpBuilder.getContext(), global.sym_name()));
543     }
544   }();
545   createBodyOfOp<omp::CriticalOp>(criticalOp, converter, currentLocation);
546 }
547 
548 static void
549 genOMP(Fortran::lower::AbstractConverter &converter,
550        Fortran::lower::pft::Evaluation &eval,
551        const Fortran::parser::OpenMPSectionConstruct &sectionConstruct) {
552 
553   auto &firOpBuilder = converter.getFirOpBuilder();
554   auto currentLocation = converter.getCurrentLocation();
555   mlir::omp::SectionOp sectionOp =
556       firOpBuilder.create<mlir::omp::SectionOp>(currentLocation);
557   createBodyOfOp<omp::SectionOp>(sectionOp, converter, currentLocation);
558 }
559 
560 // TODO: Add support for reduction
561 static void
562 genOMP(Fortran::lower::AbstractConverter &converter,
563        Fortran::lower::pft::Evaluation &eval,
564        const Fortran::parser::OpenMPSectionsConstruct &sectionsConstruct) {
565   auto &firOpBuilder = converter.getFirOpBuilder();
566   auto currentLocation = converter.getCurrentLocation();
567   SmallVector<Value> reductionVars, allocateOperands, allocatorOperands;
568   mlir::UnitAttr noWaitClauseOperand;
569   const auto &sectionsClauseList = std::get<Fortran::parser::OmpClauseList>(
570       std::get<Fortran::parser::OmpBeginSectionsDirective>(sectionsConstruct.t)
571           .t);
572   for (const Fortran::parser::OmpClause &clause : sectionsClauseList.v) {
573 
574     // Reduction Clause
575     if (std::get_if<Fortran::parser::OmpClause::Reduction>(&clause.u)) {
576       TODO(currentLocation, "OMPC_Reduction");
577 
578       // Allocate clause
579     } else if (const auto &allocateClause =
580                    std::get_if<Fortran::parser::OmpClause::Allocate>(
581                        &clause.u)) {
582       genAllocateClause(converter, allocateClause->v, allocatorOperands,
583                         allocateOperands);
584     }
585   }
586   const auto &endSectionsClauseList =
587       std::get<Fortran::parser::OmpEndSectionsDirective>(sectionsConstruct.t);
588   const auto &clauseList =
589       std::get<Fortran::parser::OmpClauseList>(endSectionsClauseList.t);
590   for (const auto &clause : clauseList.v) {
591     // Nowait clause
592     if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u)) {
593       noWaitClauseOperand = firOpBuilder.getUnitAttr();
594     }
595   }
596 
597   llvm::omp::Directive dir =
598       std::get<Fortran::parser::OmpSectionsDirective>(
599           std::get<Fortran::parser::OmpBeginSectionsDirective>(
600               sectionsConstruct.t)
601               .t)
602           .v;
603 
604   // Parallel Sections Construct
605   if (dir == llvm::omp::Directive::OMPD_parallel_sections) {
606     auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
607         currentLocation, /*if_expr_var*/ nullptr, /*num_threads_var*/ nullptr,
608         allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(),
609         /*reductions=*/nullptr, /*proc_bind_val*/ nullptr);
610     createBodyOfOp(parallelOp, converter, currentLocation);
611     auto sectionsOp = firOpBuilder.create<mlir::omp::SectionsOp>(
612         currentLocation, /*reduction_vars*/ ValueRange(),
613         /*reductions=*/nullptr, /*allocate_vars*/ ValueRange(),
614         /*allocators_vars*/ ValueRange(), /*nowait=*/nullptr);
615     createBodyOfOp(sectionsOp, converter, currentLocation);
616 
617     // Sections Construct
618   } else if (dir == llvm::omp::Directive::OMPD_sections) {
619     auto sectionsOp = firOpBuilder.create<mlir::omp::SectionsOp>(
620         currentLocation, reductionVars, /*reductions = */ nullptr,
621         allocateOperands, allocatorOperands, noWaitClauseOperand);
622     createBodyOfOp<omp::SectionsOp>(sectionsOp, converter, currentLocation);
623   }
624 }
625 
626 static void genOmpAtomicHintAndMemoryOrderClauses(
627     Fortran::lower::AbstractConverter &converter,
628     const Fortran::parser::OmpAtomicClauseList &clauseList,
629     mlir::IntegerAttr &hint,
630     mlir::omp::ClauseMemoryOrderKindAttr &memory_order) {
631   auto &firOpBuilder = converter.getFirOpBuilder();
632   for (const auto &clause : clauseList.v) {
633     if (auto ompClause = std::get_if<Fortran::parser::OmpClause>(&clause.u)) {
634       if (auto hintClause =
635               std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u)) {
636         const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
637         uint64_t hintExprValue = *Fortran::evaluate::ToInt64(*expr);
638         hint = firOpBuilder.getI64IntegerAttr(hintExprValue);
639       }
640     } else if (auto ompMemoryOrderClause =
641                    std::get_if<Fortran::parser::OmpMemoryOrderClause>(
642                        &clause.u)) {
643       if (std::get_if<Fortran::parser::OmpClause::Acquire>(
644               &ompMemoryOrderClause->v.u)) {
645         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
646             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Acquire);
647       } else if (std::get_if<Fortran::parser::OmpClause::Relaxed>(
648                      &ompMemoryOrderClause->v.u)) {
649         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
650             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Relaxed);
651       } else if (std::get_if<Fortran::parser::OmpClause::SeqCst>(
652                      &ompMemoryOrderClause->v.u)) {
653         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
654             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Seq_cst);
655       } else if (std::get_if<Fortran::parser::OmpClause::Release>(
656                      &ompMemoryOrderClause->v.u)) {
657         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
658             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Release);
659       }
660     }
661   }
662 }
663 
664 static void
665 genOmpAtomicWrite(Fortran::lower::AbstractConverter &converter,
666                   Fortran::lower::pft::Evaluation &eval,
667                   const Fortran::parser::OmpAtomicWrite &atomicWrite) {
668   auto &firOpBuilder = converter.getFirOpBuilder();
669   auto currentLocation = converter.getCurrentLocation();
670   mlir::Value address;
671   // If no hint clause is specified, the effect is as if
672   // hint(omp_sync_hint_none) had been specified.
673   mlir::IntegerAttr hint = nullptr;
674   mlir::omp::ClauseMemoryOrderKindAttr memory_order = nullptr;
675   const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
676       std::get<2>(atomicWrite.t);
677   const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
678       std::get<0>(atomicWrite.t);
679   const auto &assignmentStmtExpr =
680       std::get<Fortran::parser::Expr>(std::get<3>(atomicWrite.t).statement.t);
681   const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
682       std::get<3>(atomicWrite.t).statement.t);
683   Fortran::lower::StatementContext stmtCtx;
684   auto value = fir::getBase(converter.genExprValue(
685       *Fortran::semantics::GetExpr(assignmentStmtExpr), stmtCtx));
686   if (auto varDesignator = std::get_if<
687           Fortran::common::Indirection<Fortran::parser::Designator>>(
688           &assignmentStmtVariable.u)) {
689     if (const auto *name = getDesignatorNameIfDataRef(varDesignator->value())) {
690       address = converter.getSymbolAddress(*name->symbol);
691     }
692   }
693 
694   genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
695                                         memory_order);
696   genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
697                                         memory_order);
698   firOpBuilder.create<mlir::omp::AtomicWriteOp>(currentLocation, address, value,
699                                                 hint, memory_order);
700 }
701 
702 static void genOmpAtomicRead(Fortran::lower::AbstractConverter &converter,
703                              Fortran::lower::pft::Evaluation &eval,
704                              const Fortran::parser::OmpAtomicRead &atomicRead) {
705   auto &firOpBuilder = converter.getFirOpBuilder();
706   auto currentLocation = converter.getCurrentLocation();
707   mlir::Value to_address;
708   mlir::Value from_address;
709   // If no hint clause is specified, the effect is as if
710   // hint(omp_sync_hint_none) had been specified.
711   mlir::IntegerAttr hint = nullptr;
712   mlir::omp::ClauseMemoryOrderKindAttr memory_order = nullptr;
713   const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
714       std::get<2>(atomicRead.t);
715   const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
716       std::get<0>(atomicRead.t);
717   const auto &assignmentStmtExpr =
718       std::get<Fortran::parser::Expr>(std::get<3>(atomicRead.t).statement.t);
719   const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
720       std::get<3>(atomicRead.t).statement.t);
721   if (auto exprDesignator = std::get_if<
722           Fortran::common::Indirection<Fortran::parser::Designator>>(
723           &assignmentStmtExpr.u)) {
724     if (const auto *name =
725             getDesignatorNameIfDataRef(exprDesignator->value())) {
726       from_address = converter.getSymbolAddress(*name->symbol);
727     }
728   }
729 
730   if (auto varDesignator = std::get_if<
731           Fortran::common::Indirection<Fortran::parser::Designator>>(
732           &assignmentStmtVariable.u)) {
733     if (const auto *name = getDesignatorNameIfDataRef(varDesignator->value())) {
734       to_address = converter.getSymbolAddress(*name->symbol);
735     }
736   }
737 
738   genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
739                                         memory_order);
740   genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
741                                         memory_order);
742   firOpBuilder.create<mlir::omp::AtomicReadOp>(currentLocation, from_address,
743                                                to_address, hint, memory_order);
744 }
745 
746 static void
747 genOMP(Fortran::lower::AbstractConverter &converter,
748        Fortran::lower::pft::Evaluation &eval,
749        const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
750   std::visit(Fortran::common::visitors{
751                  [&](const Fortran::parser::OmpAtomicRead &atomicRead) {
752                    genOmpAtomicRead(converter, eval, atomicRead);
753                  },
754                  [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) {
755                    genOmpAtomicWrite(converter, eval, atomicWrite);
756                  },
757                  [&](const auto &) {
758                    TODO(converter.getCurrentLocation(),
759                         "Atomic update & capture");
760                  },
761              },
762              atomicConstruct.u);
763 }
764 
765 void Fortran::lower::genOpenMPConstruct(
766     Fortran::lower::AbstractConverter &converter,
767     Fortran::lower::pft::Evaluation &eval,
768     const Fortran::parser::OpenMPConstruct &ompConstruct) {
769 
770   std::visit(
771       common::visitors{
772           [&](const Fortran::parser::OpenMPStandaloneConstruct
773                   &standaloneConstruct) {
774             genOMP(converter, eval, standaloneConstruct);
775           },
776           [&](const Fortran::parser::OpenMPSectionsConstruct
777                   &sectionsConstruct) {
778             genOMP(converter, eval, sectionsConstruct);
779           },
780           [&](const Fortran::parser::OpenMPSectionConstruct &sectionConstruct) {
781             genOMP(converter, eval, sectionConstruct);
782           },
783           [&](const Fortran::parser::OpenMPLoopConstruct &loopConstruct) {
784             genOMP(converter, eval, loopConstruct);
785           },
786           [&](const Fortran::parser::OpenMPDeclarativeAllocate
787                   &execAllocConstruct) {
788             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
789           },
790           [&](const Fortran::parser::OpenMPExecutableAllocate
791                   &execAllocConstruct) {
792             TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate");
793           },
794           [&](const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
795             genOMP(converter, eval, blockConstruct);
796           },
797           [&](const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
798             genOMP(converter, eval, atomicConstruct);
799           },
800           [&](const Fortran::parser::OpenMPCriticalConstruct
801                   &criticalConstruct) {
802             genOMP(converter, eval, criticalConstruct);
803           },
804       },
805       ompConstruct.u);
806 }
807 
808 void Fortran::lower::genOpenMPDeclarativeConstruct(
809     Fortran::lower::AbstractConverter &converter,
810     Fortran::lower::pft::Evaluation &eval,
811     const Fortran::parser::OpenMPDeclarativeConstruct &ompDeclConstruct) {
812 
813   std::visit(
814       common::visitors{
815           [&](const Fortran::parser::OpenMPDeclarativeAllocate
816                   &declarativeAllocate) {
817             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
818           },
819           [&](const Fortran::parser::OpenMPDeclareReductionConstruct
820                   &declareReductionConstruct) {
821             TODO(converter.getCurrentLocation(),
822                  "OpenMPDeclareReductionConstruct");
823           },
824           [&](const Fortran::parser::OpenMPDeclareSimdConstruct
825                   &declareSimdConstruct) {
826             TODO(converter.getCurrentLocation(), "OpenMPDeclareSimdConstruct");
827           },
828           [&](const Fortran::parser::OpenMPDeclareTargetConstruct
829                   &declareTargetConstruct) {
830             TODO(converter.getCurrentLocation(),
831                  "OpenMPDeclareTargetConstruct");
832           },
833           [&](const Fortran::parser::OpenMPThreadprivate &threadprivate) {
834             TODO(converter.getCurrentLocation(), "OpenMPThreadprivate");
835           },
836       },
837       ompDeclConstruct.u);
838 }
839