1 //===-- lib/Semantics/check-acc-structure.cpp -----------------------------===//
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 #include "check-acc-structure.h"
9 #include "flang/Parser/parse-tree.h"
10 #include "flang/Semantics/tools.h"
11 
12 #define CHECK_SIMPLE_CLAUSE(X, Y) \
13   void AccStructureChecker::Enter(const parser::AccClause::X &) { \
14     CheckAllowed(llvm::acc::Clause::Y); \
15   }
16 
17 #define CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(X, Y) \
18   void AccStructureChecker::Enter(const parser::AccClause::X &c) { \
19     CheckAllowed(llvm::acc::Clause::Y); \
20     RequiresConstantPositiveParameter(llvm::acc::Clause::Y, c.v); \
21   }
22 
23 namespace Fortran::semantics {
24 
25 static constexpr inline AccClauseSet
26     computeConstructOnlyAllowedAfterDeviceTypeClauses{
27         llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait,
28         llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_num_workers,
29         llvm::acc::Clause::ACCC_vector_length};
30 
31 static constexpr inline AccClauseSet loopOnlyAllowedAfterDeviceTypeClauses{
32     llvm::acc::Clause::ACCC_auto, llvm::acc::Clause::ACCC_collapse,
33     llvm::acc::Clause::ACCC_independent, llvm::acc::Clause::ACCC_gang,
34     llvm::acc::Clause::ACCC_seq, llvm::acc::Clause::ACCC_tile,
35     llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker};
36 
37 static constexpr inline AccClauseSet updateOnlyAllowedAfterDeviceTypeClauses{
38     llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait};
39 
40 static constexpr inline AccClauseSet routineOnlyAllowedAfterDeviceTypeClauses{
41     llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang,
42     llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker};
43 
44 bool AccStructureChecker::CheckAllowedModifier(llvm::acc::Clause clause) {
45   if (GetContext().directive == llvm::acc::ACCD_enter_data ||
46       GetContext().directive == llvm::acc::ACCD_exit_data) {
47     context_.Say(GetContext().clauseSource,
48         "Modifier is not allowed for the %s clause "
49         "on the %s directive"_err_en_US,
50         parser::ToUpperCaseLetters(getClauseName(clause).str()),
51         ContextDirectiveAsFortran());
52     return true;
53   }
54   return false;
55 }
56 
57 bool AccStructureChecker::IsComputeConstruct(
58     llvm::acc::Directive directive) const {
59   return directive == llvm::acc::ACCD_parallel ||
60       directive == llvm::acc::ACCD_parallel_loop ||
61       directive == llvm::acc::ACCD_serial ||
62       directive == llvm::acc::ACCD_serial_loop ||
63       directive == llvm::acc::ACCD_kernels ||
64       directive == llvm::acc::ACCD_kernels_loop;
65 }
66 
67 bool AccStructureChecker::IsInsideComputeConstruct() const {
68   if (dirContext_.size() <= 1) {
69     return false;
70   }
71 
72   // Check all nested context skipping the first one.
73   for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
74     if (IsComputeConstruct(dirContext_[i - 1].directive)) {
75       return true;
76     }
77   }
78   return false;
79 }
80 
81 void AccStructureChecker::CheckNotInComputeConstruct() {
82   if (IsInsideComputeConstruct()) {
83     context_.Say(GetContext().directiveSource,
84         "Directive %s may not be called within a compute region"_err_en_US,
85         ContextDirectiveAsFortran());
86   }
87 }
88 
89 void AccStructureChecker::Enter(const parser::AccClause &x) {
90   SetContextClause(x);
91 }
92 
93 void AccStructureChecker::Leave(const parser::AccClauseList &) {}
94 
95 void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) {
96   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
97   const auto &endBlockDir{std::get<parser::AccEndBlockDirective>(x.t)};
98   const auto &beginAccBlockDir{
99       std::get<parser::AccBlockDirective>(beginBlockDir.t)};
100 
101   CheckMatching(beginAccBlockDir, endBlockDir.v);
102   PushContextAndClauseSets(beginAccBlockDir.source, beginAccBlockDir.v);
103 }
104 
105 void AccStructureChecker::Leave(const parser::OpenACCBlockConstruct &x) {
106   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
107   const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
108   const parser::Block &block{std::get<parser::Block>(x.t)};
109   switch (blockDir.v) {
110   case llvm::acc::Directive::ACCD_kernels:
111   case llvm::acc::Directive::ACCD_parallel:
112   case llvm::acc::Directive::ACCD_serial:
113     // Restriction - line 1004-1005
114     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
115         computeConstructOnlyAllowedAfterDeviceTypeClauses);
116     // Restriction - line 1001
117     CheckNoBranching(block, GetContext().directive, blockDir.source);
118     break;
119   case llvm::acc::Directive::ACCD_data:
120     // Restriction - line 1249-1250
121     CheckRequireAtLeastOneOf();
122     break;
123   case llvm::acc::Directive::ACCD_host_data:
124     // Restriction - line 1746
125     CheckRequireAtLeastOneOf();
126     break;
127   default:
128     break;
129   }
130   dirContext_.pop_back();
131 }
132 
133 void AccStructureChecker::Enter(
134     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
135   const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
136   PushContextAndClauseSets(declarativeDir.source, declarativeDir.v);
137 }
138 
139 void AccStructureChecker::Leave(
140     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
141   // Restriction - line 2409
142   CheckAtLeastOneClause();
143 
144   // Restriction - line 2417-2418 - In a Fortran module declaration section,
145   // only create, copyin, device_resident, and link clauses are allowed.
146   const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
147   const auto &scope{context_.FindScope(declarativeDir.source)};
148   const Scope &containingScope{GetProgramUnitContaining(scope)};
149   if (containingScope.kind() == Scope::Kind::Module) {
150     for (auto cl : GetContext().actualClauses) {
151       if (cl != llvm::acc::Clause::ACCC_create &&
152           cl != llvm::acc::Clause::ACCC_copyin &&
153           cl != llvm::acc::Clause::ACCC_device_resident &&
154           cl != llvm::acc::Clause::ACCC_link) {
155         context_.Say(GetContext().directiveSource,
156             "%s clause is not allowed on the %s directive in module "
157             "declaration "
158             "section"_err_en_US,
159             parser::ToUpperCaseLetters(
160                 llvm::acc::getOpenACCClauseName(cl).str()),
161             ContextDirectiveAsFortran());
162       }
163     }
164   }
165   dirContext_.pop_back();
166 }
167 
168 void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) {
169   const auto &beginCombinedDir{
170       std::get<parser::AccBeginCombinedDirective>(x.t)};
171   const auto &combinedDir{
172       std::get<parser::AccCombinedDirective>(beginCombinedDir.t)};
173 
174   // check matching, End directive is optional
175   if (const auto &endCombinedDir{
176           std::get<std::optional<parser::AccEndCombinedDirective>>(x.t)}) {
177     CheckMatching<parser::AccCombinedDirective>(combinedDir, endCombinedDir->v);
178   }
179 
180   PushContextAndClauseSets(combinedDir.source, combinedDir.v);
181 }
182 
183 void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) {
184   const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
185   const auto &combinedDir{
186       std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
187   switch (combinedDir.v) {
188   case llvm::acc::Directive::ACCD_kernels_loop:
189   case llvm::acc::Directive::ACCD_parallel_loop:
190   case llvm::acc::Directive::ACCD_serial_loop:
191     // Restriction - line 1004-1005
192     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
193         computeConstructOnlyAllowedAfterDeviceTypeClauses);
194     break;
195   default:
196     break;
197   }
198   dirContext_.pop_back();
199 }
200 
201 void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) {
202   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
203   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
204   PushContextAndClauseSets(loopDir.source, loopDir.v);
205 }
206 
207 void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) {
208   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
209   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
210   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
211     // Restriction - line 1818-1819
212     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
213         loopOnlyAllowedAfterDeviceTypeClauses);
214     // Restriction - line 1834
215     CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq,
216         {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector,
217             llvm::acc::Clause::ACCC_worker});
218   }
219   dirContext_.pop_back();
220 }
221 
222 void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) {
223   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
224   PushContextAndClauseSets(standaloneDir.source, standaloneDir.v);
225 }
226 
227 void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {
228   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
229   switch (standaloneDir.v) {
230   case llvm::acc::Directive::ACCD_enter_data:
231   case llvm::acc::Directive::ACCD_exit_data:
232     // Restriction - line 1310-1311 (ENTER DATA)
233     // Restriction - line 1312-1313 (EXIT DATA)
234     CheckRequireAtLeastOneOf();
235     break;
236   case llvm::acc::Directive::ACCD_set:
237     // Restriction - line 2610
238     CheckRequireAtLeastOneOf();
239     // Restriction - line 2602
240     CheckNotInComputeConstruct();
241     break;
242   case llvm::acc::Directive::ACCD_update:
243     // Restriction - line 2636
244     CheckRequireAtLeastOneOf();
245     // Restriction - line 2669
246     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
247         updateOnlyAllowedAfterDeviceTypeClauses);
248     break;
249   case llvm::acc::Directive::ACCD_init:
250   case llvm::acc::Directive::ACCD_shutdown:
251     // Restriction - line 2525 (INIT)
252     // Restriction - line 2561 (SHUTDOWN)
253     CheckNotInComputeConstruct();
254     break;
255   default:
256     break;
257   }
258   dirContext_.pop_back();
259 }
260 
261 void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) {
262   PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine);
263   const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
264   if (!optName) {
265     const auto &verbatim{std::get<parser::Verbatim>(x.t)};
266     const auto &scope{context_.FindScope(verbatim.source)};
267     const Scope &containingScope{GetProgramUnitContaining(scope)};
268     if (containingScope.kind() == Scope::Kind::Module) {
269       context_.Say(GetContext().directiveSource,
270           "ROUTINE directive without name must appear within the specification "
271           "part of a subroutine or function definition, or within an interface "
272           "body for a subroutine or function in an interface block"_err_en_US);
273     }
274   }
275 }
276 void AccStructureChecker::Leave(const parser::OpenACCRoutineConstruct &) {
277   // Restriction - line 2790
278   CheckRequireAtLeastOneOf();
279   // Restriction - line 2788-2789
280   CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
281       routineOnlyAllowedAfterDeviceTypeClauses);
282   dirContext_.pop_back();
283 }
284 
285 void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) {
286   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
287   PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_wait);
288 }
289 void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &x) {
290   dirContext_.pop_back();
291 }
292 
293 void AccStructureChecker::Enter(const parser::OpenACCAtomicConstruct &x) {
294   PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_atomic);
295 }
296 void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {
297   dirContext_.pop_back();
298 }
299 
300 void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) {
301   const auto &verbatim = std::get<parser::Verbatim>(x.t);
302   PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache);
303   SetContextDirectiveSource(verbatim.source);
304 }
305 void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) {
306   dirContext_.pop_back();
307 }
308 
309 // Clause checkers
310 CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(Collapse, ACCC_collapse)
311 
312 CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto)
313 CHECK_SIMPLE_CLAUSE(Async, ACCC_async)
314 CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)
315 CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)
316 CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)
317 CHECK_SIMPLE_CLAUSE(Copy, ACCC_copy)
318 CHECK_SIMPLE_CLAUSE(Default, ACCC_default)
319 CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async)
320 CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete)
321 CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach)
322 CHECK_SIMPLE_CLAUSE(Device, ACCC_device)
323 CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num)
324 CHECK_SIMPLE_CLAUSE(Deviceptr, ACCC_deviceptr)
325 CHECK_SIMPLE_CLAUSE(DeviceResident, ACCC_device_resident)
326 CHECK_SIMPLE_CLAUSE(DeviceType, ACCC_device_type)
327 CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize)
328 CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate)
329 CHECK_SIMPLE_CLAUSE(Gang, ACCC_gang)
330 CHECK_SIMPLE_CLAUSE(Host, ACCC_host)
331 CHECK_SIMPLE_CLAUSE(If, ACCC_if)
332 CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present)
333 CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent)
334 CHECK_SIMPLE_CLAUSE(Link, ACCC_link)
335 CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create)
336 CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost)
337 CHECK_SIMPLE_CLAUSE(NumGangs, ACCC_num_gangs)
338 CHECK_SIMPLE_CLAUSE(NumWorkers, ACCC_num_workers)
339 CHECK_SIMPLE_CLAUSE(Present, ACCC_present)
340 CHECK_SIMPLE_CLAUSE(Private, ACCC_private)
341 CHECK_SIMPLE_CLAUSE(Read, ACCC_read)
342 CHECK_SIMPLE_CLAUSE(Reduction, ACCC_reduction)
343 CHECK_SIMPLE_CLAUSE(Seq, ACCC_seq)
344 CHECK_SIMPLE_CLAUSE(Tile, ACCC_tile)
345 CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device)
346 CHECK_SIMPLE_CLAUSE(Vector, ACCC_vector)
347 CHECK_SIMPLE_CLAUSE(VectorLength, ACCC_vector_length)
348 CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait)
349 CHECK_SIMPLE_CLAUSE(Worker, ACCC_worker)
350 CHECK_SIMPLE_CLAUSE(Write, ACCC_write)
351 CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown)
352 
353 void AccStructureChecker::Enter(const parser::AccClause::Create &c) {
354   CheckAllowed(llvm::acc::Clause::ACCC_create);
355   const auto &modifierClause{c.v};
356   if (const auto &modifier{
357           std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
358     if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
359       context_.Say(GetContext().clauseSource,
360           "Only the ZERO modifier is allowed for the %s clause "
361           "on the %s directive"_err_en_US,
362           parser::ToUpperCaseLetters(
363               llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)
364                   .str()),
365           ContextDirectiveAsFortran());
366     }
367   }
368 }
369 
370 void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {
371   CheckAllowed(llvm::acc::Clause::ACCC_copyin);
372   const auto &modifierClause{c.v};
373   if (const auto &modifier{
374           std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
375     if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyin)) {
376       return;
377     }
378     if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) {
379       context_.Say(GetContext().clauseSource,
380           "Only the READONLY modifier is allowed for the %s clause "
381           "on the %s directive"_err_en_US,
382           parser::ToUpperCaseLetters(
383               llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin)
384                   .str()),
385           ContextDirectiveAsFortran());
386     }
387   }
388 }
389 
390 void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {
391   CheckAllowed(llvm::acc::Clause::ACCC_copyout);
392   const auto &modifierClause{c.v};
393   if (const auto &modifier{
394           std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
395     if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyout)) {
396       return;
397     }
398     if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
399       context_.Say(GetContext().clauseSource,
400           "Only the ZERO modifier is allowed for the %s clause "
401           "on the %s directive"_err_en_US,
402           parser::ToUpperCaseLetters(
403               llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)
404                   .str()),
405           ContextDirectiveAsFortran());
406     }
407   }
408 }
409 
410 void AccStructureChecker::Enter(const parser::AccClause::Self &x) {
411   CheckAllowed(llvm::acc::Clause::ACCC_self);
412   const parser::AccSelfClause &accSelfClause = x.v;
413   if (GetContext().directive == llvm::acc::Directive::ACCD_update &&
414       std::holds_alternative<std::optional<parser::ScalarLogicalExpr>>(
415           accSelfClause.u)) {
416     context_.Say(GetContext().clauseSource,
417         "SELF clause on the %s directive must have a var-list"_err_en_US,
418         ContextDirectiveAsFortran());
419   } else if (GetContext().directive != llvm::acc::Directive::ACCD_update &&
420       std::holds_alternative<parser::AccObjectList>(accSelfClause.u)) {
421     const auto &accObjectList =
422         std::get<parser::AccObjectList>(accSelfClause.u);
423     if (accObjectList.v.size() != 1) {
424       context_.Say(GetContext().clauseSource,
425           "SELF clause on the %s directive only accepts optional scalar logical"
426           " expression"_err_en_US,
427           ContextDirectiveAsFortran());
428     }
429   }
430 }
431 
432 llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {
433   return llvm::acc::getOpenACCClauseName(clause);
434 }
435 
436 llvm::StringRef AccStructureChecker::getDirectiveName(
437     llvm::acc::Directive directive) {
438   return llvm::acc::getOpenACCDirectiveName(directive);
439 }
440 
441 } // namespace Fortran::semantics
442