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                bool outerCombined = false) {
117   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
118   firOpBuilder.createBlock(&op.getRegion());
119   auto &block = op.getRegion().back();
120   firOpBuilder.setInsertionPointToStart(&block);
121   // Ensure the block is well-formed.
122   firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
123   // Reset the insertion point to the start of the first block.
124   firOpBuilder.setInsertionPointToStart(&block);
125   // Handle privatization. Do not privatize if this is the outer operation.
126   if (clauses && !outerCombined)
127     privatizeVars(converter, *clauses);
128 }
129 
130 static void genOMP(Fortran::lower::AbstractConverter &converter,
131                    Fortran::lower::pft::Evaluation &eval,
132                    const Fortran::parser::OpenMPSimpleStandaloneConstruct
133                        &simpleStandaloneConstruct) {
134   const auto &directive =
135       std::get<Fortran::parser::OmpSimpleStandaloneDirective>(
136           simpleStandaloneConstruct.t);
137   switch (directive.v) {
138   default:
139     break;
140   case llvm::omp::Directive::OMPD_barrier:
141     converter.getFirOpBuilder().create<mlir::omp::BarrierOp>(
142         converter.getCurrentLocation());
143     break;
144   case llvm::omp::Directive::OMPD_taskwait:
145     converter.getFirOpBuilder().create<mlir::omp::TaskwaitOp>(
146         converter.getCurrentLocation());
147     break;
148   case llvm::omp::Directive::OMPD_taskyield:
149     converter.getFirOpBuilder().create<mlir::omp::TaskyieldOp>(
150         converter.getCurrentLocation());
151     break;
152   case llvm::omp::Directive::OMPD_target_enter_data:
153     TODO(converter.getCurrentLocation(), "OMPD_target_enter_data");
154   case llvm::omp::Directive::OMPD_target_exit_data:
155     TODO(converter.getCurrentLocation(), "OMPD_target_exit_data");
156   case llvm::omp::Directive::OMPD_target_update:
157     TODO(converter.getCurrentLocation(), "OMPD_target_update");
158   case llvm::omp::Directive::OMPD_ordered:
159     TODO(converter.getCurrentLocation(), "OMPD_ordered");
160   }
161 }
162 
163 static void
164 genAllocateClause(Fortran::lower::AbstractConverter &converter,
165                   const Fortran::parser::OmpAllocateClause &ompAllocateClause,
166                   SmallVector<Value> &allocatorOperands,
167                   SmallVector<Value> &allocateOperands) {
168   auto &firOpBuilder = converter.getFirOpBuilder();
169   auto currentLocation = converter.getCurrentLocation();
170   Fortran::lower::StatementContext stmtCtx;
171 
172   mlir::Value allocatorOperand;
173   const Fortran::parser::OmpObjectList &ompObjectList =
174       std::get<Fortran::parser::OmpObjectList>(ompAllocateClause.t);
175   const auto &allocatorValue =
176       std::get<std::optional<Fortran::parser::OmpAllocateClause::Allocator>>(
177           ompAllocateClause.t);
178   // Check if allocate clause has allocator specified. If so, add it
179   // to list of allocators, otherwise, add default allocator to
180   // list of allocators.
181   if (allocatorValue) {
182     allocatorOperand = fir::getBase(converter.genExprValue(
183         *Fortran::semantics::GetExpr(allocatorValue->v), stmtCtx));
184     allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(),
185                              allocatorOperand);
186   } else {
187     allocatorOperand = firOpBuilder.createIntegerConstant(
188         currentLocation, firOpBuilder.getI32Type(), 1);
189     allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(),
190                              allocatorOperand);
191   }
192   genObjectList(ompObjectList, converter, allocateOperands);
193 }
194 
195 static void
196 genOMP(Fortran::lower::AbstractConverter &converter,
197        Fortran::lower::pft::Evaluation &eval,
198        const Fortran::parser::OpenMPStandaloneConstruct &standaloneConstruct) {
199   std::visit(
200       Fortran::common::visitors{
201           [&](const Fortran::parser::OpenMPSimpleStandaloneConstruct
202                   &simpleStandaloneConstruct) {
203             genOMP(converter, eval, simpleStandaloneConstruct);
204           },
205           [&](const Fortran::parser::OpenMPFlushConstruct &flushConstruct) {
206             SmallVector<Value, 4> operandRange;
207             if (const auto &ompObjectList =
208                     std::get<std::optional<Fortran::parser::OmpObjectList>>(
209                         flushConstruct.t))
210               genObjectList(*ompObjectList, converter, operandRange);
211             const auto &memOrderClause = std::get<std::optional<
212                 std::list<Fortran::parser::OmpMemoryOrderClause>>>(
213                 flushConstruct.t);
214             if (memOrderClause.has_value() && memOrderClause->size() > 0)
215               TODO(converter.getCurrentLocation(),
216                    "Handle OmpMemoryOrderClause");
217             converter.getFirOpBuilder().create<mlir::omp::FlushOp>(
218                 converter.getCurrentLocation(), operandRange);
219           },
220           [&](const Fortran::parser::OpenMPCancelConstruct &cancelConstruct) {
221             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
222           },
223           [&](const Fortran::parser::OpenMPCancellationPointConstruct
224                   &cancellationPointConstruct) {
225             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
226           },
227       },
228       standaloneConstruct.u);
229 }
230 
231 static void
232 genOMP(Fortran::lower::AbstractConverter &converter,
233        Fortran::lower::pft::Evaluation &eval,
234        const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
235   const auto &beginBlockDirective =
236       std::get<Fortran::parser::OmpBeginBlockDirective>(blockConstruct.t);
237   const auto &blockDirective =
238       std::get<Fortran::parser::OmpBlockDirective>(beginBlockDirective.t);
239   const auto &endBlockDirective =
240       std::get<Fortran::parser::OmpEndBlockDirective>(blockConstruct.t);
241   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
242   mlir::Location currentLocation = converter.getCurrentLocation();
243 
244   Fortran::lower::StatementContext stmtCtx;
245   llvm::ArrayRef<mlir::Type> argTy;
246   mlir::Value ifClauseOperand, numThreadsClauseOperand;
247   mlir::omp::ClauseProcBindKindAttr procBindKindAttr;
248   SmallVector<Value> allocateOperands, allocatorOperands;
249   mlir::UnitAttr nowaitAttr;
250 
251   const auto &opClauseList =
252       std::get<Fortran::parser::OmpClauseList>(beginBlockDirective.t);
253   for (const auto &clause : opClauseList.v) {
254     if (const auto &ifClause =
255             std::get_if<Fortran::parser::OmpClause::If>(&clause.u)) {
256       auto &expr = std::get<Fortran::parser::ScalarLogicalExpr>(ifClause->v.t);
257       mlir::Value ifVal = fir::getBase(
258           converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
259       ifClauseOperand = firOpBuilder.createConvert(
260           currentLocation, firOpBuilder.getI1Type(), ifVal);
261     } else if (const auto &numThreadsClause =
262                    std::get_if<Fortran::parser::OmpClause::NumThreads>(
263                        &clause.u)) {
264       // OMPIRBuilder expects `NUM_THREAD` clause as a `Value`.
265       numThreadsClauseOperand = fir::getBase(converter.genExprValue(
266           *Fortran::semantics::GetExpr(numThreadsClause->v), stmtCtx));
267     } else if (const auto &procBindClause =
268                    std::get_if<Fortran::parser::OmpClause::ProcBind>(
269                        &clause.u)) {
270       omp::ClauseProcBindKind pbKind;
271       switch (procBindClause->v.v) {
272       case Fortran::parser::OmpProcBindClause::Type::Master:
273         pbKind = omp::ClauseProcBindKind::Master;
274         break;
275       case Fortran::parser::OmpProcBindClause::Type::Close:
276         pbKind = omp::ClauseProcBindKind::Close;
277         break;
278       case Fortran::parser::OmpProcBindClause::Type::Spread:
279         pbKind = omp::ClauseProcBindKind::Spread;
280         break;
281       case Fortran::parser::OmpProcBindClause::Type::Primary:
282         pbKind = omp::ClauseProcBindKind::Primary;
283         break;
284       }
285       procBindKindAttr =
286           omp::ClauseProcBindKindAttr::get(firOpBuilder.getContext(), pbKind);
287     } else if (const auto &allocateClause =
288                    std::get_if<Fortran::parser::OmpClause::Allocate>(
289                        &clause.u)) {
290       genAllocateClause(converter, allocateClause->v, allocatorOperands,
291                         allocateOperands);
292     } else if (std::get_if<Fortran::parser::OmpClause::Private>(&clause.u) ||
293                std::get_if<Fortran::parser::OmpClause::Firstprivate>(
294                    &clause.u)) {
295       // Privatisation clauses are handled elsewhere.
296       continue;
297     } else if (std::get_if<Fortran::parser::OmpClause::Threads>(&clause.u)) {
298       // Nothing needs to be done for threads clause.
299       continue;
300     } else {
301       TODO(currentLocation, "OpenMP Block construct clauses");
302     }
303   }
304 
305   for (const auto &clause :
306        std::get<Fortran::parser::OmpClauseList>(endBlockDirective.t).v) {
307     if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u))
308       nowaitAttr = firOpBuilder.getUnitAttr();
309   }
310 
311   if (blockDirective.v == llvm::omp::OMPD_parallel) {
312     // Create and insert the operation.
313     auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
314         currentLocation, argTy, ifClauseOperand, numThreadsClauseOperand,
315         allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(),
316         /*reductions=*/nullptr, procBindKindAttr);
317     createBodyOfOp<omp::ParallelOp>(parallelOp, converter, currentLocation,
318                                     &opClauseList, /*isCombined=*/false);
319   } else if (blockDirective.v == llvm::omp::OMPD_master) {
320     auto masterOp =
321         firOpBuilder.create<mlir::omp::MasterOp>(currentLocation, argTy);
322     createBodyOfOp<omp::MasterOp>(masterOp, converter, currentLocation);
323   } else if (blockDirective.v == llvm::omp::OMPD_single) {
324     auto singleOp = firOpBuilder.create<mlir::omp::SingleOp>(
325         currentLocation, allocateOperands, allocatorOperands, nowaitAttr);
326     createBodyOfOp<omp::SingleOp>(singleOp, converter, currentLocation);
327   } else if (blockDirective.v == llvm::omp::OMPD_ordered) {
328     auto orderedOp = firOpBuilder.create<mlir::omp::OrderedRegionOp>(
329         currentLocation, /*simd=*/nullptr);
330     createBodyOfOp<omp::OrderedRegionOp>(orderedOp, converter, currentLocation);
331   } else {
332     TODO(converter.getCurrentLocation(), "Unhandled block directive");
333   }
334 }
335 
336 static void
337 genOMP(Fortran::lower::AbstractConverter &converter,
338        Fortran::lower::pft::Evaluation &eval,
339        const Fortran::parser::OpenMPCriticalConstruct &criticalConstruct) {
340   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
341   mlir::Location currentLocation = converter.getCurrentLocation();
342   std::string name;
343   const Fortran::parser::OmpCriticalDirective &cd =
344       std::get<Fortran::parser::OmpCriticalDirective>(criticalConstruct.t);
345   if (std::get<std::optional<Fortran::parser::Name>>(cd.t).has_value()) {
346     name =
347         std::get<std::optional<Fortran::parser::Name>>(cd.t).value().ToString();
348   }
349 
350   uint64_t hint = 0;
351   const auto &clauseList = std::get<Fortran::parser::OmpClauseList>(cd.t);
352   for (const Fortran::parser::OmpClause &clause : clauseList.v)
353     if (auto hintClause =
354             std::get_if<Fortran::parser::OmpClause::Hint>(&clause.u)) {
355       const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
356       hint = *Fortran::evaluate::ToInt64(*expr);
357       break;
358     }
359 
360   mlir::omp::CriticalOp criticalOp = [&]() {
361     if (name.empty()) {
362       return firOpBuilder.create<mlir::omp::CriticalOp>(currentLocation,
363                                                         FlatSymbolRefAttr());
364     } else {
365       mlir::ModuleOp module = firOpBuilder.getModule();
366       mlir::OpBuilder modBuilder(module.getBodyRegion());
367       auto global = module.lookupSymbol<mlir::omp::CriticalDeclareOp>(name);
368       if (!global)
369         global = modBuilder.create<mlir::omp::CriticalDeclareOp>(
370             currentLocation, name, hint);
371       return firOpBuilder.create<mlir::omp::CriticalOp>(
372           currentLocation, mlir::FlatSymbolRefAttr::get(
373                                firOpBuilder.getContext(), global.sym_name()));
374     }
375   }();
376   createBodyOfOp<omp::CriticalOp>(criticalOp, converter, currentLocation);
377 }
378 
379 static void
380 genOMP(Fortran::lower::AbstractConverter &converter,
381        Fortran::lower::pft::Evaluation &eval,
382        const Fortran::parser::OpenMPSectionConstruct &sectionConstruct) {
383 
384   auto &firOpBuilder = converter.getFirOpBuilder();
385   auto currentLocation = converter.getCurrentLocation();
386   mlir::omp::SectionOp sectionOp =
387       firOpBuilder.create<mlir::omp::SectionOp>(currentLocation);
388   createBodyOfOp<omp::SectionOp>(sectionOp, converter, currentLocation);
389 }
390 
391 // TODO: Add support for reduction
392 static void
393 genOMP(Fortran::lower::AbstractConverter &converter,
394        Fortran::lower::pft::Evaluation &eval,
395        const Fortran::parser::OpenMPSectionsConstruct &sectionsConstruct) {
396   auto &firOpBuilder = converter.getFirOpBuilder();
397   auto currentLocation = converter.getCurrentLocation();
398   SmallVector<Value> reductionVars, allocateOperands, allocatorOperands;
399   mlir::UnitAttr noWaitClauseOperand;
400   const auto &sectionsClauseList = std::get<Fortran::parser::OmpClauseList>(
401       std::get<Fortran::parser::OmpBeginSectionsDirective>(sectionsConstruct.t)
402           .t);
403   for (const Fortran::parser::OmpClause &clause : sectionsClauseList.v) {
404 
405     // Reduction Clause
406     if (std::get_if<Fortran::parser::OmpClause::Reduction>(&clause.u)) {
407       TODO(currentLocation, "OMPC_Reduction");
408 
409       // Allocate clause
410     } else if (const auto &allocateClause =
411                    std::get_if<Fortran::parser::OmpClause::Allocate>(
412                        &clause.u)) {
413       genAllocateClause(converter, allocateClause->v, allocatorOperands,
414                         allocateOperands);
415     }
416   }
417   const auto &endSectionsClauseList =
418       std::get<Fortran::parser::OmpEndSectionsDirective>(sectionsConstruct.t);
419   const auto &clauseList =
420       std::get<Fortran::parser::OmpClauseList>(endSectionsClauseList.t);
421   for (const auto &clause : clauseList.v) {
422     // Nowait clause
423     if (std::get_if<Fortran::parser::OmpClause::Nowait>(&clause.u)) {
424       noWaitClauseOperand = firOpBuilder.getUnitAttr();
425     }
426   }
427 
428   llvm::omp::Directive dir =
429       std::get<Fortran::parser::OmpSectionsDirective>(
430           std::get<Fortran::parser::OmpBeginSectionsDirective>(
431               sectionsConstruct.t)
432               .t)
433           .v;
434 
435   // Parallel Sections Construct
436   if (dir == llvm::omp::Directive::OMPD_parallel_sections) {
437     auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
438         currentLocation, /*if_expr_var*/ nullptr, /*num_threads_var*/ nullptr,
439         allocateOperands, allocatorOperands, /*reduction_vars=*/ValueRange(),
440         /*reductions=*/nullptr, /*proc_bind_val*/ nullptr);
441     createBodyOfOp(parallelOp, converter, currentLocation);
442     auto sectionsOp = firOpBuilder.create<mlir::omp::SectionsOp>(
443         currentLocation, /*reduction_vars*/ ValueRange(),
444         /*reductions=*/nullptr, /*allocate_vars*/ ValueRange(),
445         /*allocators_vars*/ ValueRange(), /*nowait=*/nullptr);
446     createBodyOfOp(sectionsOp, converter, currentLocation);
447 
448     // Sections Construct
449   } else if (dir == llvm::omp::Directive::OMPD_sections) {
450     auto sectionsOp = firOpBuilder.create<mlir::omp::SectionsOp>(
451         currentLocation, reductionVars, /*reductions = */ nullptr,
452         allocateOperands, allocatorOperands, noWaitClauseOperand);
453     createBodyOfOp<omp::SectionsOp>(sectionsOp, converter, currentLocation);
454   }
455 }
456 
457 static void genOmpAtomicHintAndMemoryOrderClauses(
458     Fortran::lower::AbstractConverter &converter,
459     const Fortran::parser::OmpAtomicClauseList &clauseList,
460     mlir::IntegerAttr &hint,
461     mlir::omp::ClauseMemoryOrderKindAttr &memory_order) {
462   auto &firOpBuilder = converter.getFirOpBuilder();
463   for (const auto &clause : clauseList.v) {
464     if (auto ompClause = std::get_if<Fortran::parser::OmpClause>(&clause.u)) {
465       if (auto hintClause =
466               std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u)) {
467         const auto *expr = Fortran::semantics::GetExpr(hintClause->v);
468         uint64_t hintExprValue = *Fortran::evaluate::ToInt64(*expr);
469         hint = firOpBuilder.getI64IntegerAttr(hintExprValue);
470       }
471     } else if (auto ompMemoryOrderClause =
472                    std::get_if<Fortran::parser::OmpMemoryOrderClause>(
473                        &clause.u)) {
474       if (std::get_if<Fortran::parser::OmpClause::Acquire>(
475               &ompMemoryOrderClause->v.u)) {
476         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
477             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Acquire);
478       } else if (std::get_if<Fortran::parser::OmpClause::Relaxed>(
479                      &ompMemoryOrderClause->v.u)) {
480         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
481             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Relaxed);
482       } else if (std::get_if<Fortran::parser::OmpClause::SeqCst>(
483                      &ompMemoryOrderClause->v.u)) {
484         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
485             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Seq_cst);
486       } else if (std::get_if<Fortran::parser::OmpClause::Release>(
487                      &ompMemoryOrderClause->v.u)) {
488         memory_order = mlir::omp::ClauseMemoryOrderKindAttr::get(
489             firOpBuilder.getContext(), omp::ClauseMemoryOrderKind::Release);
490       }
491     }
492   }
493 }
494 
495 static void
496 genOmpAtomicWrite(Fortran::lower::AbstractConverter &converter,
497                   Fortran::lower::pft::Evaluation &eval,
498                   const Fortran::parser::OmpAtomicWrite &atomicWrite) {
499   auto &firOpBuilder = converter.getFirOpBuilder();
500   auto currentLocation = converter.getCurrentLocation();
501   mlir::Value address;
502   // If no hint clause is specified, the effect is as if
503   // hint(omp_sync_hint_none) had been specified.
504   mlir::IntegerAttr hint = nullptr;
505   mlir::omp::ClauseMemoryOrderKindAttr memory_order = nullptr;
506   const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
507       std::get<2>(atomicWrite.t);
508   const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
509       std::get<0>(atomicWrite.t);
510   const auto &assignmentStmtExpr =
511       std::get<Fortran::parser::Expr>(std::get<3>(atomicWrite.t).statement.t);
512   const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
513       std::get<3>(atomicWrite.t).statement.t);
514   Fortran::lower::StatementContext stmtCtx;
515   auto value = fir::getBase(converter.genExprValue(
516       *Fortran::semantics::GetExpr(assignmentStmtExpr), stmtCtx));
517   if (auto varDesignator = std::get_if<
518           Fortran::common::Indirection<Fortran::parser::Designator>>(
519           &assignmentStmtVariable.u)) {
520     if (const auto *name = getDesignatorNameIfDataRef(varDesignator->value())) {
521       address = converter.getSymbolAddress(*name->symbol);
522     }
523   }
524 
525   genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
526                                         memory_order);
527   genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
528                                         memory_order);
529   firOpBuilder.create<mlir::omp::AtomicWriteOp>(currentLocation, address, value,
530                                                 hint, memory_order);
531 }
532 
533 static void genOmpAtomicRead(Fortran::lower::AbstractConverter &converter,
534                              Fortran::lower::pft::Evaluation &eval,
535                              const Fortran::parser::OmpAtomicRead &atomicRead) {
536   auto &firOpBuilder = converter.getFirOpBuilder();
537   auto currentLocation = converter.getCurrentLocation();
538   mlir::Value to_address;
539   mlir::Value from_address;
540   // If no hint clause is specified, the effect is as if
541   // hint(omp_sync_hint_none) had been specified.
542   mlir::IntegerAttr hint = nullptr;
543   mlir::omp::ClauseMemoryOrderKindAttr memory_order = nullptr;
544   const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
545       std::get<2>(atomicRead.t);
546   const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
547       std::get<0>(atomicRead.t);
548   const auto &assignmentStmtExpr =
549       std::get<Fortran::parser::Expr>(std::get<3>(atomicRead.t).statement.t);
550   const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
551       std::get<3>(atomicRead.t).statement.t);
552   if (auto exprDesignator = std::get_if<
553           Fortran::common::Indirection<Fortran::parser::Designator>>(
554           &assignmentStmtExpr.u)) {
555     if (const auto *name =
556             getDesignatorNameIfDataRef(exprDesignator->value())) {
557       from_address = converter.getSymbolAddress(*name->symbol);
558     }
559   }
560 
561   if (auto varDesignator = std::get_if<
562           Fortran::common::Indirection<Fortran::parser::Designator>>(
563           &assignmentStmtVariable.u)) {
564     if (const auto *name = getDesignatorNameIfDataRef(varDesignator->value())) {
565       to_address = converter.getSymbolAddress(*name->symbol);
566     }
567   }
568 
569   genOmpAtomicHintAndMemoryOrderClauses(converter, leftHandClauseList, hint,
570                                         memory_order);
571   genOmpAtomicHintAndMemoryOrderClauses(converter, rightHandClauseList, hint,
572                                         memory_order);
573   firOpBuilder.create<mlir::omp::AtomicReadOp>(currentLocation, from_address,
574                                                to_address, hint, memory_order);
575 }
576 
577 static void
578 genOMP(Fortran::lower::AbstractConverter &converter,
579        Fortran::lower::pft::Evaluation &eval,
580        const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
581   std::visit(Fortran::common::visitors{
582                  [&](const Fortran::parser::OmpAtomicRead &atomicRead) {
583                    genOmpAtomicRead(converter, eval, atomicRead);
584                  },
585                  [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) {
586                    genOmpAtomicWrite(converter, eval, atomicWrite);
587                  },
588                  [&](const auto &) {
589                    TODO(converter.getCurrentLocation(),
590                         "Atomic update & capture");
591                  },
592              },
593              atomicConstruct.u);
594 }
595 
596 void Fortran::lower::genOpenMPConstruct(
597     Fortran::lower::AbstractConverter &converter,
598     Fortran::lower::pft::Evaluation &eval,
599     const Fortran::parser::OpenMPConstruct &ompConstruct) {
600 
601   std::visit(
602       common::visitors{
603           [&](const Fortran::parser::OpenMPStandaloneConstruct
604                   &standaloneConstruct) {
605             genOMP(converter, eval, standaloneConstruct);
606           },
607           [&](const Fortran::parser::OpenMPSectionsConstruct
608                   &sectionsConstruct) {
609             genOMP(converter, eval, sectionsConstruct);
610           },
611           [&](const Fortran::parser::OpenMPSectionConstruct &sectionConstruct) {
612             genOMP(converter, eval, sectionConstruct);
613           },
614           [&](const Fortran::parser::OpenMPLoopConstruct &loopConstruct) {
615             TODO(converter.getCurrentLocation(), "OpenMPLoopConstruct");
616           },
617           [&](const Fortran::parser::OpenMPDeclarativeAllocate
618                   &execAllocConstruct) {
619             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
620           },
621           [&](const Fortran::parser::OpenMPExecutableAllocate
622                   &execAllocConstruct) {
623             TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate");
624           },
625           [&](const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
626             genOMP(converter, eval, blockConstruct);
627           },
628           [&](const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
629             genOMP(converter, eval, atomicConstruct);
630           },
631           [&](const Fortran::parser::OpenMPCriticalConstruct
632                   &criticalConstruct) {
633             genOMP(converter, eval, criticalConstruct);
634           },
635       },
636       ompConstruct.u);
637 }
638 
639 void Fortran::lower::genOpenMPDeclarativeConstruct(
640     Fortran::lower::AbstractConverter &converter,
641     Fortran::lower::pft::Evaluation &eval,
642     const Fortran::parser::OpenMPDeclarativeConstruct &ompDeclConstruct) {
643 
644   std::visit(
645       common::visitors{
646           [&](const Fortran::parser::OpenMPDeclarativeAllocate
647                   &declarativeAllocate) {
648             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
649           },
650           [&](const Fortran::parser::OpenMPDeclareReductionConstruct
651                   &declareReductionConstruct) {
652             TODO(converter.getCurrentLocation(),
653                  "OpenMPDeclareReductionConstruct");
654           },
655           [&](const Fortran::parser::OpenMPDeclareSimdConstruct
656                   &declareSimdConstruct) {
657             TODO(converter.getCurrentLocation(), "OpenMPDeclareSimdConstruct");
658           },
659           [&](const Fortran::parser::OpenMPDeclareTargetConstruct
660                   &declareTargetConstruct) {
661             TODO(converter.getCurrentLocation(),
662                  "OpenMPDeclareTargetConstruct");
663           },
664           [&](const Fortran::parser::OpenMPThreadprivate &threadprivate) {
665             TODO(converter.getCurrentLocation(), "OpenMPThreadprivate");
666           },
667       },
668       ompDeclConstruct.u);
669 }
670