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