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 *
getDesignatorNameIfDataRef(const Fortran::parser::Designator & designator)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
genObjectList(const Fortran::parser::OmpObjectList & objectList,Fortran::lower::AbstractConverter & converter,SmallVectorImpl<Value> & operands)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>
createBodyOfOp(Op & op,Fortran::lower::FirOpBuilder & firOpBuilder,mlir::Location & loc)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
genOMP(Fortran::lower::AbstractConverter & converter,Fortran::lower::pft::Evaluation & eval,const Fortran::parser::OpenMPSimpleStandaloneConstruct & simpleStandaloneConstruct)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
genOMP(Fortran::lower::AbstractConverter & converter,Fortran::lower::pft::Evaluation & eval,const Fortran::parser::OpenMPStandaloneConstruct & standaloneConstruct)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
genOMP(Fortran::lower::AbstractConverter & converter,Fortran::lower::pft::Evaluation & eval,const Fortran::parser::OpenMPBlockConstruct & blockConstruct)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 ¶llelOpClauseList =
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 ©inClause =
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
genOpenMPConstruct(Fortran::lower::AbstractConverter & converter,Fortran::lower::pft::Evaluation & eval,const Fortran::parser::OpenMPConstruct & ompConstruct)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 §ionsConstruct) {
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