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/FIRBuilder.h"
17 #include "flang/Lower/PFTBuilder.h"
18 #include "flang/Lower/Support/BoxValue.h"
19 #include "flang/Lower/Todo.h"
20 #include "flang/Parser/parse-tree.h"
21 #include "flang/Semantics/tools.h"
22 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
23 #include "llvm/Frontend/OpenMP/OMPConstants.h"
24 
25 static const Fortran::parser::Name *
26 getDesignatorNameIfDataRef(const Fortran::parser::Designator &designator) {
27   const auto *dataRef = std::get_if<Fortran::parser::DataRef>(&designator.u);
28   return dataRef ? std::get_if<Fortran::parser::Name>(&dataRef->u) : nullptr;
29 }
30 
31 static void genObjectList(const Fortran::parser::OmpObjectList &objectList,
32                           Fortran::lower::AbstractConverter &converter,
33                           SmallVectorImpl<Value> &operands) {
34   for (const auto &ompObject : objectList.v) {
35     std::visit(
36         Fortran::common::visitors{
37             [&](const Fortran::parser::Designator &designator) {
38               if (const auto *name = getDesignatorNameIfDataRef(designator)) {
39                 const auto variable = converter.getSymbolAddress(*name->symbol);
40                 operands.push_back(variable);
41               }
42             },
43             [&](const Fortran::parser::Name &name) {
44               const auto variable = converter.getSymbolAddress(*name.symbol);
45               operands.push_back(variable);
46             }},
47         ompObject.u);
48   }
49 }
50 
51 template <typename Op>
52 static void createBodyOfOp(Op &op, Fortran::lower::FirOpBuilder &firOpBuilder,
53                            mlir::Location &loc) {
54   firOpBuilder.createBlock(&op.getRegion());
55   auto &block = op.getRegion().back();
56   firOpBuilder.setInsertionPointToStart(&block);
57   // Ensure the block is well-formed.
58   firOpBuilder.create<mlir::omp::TerminatorOp>(loc);
59   // Reset the insertion point to the start of the first block.
60   firOpBuilder.setInsertionPointToStart(&block);
61 }
62 
63 static void genOMP(Fortran::lower::AbstractConverter &converter,
64                    Fortran::lower::pft::Evaluation &eval,
65                    const Fortran::parser::OpenMPSimpleStandaloneConstruct
66                        &simpleStandaloneConstruct) {
67   const auto &directive =
68       std::get<Fortran::parser::OmpSimpleStandaloneDirective>(
69           simpleStandaloneConstruct.t);
70   switch (directive.v) {
71   default:
72     break;
73   case llvm::omp::Directive::OMPD_barrier:
74     converter.getFirOpBuilder().create<mlir::omp::BarrierOp>(
75         converter.getCurrentLocation());
76     break;
77   case llvm::omp::Directive::OMPD_taskwait:
78     converter.getFirOpBuilder().create<mlir::omp::TaskwaitOp>(
79         converter.getCurrentLocation());
80     break;
81   case llvm::omp::Directive::OMPD_taskyield:
82     converter.getFirOpBuilder().create<mlir::omp::TaskyieldOp>(
83         converter.getCurrentLocation());
84     break;
85   case llvm::omp::Directive::OMPD_target_enter_data:
86     TODO(converter.getCurrentLocation(), "OMPD_target_enter_data");
87   case llvm::omp::Directive::OMPD_target_exit_data:
88     TODO(converter.getCurrentLocation(), "OMPD_target_exit_data");
89   case llvm::omp::Directive::OMPD_target_update:
90     TODO(converter.getCurrentLocation(), "OMPD_target_update");
91   case llvm::omp::Directive::OMPD_ordered:
92     TODO(converter.getCurrentLocation(), "OMPD_ordered");
93   }
94 }
95 
96 static void
97 genOMP(Fortran::lower::AbstractConverter &converter,
98        Fortran::lower::pft::Evaluation &eval,
99        const Fortran::parser::OpenMPStandaloneConstruct &standaloneConstruct) {
100   std::visit(
101       Fortran::common::visitors{
102           [&](const Fortran::parser::OpenMPSimpleStandaloneConstruct
103                   &simpleStandaloneConstruct) {
104             genOMP(converter, eval, simpleStandaloneConstruct);
105           },
106           [&](const Fortran::parser::OpenMPFlushConstruct &flushConstruct) {
107             SmallVector<Value, 4> operandRange;
108             if (const auto &ompObjectList =
109                     std::get<std::optional<Fortran::parser::OmpObjectList>>(
110                         flushConstruct.t))
111               genObjectList(*ompObjectList, converter, operandRange);
112             if (std::get<std::optional<
113                     std::list<Fortran::parser::OmpMemoryOrderClause>>>(
114                     flushConstruct.t))
115               TODO(converter.getCurrentLocation(),
116                    "Handle OmpMemoryOrderClause");
117             converter.getFirOpBuilder().create<mlir::omp::FlushOp>(
118                 converter.getCurrentLocation(), operandRange);
119           },
120           [&](const Fortran::parser::OpenMPCancelConstruct &cancelConstruct) {
121             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
122           },
123           [&](const Fortran::parser::OpenMPCancellationPointConstruct
124                   &cancellationPointConstruct) {
125             TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct");
126           },
127       },
128       standaloneConstruct.u);
129 }
130 
131 static void
132 genOMP(Fortran::lower::AbstractConverter &converter,
133        Fortran::lower::pft::Evaluation &eval,
134        const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
135   const auto &beginBlockDirective =
136       std::get<Fortran::parser::OmpBeginBlockDirective>(blockConstruct.t);
137   const auto &blockDirective =
138       std::get<Fortran::parser::OmpBlockDirective>(beginBlockDirective.t);
139 
140   auto &firOpBuilder = converter.getFirOpBuilder();
141   auto currentLocation = converter.getCurrentLocation();
142   llvm::ArrayRef<mlir::Type> argTy;
143   if (blockDirective.v == llvm::omp::OMPD_parallel) {
144 
145     mlir::Value ifClauseOperand, numThreadsClauseOperand;
146     SmallVector<Value, 4> privateClauseOperands, firstprivateClauseOperands,
147         sharedClauseOperands, copyinClauseOperands;
148     Attribute defaultClauseOperand, procBindClauseOperand;
149 
150     const auto &parallelOpClauseList =
151         std::get<Fortran::parser::OmpClauseList>(beginBlockDirective.t);
152     for (const auto &clause : parallelOpClauseList.v) {
153       if (const auto &ifClause =
154               std::get_if<Fortran::parser::OmpClause::If>(&clause.u)) {
155         auto &expr =
156             std::get<Fortran::parser::ScalarLogicalExpr>(ifClause->v.t);
157         ifClauseOperand = fir::getBase(
158             converter.genExprValue(*Fortran::semantics::GetExpr(expr)));
159       } else if (const auto &numThreadsClause =
160                      std::get_if<Fortran::parser::OmpClause::NumThreads>(
161                          &clause.u)) {
162         // OMPIRBuilder expects `NUM_THREAD` clause as a `Value`.
163         numThreadsClauseOperand = fir::getBase(converter.genExprValue(
164             *Fortran::semantics::GetExpr(numThreadsClause->v)));
165       } else if (const auto &privateClause =
166                      std::get_if<Fortran::parser::OmpClause::Private>(
167                          &clause.u)) {
168         const Fortran::parser::OmpObjectList &ompObjectList = privateClause->v;
169         genObjectList(ompObjectList, converter, privateClauseOperands);
170       } else if (const auto &firstprivateClause =
171                      std::get_if<Fortran::parser::OmpClause::Firstprivate>(
172                          &clause.u)) {
173         const Fortran::parser::OmpObjectList &ompObjectList =
174             firstprivateClause->v;
175         genObjectList(ompObjectList, converter, firstprivateClauseOperands);
176       } else if (const auto &sharedClause =
177                      std::get_if<Fortran::parser::OmpClause::Shared>(
178                          &clause.u)) {
179         const Fortran::parser::OmpObjectList &ompObjectList = sharedClause->v;
180         genObjectList(ompObjectList, converter, sharedClauseOperands);
181       } else if (const auto &copyinClause =
182                      std::get_if<Fortran::parser::OmpClause::Copyin>(
183                          &clause.u)) {
184         const Fortran::parser::OmpObjectList &ompObjectList = copyinClause->v;
185         genObjectList(ompObjectList, converter, copyinClauseOperands);
186       }
187     }
188     // Create and insert the operation.
189     auto parallelOp = firOpBuilder.create<mlir::omp::ParallelOp>(
190         currentLocation, argTy, ifClauseOperand, numThreadsClauseOperand,
191         defaultClauseOperand.dyn_cast_or_null<StringAttr>(),
192         privateClauseOperands, firstprivateClauseOperands, sharedClauseOperands,
193         copyinClauseOperands, ValueRange(), ValueRange(),
194         procBindClauseOperand.dyn_cast_or_null<StringAttr>());
195     // Handle attribute based clauses.
196     for (const auto &clause : parallelOpClauseList.v) {
197       if (const auto &defaultClause =
198               std::get_if<Fortran::parser::OmpClause::Default>(&clause.u)) {
199         const auto &ompDefaultClause{defaultClause->v};
200         switch (ompDefaultClause.v) {
201         case Fortran::parser::OmpDefaultClause::Type::Private:
202           parallelOp.default_valAttr(firOpBuilder.getStringAttr(
203               omp::stringifyClauseDefault(omp::ClauseDefault::defprivate)));
204           break;
205         case Fortran::parser::OmpDefaultClause::Type::Firstprivate:
206           parallelOp.default_valAttr(
207               firOpBuilder.getStringAttr(omp::stringifyClauseDefault(
208                   omp::ClauseDefault::deffirstprivate)));
209           break;
210         case Fortran::parser::OmpDefaultClause::Type::Shared:
211           parallelOp.default_valAttr(firOpBuilder.getStringAttr(
212               omp::stringifyClauseDefault(omp::ClauseDefault::defshared)));
213           break;
214         case Fortran::parser::OmpDefaultClause::Type::None:
215           parallelOp.default_valAttr(firOpBuilder.getStringAttr(
216               omp::stringifyClauseDefault(omp::ClauseDefault::defnone)));
217           break;
218         }
219       }
220       if (const auto &procBindClause =
221               std::get_if<Fortran::parser::OmpClause::ProcBind>(&clause.u)) {
222         const auto &ompProcBindClause{procBindClause->v};
223         switch (ompProcBindClause.v) {
224         case Fortran::parser::OmpProcBindClause::Type::Master:
225           parallelOp.proc_bind_valAttr(
226               firOpBuilder.getStringAttr(omp::stringifyClauseProcBindKind(
227                   omp::ClauseProcBindKind::master)));
228           break;
229         case Fortran::parser::OmpProcBindClause::Type::Close:
230           parallelOp.proc_bind_valAttr(
231               firOpBuilder.getStringAttr(omp::stringifyClauseProcBindKind(
232                   omp::ClauseProcBindKind::close)));
233           break;
234         case Fortran::parser::OmpProcBindClause::Type::Spread:
235           parallelOp.proc_bind_valAttr(
236               firOpBuilder.getStringAttr(omp::stringifyClauseProcBindKind(
237                   omp::ClauseProcBindKind::spread)));
238           break;
239         }
240       }
241     }
242     createBodyOfOp<omp::ParallelOp>(parallelOp, firOpBuilder, currentLocation);
243   } else if (blockDirective.v == llvm::omp::OMPD_master) {
244     auto masterOp =
245         firOpBuilder.create<mlir::omp::MasterOp>(currentLocation, argTy);
246     createBodyOfOp<omp::MasterOp>(masterOp, firOpBuilder, currentLocation);
247   }
248 }
249 
250 void Fortran::lower::genOpenMPConstruct(
251     Fortran::lower::AbstractConverter &converter,
252     Fortran::lower::pft::Evaluation &eval,
253     const Fortran::parser::OpenMPConstruct &ompConstruct) {
254 
255   std::visit(
256       common::visitors{
257           [&](const Fortran::parser::OpenMPStandaloneConstruct
258                   &standaloneConstruct) {
259             genOMP(converter, eval, standaloneConstruct);
260           },
261           [&](const Fortran::parser::OpenMPSectionsConstruct
262                   &sectionsConstruct) {
263             TODO(converter.getCurrentLocation(), "OpenMPSectionsConstruct");
264           },
265           [&](const Fortran::parser::OpenMPLoopConstruct &loopConstruct) {
266             TODO(converter.getCurrentLocation(), "OpenMPLoopConstruct");
267           },
268           [&](const Fortran::parser::OpenMPDeclarativeAllocate
269                   &execAllocConstruct) {
270             TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
271           },
272           [&](const Fortran::parser::OpenMPExecutableAllocate
273                   &execAllocConstruct) {
274             TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate");
275           },
276           [&](const Fortran::parser::OpenMPBlockConstruct &blockConstruct) {
277             genOMP(converter, eval, blockConstruct);
278           },
279           [&](const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
280             TODO(converter.getCurrentLocation(), "OpenMPAtomicConstruct");
281           },
282           [&](const Fortran::parser::OpenMPCriticalConstruct
283                   &criticalConstruct) {
284             TODO(converter.getCurrentLocation(), "OpenMPCriticalConstruct");
285           },
286       },
287       ompConstruct.u);
288 }
289