1 //===----------------------------------------------------------------------===//
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 #include "resolve-directives.h"
10
11 #include "check-acc-structure.h"
12 #include "check-omp-structure.h"
13 #include "resolve-names-utils.h"
14 #include "flang/Common/idioms.h"
15 #include "flang/Evaluate/fold.h"
16 #include "flang/Evaluate/type.h"
17 #include "flang/Parser/parse-tree-visitor.h"
18 #include "flang/Parser/parse-tree.h"
19 #include "flang/Parser/tools.h"
20 #include "flang/Semantics/expression.h"
21 #include <list>
22 #include <map>
23
24 namespace Fortran::semantics {
25
26 template <typename T> class DirectiveAttributeVisitor {
27 public:
DirectiveAttributeVisitor(SemanticsContext & context)28 explicit DirectiveAttributeVisitor(SemanticsContext &context)
29 : context_{context} {}
30
Pre(const A &)31 template <typename A> bool Pre(const A &) { return true; }
Post(const A &)32 template <typename A> void Post(const A &) {}
33
34 protected:
35 struct DirContext {
DirContextFortran::semantics::DirectiveAttributeVisitor::DirContext36 DirContext(const parser::CharBlock &source, T d, Scope &s)
37 : directiveSource{source}, directive{d}, scope{s} {}
38 parser::CharBlock directiveSource;
39 T directive;
40 Scope &scope;
41 Symbol::Flag defaultDSA{Symbol::Flag::AccShared}; // TODOACC
42 std::map<const Symbol *, Symbol::Flag> objectWithDSA;
43 bool withinConstruct{false};
44 std::int64_t associatedLoopLevel{0};
45 };
46
GetContext()47 DirContext &GetContext() {
48 CHECK(!dirContext_.empty());
49 return dirContext_.back();
50 }
PushContext(const parser::CharBlock & source,T dir)51 void PushContext(const parser::CharBlock &source, T dir) {
52 dirContext_.emplace_back(source, dir, context_.FindScope(source));
53 }
PopContext()54 void PopContext() { dirContext_.pop_back(); }
SetContextDirectiveSource(parser::CharBlock & dir)55 void SetContextDirectiveSource(parser::CharBlock &dir) {
56 GetContext().directiveSource = dir;
57 }
currScope()58 Scope &currScope() { return GetContext().scope; }
SetContextDefaultDSA(Symbol::Flag flag)59 void SetContextDefaultDSA(Symbol::Flag flag) {
60 GetContext().defaultDSA = flag;
61 }
AddToContextObjectWithDSA(const Symbol & symbol,Symbol::Flag flag,DirContext & context)62 void AddToContextObjectWithDSA(
63 const Symbol &symbol, Symbol::Flag flag, DirContext &context) {
64 context.objectWithDSA.emplace(&symbol, flag);
65 }
AddToContextObjectWithDSA(const Symbol & symbol,Symbol::Flag flag)66 void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
67 AddToContextObjectWithDSA(symbol, flag, GetContext());
68 }
IsObjectWithDSA(const Symbol & symbol)69 bool IsObjectWithDSA(const Symbol &symbol) {
70 auto it{GetContext().objectWithDSA.find(&symbol)};
71 return it != GetContext().objectWithDSA.end();
72 }
SetContextAssociatedLoopLevel(std::int64_t level)73 void SetContextAssociatedLoopLevel(std::int64_t level) {
74 GetContext().associatedLoopLevel = level;
75 }
MakeAssocSymbol(const SourceName & name,Symbol & prev,Scope & scope)76 Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev, Scope &scope) {
77 const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
78 return *pair.first->second;
79 }
MakeAssocSymbol(const SourceName & name,Symbol & prev)80 Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
81 return MakeAssocSymbol(name, prev, currScope());
82 }
GetDesignatorNameIfDataRef(const parser::Designator & designator)83 static const parser::Name *GetDesignatorNameIfDataRef(
84 const parser::Designator &designator) {
85 const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
86 return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
87 }
AddDataSharingAttributeObject(SymbolRef object)88 void AddDataSharingAttributeObject(SymbolRef object) {
89 dataSharingAttributeObjects_.insert(object);
90 }
ClearDataSharingAttributeObjects()91 void ClearDataSharingAttributeObjects() {
92 dataSharingAttributeObjects_.clear();
93 }
94 bool HasDataSharingAttributeObject(const Symbol &);
95 const parser::Name &GetLoopIndex(const parser::DoConstruct &);
96 const parser::DoConstruct *GetDoConstructIf(
97 const parser::ExecutionPartConstruct &);
98 Symbol *DeclarePrivateAccessEntity(
99 const parser::Name &, Symbol::Flag, Scope &);
100 Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &);
101 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
102
103 SymbolSet dataSharingAttributeObjects_; // on one directive
104 SemanticsContext &context_;
105 std::vector<DirContext> dirContext_; // used as a stack
106 };
107
108 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
109 public:
AccAttributeVisitor(SemanticsContext & context)110 explicit AccAttributeVisitor(SemanticsContext &context)
111 : DirectiveAttributeVisitor(context) {}
112
Walk(const A & x)113 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
Pre(const A &)114 template <typename A> bool Pre(const A &) { return true; }
Post(const A &)115 template <typename A> void Post(const A &) {}
116
Pre(const parser::SpecificationPart & x)117 bool Pre(const parser::SpecificationPart &x) {
118 Walk(std::get<std::list<parser::OpenACCDeclarativeConstruct>>(x.t));
119 return false;
120 }
121
122 bool Pre(const parser::OpenACCBlockConstruct &);
Post(const parser::OpenACCBlockConstruct &)123 void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }
124 bool Pre(const parser::OpenACCCombinedConstruct &);
Post(const parser::OpenACCCombinedConstruct &)125 void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }
126
Post(const parser::AccBeginBlockDirective &)127 void Post(const parser::AccBeginBlockDirective &) {
128 GetContext().withinConstruct = true;
129 }
130
131 bool Pre(const parser::OpenACCLoopConstruct &);
Post(const parser::OpenACCLoopConstruct &)132 void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
Post(const parser::AccLoopDirective &)133 void Post(const parser::AccLoopDirective &) {
134 GetContext().withinConstruct = true;
135 }
136
137 bool Pre(const parser::OpenACCStandaloneConstruct &);
Post(const parser::OpenACCStandaloneConstruct &)138 void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
Post(const parser::AccStandaloneDirective &)139 void Post(const parser::AccStandaloneDirective &) {
140 GetContext().withinConstruct = true;
141 }
142
143 bool Pre(const parser::OpenACCCacheConstruct &);
Post(const parser::OpenACCCacheConstruct &)144 void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }
145
146 void Post(const parser::AccDefaultClause &);
147
Pre(const parser::AccClause::Copy & x)148 bool Pre(const parser::AccClause::Copy &x) {
149 ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn);
150 ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut);
151 return false;
152 }
153
Pre(const parser::AccClause::Create & x)154 bool Pre(const parser::AccClause::Create &x) {
155 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
156 ResolveAccObjectList(objectList, Symbol::Flag::AccCreate);
157 return false;
158 }
159
Pre(const parser::AccClause::Copyin & x)160 bool Pre(const parser::AccClause::Copyin &x) {
161 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
162 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn);
163 return false;
164 }
165
Pre(const parser::AccClause::Copyout & x)166 bool Pre(const parser::AccClause::Copyout &x) {
167 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
168 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut);
169 return false;
170 }
171
Pre(const parser::AccClause::Present & x)172 bool Pre(const parser::AccClause::Present &x) {
173 ResolveAccObjectList(x.v, Symbol::Flag::AccPresent);
174 return false;
175 }
Pre(const parser::AccClause::Private & x)176 bool Pre(const parser::AccClause::Private &x) {
177 ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate);
178 return false;
179 }
Pre(const parser::AccClause::Firstprivate & x)180 bool Pre(const parser::AccClause::Firstprivate &x) {
181 ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate);
182 return false;
183 }
184
185 void Post(const parser::Name &);
186
187 private:
188 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);
189
190 static constexpr Symbol::Flags dataSharingAttributeFlags{
191 Symbol::Flag::AccShared, Symbol::Flag::AccPrivate,
192 Symbol::Flag::AccPresent, Symbol::Flag::AccFirstPrivate,
193 Symbol::Flag::AccReduction};
194
195 static constexpr Symbol::Flags dataMappingAttributeFlags{
196 Symbol::Flag::AccCreate, Symbol::Flag::AccCopyIn,
197 Symbol::Flag::AccCopyOut, Symbol::Flag::AccDelete};
198
199 static constexpr Symbol::Flags accFlagsRequireNewSymbol{
200 Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate,
201 Symbol::Flag::AccReduction};
202
203 static constexpr Symbol::Flags accFlagsRequireMark{};
204
205 void PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct &);
206 void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);
207 void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
208 Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
209 Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
210 Symbol *ResolveAccCommonBlockName(const parser::Name *);
211 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
212 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
213 void CheckMultipleAppearances(
214 const parser::Name &, const Symbol &, Symbol::Flag);
215 void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
216 };
217
218 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
219 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
220 public:
OmpAttributeVisitor(SemanticsContext & context)221 explicit OmpAttributeVisitor(SemanticsContext &context)
222 : DirectiveAttributeVisitor(context) {}
223
Walk(const A & x)224 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
Pre(const A &)225 template <typename A> bool Pre(const A &) { return true; }
Post(const A &)226 template <typename A> void Post(const A &) {}
227
Pre(const parser::SpecificationPart & x)228 bool Pre(const parser::SpecificationPart &x) {
229 Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
230 return true;
231 }
232
233 bool Pre(const parser::OpenMPBlockConstruct &);
234 void Post(const parser::OpenMPBlockConstruct &);
235
Post(const parser::OmpBeginBlockDirective &)236 void Post(const parser::OmpBeginBlockDirective &) {
237 GetContext().withinConstruct = true;
238 }
239
240 bool Pre(const parser::OpenMPLoopConstruct &);
Post(const parser::OpenMPLoopConstruct &)241 void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
Post(const parser::OmpBeginLoopDirective &)242 void Post(const parser::OmpBeginLoopDirective &) {
243 GetContext().withinConstruct = true;
244 }
245 bool Pre(const parser::DoConstruct &);
246
247 bool Pre(const parser::OpenMPSectionsConstruct &);
Post(const parser::OpenMPSectionsConstruct &)248 void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
249
Pre(const parser::OpenMPDeclareSimdConstruct & x)250 bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
251 PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd);
252 const auto &name{std::get<std::optional<parser::Name>>(x.t)};
253 if (name) {
254 ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd);
255 }
256 return true;
257 }
Post(const parser::OpenMPDeclareSimdConstruct &)258 void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); }
259 bool Pre(const parser::OpenMPThreadprivate &);
Post(const parser::OpenMPThreadprivate &)260 void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
261
262 // 2.15.3 Data-Sharing Attribute Clauses
263 void Post(const parser::OmpDefaultClause &);
Pre(const parser::OmpClause::Shared & x)264 bool Pre(const parser::OmpClause::Shared &x) {
265 ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
266 return false;
267 }
Pre(const parser::OmpClause::Private & x)268 bool Pre(const parser::OmpClause::Private &x) {
269 ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);
270 return false;
271 }
Pre(const parser::OmpAllocateClause & x)272 bool Pre(const parser::OmpAllocateClause &x) {
273 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
274 ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate);
275 return false;
276 }
Pre(const parser::OmpClause::Firstprivate & x)277 bool Pre(const parser::OmpClause::Firstprivate &x) {
278 ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
279 return false;
280 }
Pre(const parser::OmpClause::Lastprivate & x)281 bool Pre(const parser::OmpClause::Lastprivate &x) {
282 ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate);
283 return false;
284 }
Pre(const parser::OmpClause::Copyin & x)285 bool Pre(const parser::OmpClause::Copyin &x) {
286 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn);
287 return false;
288 }
Pre(const parser::OmpLinearClause & x)289 bool Pre(const parser::OmpLinearClause &x) {
290 std::visit(common::visitors{
291 [&](const parser::OmpLinearClause::WithoutModifier
292 &linearWithoutModifier) {
293 ResolveOmpNameList(
294 linearWithoutModifier.names, Symbol::Flag::OmpLinear);
295 },
296 [&](const parser::OmpLinearClause::WithModifier
297 &linearWithModifier) {
298 ResolveOmpNameList(
299 linearWithModifier.names, Symbol::Flag::OmpLinear);
300 },
301 },
302 x.u);
303 return false;
304 }
Pre(const parser::OmpAlignedClause & x)305 bool Pre(const parser::OmpAlignedClause &x) {
306 const auto &alignedNameList{std::get<std::list<parser::Name>>(x.t)};
307 ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned);
308 return false;
309 }
310 void Post(const parser::Name &);
311
312 const parser::OmpClause *associatedClause{nullptr};
SetAssociatedClause(const parser::OmpClause & c)313 void SetAssociatedClause(const parser::OmpClause &c) {
314 associatedClause = &c;
315 }
GetAssociatedClause()316 const parser::OmpClause *GetAssociatedClause() { return associatedClause; }
317
318 private:
319 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &);
320
321 static constexpr Symbol::Flags dataSharingAttributeFlags{
322 Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
323 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
324 Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
325
326 static constexpr Symbol::Flags privateDataSharingAttributeFlags{
327 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
328 Symbol::Flag::OmpLastPrivate};
329
330 static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
331 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
332 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
333 Symbol::Flag::OmpReduction};
334
335 static constexpr Symbol::Flags ompFlagsRequireMark{
336 Symbol::Flag::OmpThreadprivate};
337
338 static constexpr Symbol::Flags dataCopyingAttributeFlags{
339 Symbol::Flag::OmpCopyIn};
340
341 std::vector<const parser::Name *> allocateNames_; // on one directive
342 SymbolSet privateDataSharingAttributeObjects_; // on one directive
343
AddAllocateName(const parser::Name * & object)344 void AddAllocateName(const parser::Name *&object) {
345 allocateNames_.push_back(object);
346 }
ClearAllocateNames()347 void ClearAllocateNames() { allocateNames_.clear(); }
348
AddPrivateDataSharingAttributeObjects(SymbolRef object)349 void AddPrivateDataSharingAttributeObjects(SymbolRef object) {
350 privateDataSharingAttributeObjects_.insert(object);
351 }
ClearPrivateDataSharingAttributeObjects()352 void ClearPrivateDataSharingAttributeObjects() {
353 privateDataSharingAttributeObjects_.clear();
354 }
355
356 // Predetermined DSA rules
357 void PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
358 const parser::OpenMPLoopConstruct &);
359 void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);
360
361 void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
362 void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
363 Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
364 Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
365 Symbol *ResolveOmpCommonBlockName(const parser::Name *);
366 void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);
367 void ResolveOmpName(const parser::Name &, Symbol::Flag);
368 Symbol *ResolveName(const parser::Name *);
369 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
370 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
371 void CheckMultipleAppearances(
372 const parser::Name &, const Symbol &, Symbol::Flag);
373
374 void CheckDataCopyingClause(
375 const parser::Name &, const Symbol &, Symbol::Flag);
376
377 void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause);
378 void CheckObjectInNamelist(
379 const parser::Name &, const Symbol &, Symbol::Flag);
380 };
381
382 template <typename T>
HasDataSharingAttributeObject(const Symbol & object)383 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
384 const Symbol &object) {
385 auto it{dataSharingAttributeObjects_.find(object)};
386 return it != dataSharingAttributeObjects_.end();
387 }
388
389 template <typename T>
GetLoopIndex(const parser::DoConstruct & x)390 const parser::Name &DirectiveAttributeVisitor<T>::GetLoopIndex(
391 const parser::DoConstruct &x) {
392 using Bounds = parser::LoopControl::Bounds;
393 return std::get<Bounds>(x.GetLoopControl()->u).name.thing;
394 }
395
396 template <typename T>
GetDoConstructIf(const parser::ExecutionPartConstruct & x)397 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf(
398 const parser::ExecutionPartConstruct &x) {
399 return parser::Unwrap<parser::DoConstruct>(x);
400 }
401
402 template <typename T>
DeclarePrivateAccessEntity(const parser::Name & name,Symbol::Flag flag,Scope & scope)403 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
404 const parser::Name &name, Symbol::Flag flag, Scope &scope) {
405 if (!name.symbol) {
406 return nullptr; // not resolved by Name Resolution step, do nothing
407 }
408 name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope);
409 return name.symbol;
410 }
411
412 template <typename T>
DeclarePrivateAccessEntity(Symbol & object,Symbol::Flag flag,Scope & scope)413 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
414 Symbol &object, Symbol::Flag flag, Scope &scope) {
415 if (object.owner() != currScope()) {
416 auto &symbol{MakeAssocSymbol(object.name(), object, scope)};
417 symbol.set(flag);
418 return &symbol;
419 } else {
420 object.set(flag);
421 return &object;
422 }
423 }
424
Pre(const parser::OpenACCBlockConstruct & x)425 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
426 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
427 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
428 switch (blockDir.v) {
429 case llvm::acc::Directive::ACCD_data:
430 case llvm::acc::Directive::ACCD_host_data:
431 case llvm::acc::Directive::ACCD_kernels:
432 case llvm::acc::Directive::ACCD_parallel:
433 case llvm::acc::Directive::ACCD_serial:
434 PushContext(blockDir.source, blockDir.v);
435 break;
436 default:
437 break;
438 }
439 ClearDataSharingAttributeObjects();
440 return true;
441 }
442
Pre(const parser::OpenACCLoopConstruct & x)443 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
444 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
445 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
446 const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
447 if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
448 PushContext(loopDir.source, loopDir.v);
449 }
450 ClearDataSharingAttributeObjects();
451 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
452 PrivatizeAssociatedLoopIndex(x);
453 return true;
454 }
455
Pre(const parser::OpenACCStandaloneConstruct & x)456 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
457 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
458 switch (standaloneDir.v) {
459 case llvm::acc::Directive::ACCD_enter_data:
460 case llvm::acc::Directive::ACCD_exit_data:
461 case llvm::acc::Directive::ACCD_init:
462 case llvm::acc::Directive::ACCD_set:
463 case llvm::acc::Directive::ACCD_shutdown:
464 case llvm::acc::Directive::ACCD_update:
465 PushContext(standaloneDir.source, standaloneDir.v);
466 break;
467 default:
468 break;
469 }
470 ClearDataSharingAttributeObjects();
471 return true;
472 }
473
Pre(const parser::OpenACCCombinedConstruct & x)474 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
475 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
476 const auto &combinedDir{
477 std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
478 switch (combinedDir.v) {
479 case llvm::acc::Directive::ACCD_kernels_loop:
480 case llvm::acc::Directive::ACCD_parallel_loop:
481 case llvm::acc::Directive::ACCD_serial_loop:
482 PushContext(combinedDir.source, combinedDir.v);
483 break;
484 default:
485 break;
486 }
487 ClearDataSharingAttributeObjects();
488 return true;
489 }
490
IsLastNameArray(const parser::Designator & designator)491 static bool IsLastNameArray(const parser::Designator &designator) {
492 const auto &name{GetLastName(designator)};
493 const evaluate::DataRef dataRef{*(name.symbol)};
494 return std::visit(
495 common::visitors{
496 [](const evaluate::SymbolRef &ref) { return ref->Rank() > 0; },
497 [](const evaluate::ArrayRef &aref) {
498 return aref.base().IsSymbol() ||
499 aref.base().GetComponent().base().Rank() == 0;
500 },
501 [](const auto &) { return false; },
502 },
503 dataRef.u);
504 }
505
AllowOnlyArrayAndSubArray(const parser::AccObjectList & objectList)506 void AccAttributeVisitor::AllowOnlyArrayAndSubArray(
507 const parser::AccObjectList &objectList) {
508 for (const auto &accObject : objectList.v) {
509 std::visit(
510 common::visitors{
511 [&](const parser::Designator &designator) {
512 if (!IsLastNameArray(designator))
513 context_.Say(designator.source,
514 "Only array element or subarray are allowed in %s directive"_err_en_US,
515 parser::ToUpperCaseLetters(
516 llvm::acc::getOpenACCDirectiveName(
517 GetContext().directive)
518 .str()));
519 },
520 [&](const auto &name) {
521 context_.Say(name.source,
522 "Only array element or subarray are allowed in %s directive"_err_en_US,
523 parser::ToUpperCaseLetters(
524 llvm::acc::getOpenACCDirectiveName(GetContext().directive)
525 .str()));
526 },
527 },
528 accObject.u);
529 }
530 }
531
Pre(const parser::OpenACCCacheConstruct & x)532 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
533 const auto &verbatim{std::get<parser::Verbatim>(x.t)};
534 PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
535 ClearDataSharingAttributeObjects();
536
537 const auto &objectListWithModifier =
538 std::get<parser::AccObjectListWithModifier>(x.t);
539 const auto &objectList =
540 std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t);
541
542 // 2.10 Cache directive restriction: A var in a cache directive must be a
543 // single array element or a simple subarray.
544 AllowOnlyArrayAndSubArray(objectList);
545
546 return true;
547 }
548
GetAssociatedLoopLevelFromClauses(const parser::AccClauseList & x)549 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(
550 const parser::AccClauseList &x) {
551 std::int64_t collapseLevel{0};
552 for (const auto &clause : x.v) {
553 if (const auto *collapseClause{
554 std::get_if<parser::AccClause::Collapse>(&clause.u)}) {
555 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
556 collapseLevel = *v;
557 }
558 }
559 }
560
561 if (collapseLevel) {
562 return collapseLevel;
563 }
564 return 1; // default is outermost loop
565 }
566
PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct & x)567 void AccAttributeVisitor::PrivatizeAssociatedLoopIndex(
568 const parser::OpenACCLoopConstruct &x) {
569 std::int64_t level{GetContext().associatedLoopLevel};
570 if (level <= 0) { // collpase value was negative or 0
571 return;
572 }
573 Symbol::Flag ivDSA{Symbol::Flag::AccPrivate};
574
575 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
576 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
577 // go through all the nested do-loops and resolve index variables
578 const parser::Name &iv{GetLoopIndex(*loop)};
579 if (auto *symbol{ResolveAcc(iv, ivDSA, currScope())}) {
580 symbol->set(Symbol::Flag::AccPreDetermined);
581 iv.symbol = symbol; // adjust the symbol within region
582 AddToContextObjectWithDSA(*symbol, ivDSA);
583 }
584
585 const auto &block{std::get<parser::Block>(loop->t)};
586 const auto it{block.begin()};
587 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
588 }
589 CHECK(level == 0);
590 }
591
Post(const parser::AccDefaultClause & x)592 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
593 if (!dirContext_.empty()) {
594 switch (x.v) {
595 case parser::AccDefaultClause::Arg::Present:
596 SetContextDefaultDSA(Symbol::Flag::AccPresent);
597 break;
598 case parser::AccDefaultClause::Arg::None:
599 SetContextDefaultDSA(Symbol::Flag::AccNone);
600 break;
601 }
602 }
603 }
604
605 // For OpenACC constructs, check all the data-refs within the constructs
606 // and adjust the symbol for each Name if necessary
Post(const parser::Name & name)607 void AccAttributeVisitor::Post(const parser::Name &name) {
608 auto *symbol{name.symbol};
609 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
610 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
611 !IsObjectWithDSA(*symbol)) {
612 if (Symbol * found{currScope().FindSymbol(name.source)}) {
613 if (symbol != found) {
614 name.symbol = found; // adjust the symbol within region
615 } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {
616 // 2.5.14.
617 context_.Say(name.source,
618 "The DEFAULT(NONE) clause requires that '%s' must be listed in "
619 "a data-mapping clause"_err_en_US,
620 symbol->name());
621 }
622 }
623 }
624 } // within OpenACC construct
625 }
626
ResolveAccCommonBlockName(const parser::Name * name)627 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
628 const parser::Name *name) {
629 if (!name) {
630 return nullptr;
631 } else if (auto *prev{
632 GetContext().scope.parent().FindCommonBlock(name->source)}) {
633 name->symbol = prev;
634 return prev;
635 } else {
636 return nullptr;
637 }
638 }
639
ResolveAccObjectList(const parser::AccObjectList & accObjectList,Symbol::Flag accFlag)640 void AccAttributeVisitor::ResolveAccObjectList(
641 const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
642 for (const auto &accObject : accObjectList.v) {
643 ResolveAccObject(accObject, accFlag);
644 }
645 }
646
ResolveAccObject(const parser::AccObject & accObject,Symbol::Flag accFlag)647 void AccAttributeVisitor::ResolveAccObject(
648 const parser::AccObject &accObject, Symbol::Flag accFlag) {
649 std::visit(
650 common::visitors{
651 [&](const parser::Designator &designator) {
652 if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
653 if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) {
654 AddToContextObjectWithDSA(*symbol, accFlag);
655 if (dataSharingAttributeFlags.test(accFlag)) {
656 CheckMultipleAppearances(*name, *symbol, accFlag);
657 }
658 }
659 } else {
660 // Array sections to be changed to substrings as needed
661 if (AnalyzeExpr(context_, designator)) {
662 if (std::holds_alternative<parser::Substring>(designator.u)) {
663 context_.Say(designator.source,
664 "Substrings are not allowed on OpenACC "
665 "directives or clauses"_err_en_US);
666 }
667 }
668 // other checks, more TBD
669 }
670 },
671 [&](const parser::Name &name) { // common block
672 if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
673 CheckMultipleAppearances(
674 name, *symbol, Symbol::Flag::AccCommonBlock);
675 for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
676 if (auto *resolvedObject{
677 ResolveAcc(*object, accFlag, currScope())}) {
678 AddToContextObjectWithDSA(*resolvedObject, accFlag);
679 }
680 }
681 } else {
682 context_.Say(name.source,
683 "COMMON block must be declared in the same scoping unit "
684 "in which the OpenACC directive or clause appears"_err_en_US);
685 }
686 },
687 },
688 accObject.u);
689 }
690
ResolveAcc(const parser::Name & name,Symbol::Flag accFlag,Scope & scope)691 Symbol *AccAttributeVisitor::ResolveAcc(
692 const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {
693 if (accFlagsRequireNewSymbol.test(accFlag)) {
694 return DeclarePrivateAccessEntity(name, accFlag, scope);
695 } else {
696 return DeclareOrMarkOtherAccessEntity(name, accFlag);
697 }
698 }
699
ResolveAcc(Symbol & symbol,Symbol::Flag accFlag,Scope & scope)700 Symbol *AccAttributeVisitor::ResolveAcc(
701 Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {
702 if (accFlagsRequireNewSymbol.test(accFlag)) {
703 return DeclarePrivateAccessEntity(symbol, accFlag, scope);
704 } else {
705 return DeclareOrMarkOtherAccessEntity(symbol, accFlag);
706 }
707 }
708
DeclareOrMarkOtherAccessEntity(const parser::Name & name,Symbol::Flag accFlag)709 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
710 const parser::Name &name, Symbol::Flag accFlag) {
711 Symbol *prev{currScope().FindSymbol(name.source)};
712 if (!name.symbol || !prev) {
713 return nullptr;
714 } else if (prev != name.symbol) {
715 name.symbol = prev;
716 }
717 return DeclareOrMarkOtherAccessEntity(*prev, accFlag);
718 }
719
DeclareOrMarkOtherAccessEntity(Symbol & object,Symbol::Flag accFlag)720 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
721 Symbol &object, Symbol::Flag accFlag) {
722 if (accFlagsRequireMark.test(accFlag)) {
723 object.set(accFlag);
724 }
725 return &object;
726 }
727
WithMultipleAppearancesAccException(const Symbol & symbol,Symbol::Flag flag)728 static bool WithMultipleAppearancesAccException(
729 const Symbol &symbol, Symbol::Flag flag) {
730 return false; // Place holder
731 }
732
CheckMultipleAppearances(const parser::Name & name,const Symbol & symbol,Symbol::Flag accFlag)733 void AccAttributeVisitor::CheckMultipleAppearances(
734 const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) {
735 const auto *target{&symbol};
736 if (accFlagsRequireNewSymbol.test(accFlag)) {
737 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
738 target = &details->symbol();
739 }
740 }
741 if (HasDataSharingAttributeObject(*target) &&
742 !WithMultipleAppearancesAccException(symbol, accFlag)) {
743 context_.Say(name.source,
744 "'%s' appears in more than one data-sharing clause "
745 "on the same OpenACC directive"_err_en_US,
746 name.ToString());
747 } else {
748 AddDataSharingAttributeObject(*target);
749 }
750 }
751
Pre(const parser::OpenMPBlockConstruct & x)752 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
753 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
754 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
755 switch (beginDir.v) {
756 case llvm::omp::Directive::OMPD_master:
757 case llvm::omp::Directive::OMPD_ordered:
758 case llvm::omp::Directive::OMPD_parallel:
759 case llvm::omp::Directive::OMPD_single:
760 case llvm::omp::Directive::OMPD_target:
761 case llvm::omp::Directive::OMPD_target_data:
762 case llvm::omp::Directive::OMPD_task:
763 case llvm::omp::Directive::OMPD_teams:
764 case llvm::omp::Directive::OMPD_workshare:
765 case llvm::omp::Directive::OMPD_parallel_workshare:
766 case llvm::omp::Directive::OMPD_target_teams:
767 case llvm::omp::Directive::OMPD_target_parallel:
768 PushContext(beginDir.source, beginDir.v);
769 break;
770 default:
771 // TODO others
772 break;
773 }
774 ClearDataSharingAttributeObjects();
775 ClearPrivateDataSharingAttributeObjects();
776 ClearAllocateNames();
777 return true;
778 }
779
Post(const parser::OpenMPBlockConstruct & x)780 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) {
781 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
782 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
783 switch (beginDir.v) {
784 case llvm::omp::Directive::OMPD_parallel:
785 case llvm::omp::Directive::OMPD_single:
786 case llvm::omp::Directive::OMPD_target:
787 case llvm::omp::Directive::OMPD_task:
788 case llvm::omp::Directive::OMPD_teams:
789 case llvm::omp::Directive::OMPD_parallel_workshare:
790 case llvm::omp::Directive::OMPD_target_teams:
791 case llvm::omp::Directive::OMPD_target_parallel: {
792 bool hasPrivate;
793 for (const auto *allocName : allocateNames_) {
794 hasPrivate = false;
795 for (auto privateObj : privateDataSharingAttributeObjects_) {
796 const Symbol &symbolPrivate{*privateObj};
797 if (allocName->source == symbolPrivate.name()) {
798 hasPrivate = true;
799 break;
800 }
801 }
802 if (!hasPrivate) {
803 context_.Say(allocName->source,
804 "The ALLOCATE clause requires that '%s' must be listed in a "
805 "private "
806 "data-sharing attribute clause on the same directive"_err_en_US,
807 allocName->ToString());
808 }
809 }
810 break;
811 }
812 default:
813 break;
814 }
815 PopContext();
816 }
817
Pre(const parser::OpenMPLoopConstruct & x)818 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
819 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
820 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
821 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
822 switch (beginDir.v) {
823 case llvm::omp::Directive::OMPD_distribute:
824 case llvm::omp::Directive::OMPD_distribute_parallel_do:
825 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
826 case llvm::omp::Directive::OMPD_distribute_simd:
827 case llvm::omp::Directive::OMPD_do:
828 case llvm::omp::Directive::OMPD_do_simd:
829 case llvm::omp::Directive::OMPD_parallel_do:
830 case llvm::omp::Directive::OMPD_parallel_do_simd:
831 case llvm::omp::Directive::OMPD_simd:
832 case llvm::omp::Directive::OMPD_target_parallel_do:
833 case llvm::omp::Directive::OMPD_target_parallel_do_simd:
834 case llvm::omp::Directive::OMPD_target_teams_distribute:
835 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
836 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
837 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
838 case llvm::omp::Directive::OMPD_target_simd:
839 case llvm::omp::Directive::OMPD_taskloop:
840 case llvm::omp::Directive::OMPD_taskloop_simd:
841 case llvm::omp::Directive::OMPD_teams_distribute:
842 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
843 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
844 case llvm::omp::Directive::OMPD_teams_distribute_simd:
845 PushContext(beginDir.source, beginDir.v);
846 break;
847 default:
848 break;
849 }
850 ClearDataSharingAttributeObjects();
851 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
852 PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);
853 return true;
854 }
855
ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name & iv)856 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(
857 const parser::Name &iv) {
858 auto targetIt{dirContext_.rbegin()};
859 for (;; ++targetIt) {
860 if (targetIt == dirContext_.rend()) {
861 return;
862 }
863 if (llvm::omp::parallelSet.test(targetIt->directive) ||
864 llvm::omp::taskGeneratingSet.test(targetIt->directive)) {
865 break;
866 }
867 }
868 if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) {
869 targetIt++;
870 symbol->set(Symbol::Flag::OmpPreDetermined);
871 iv.symbol = symbol; // adjust the symbol within region
872 for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) {
873 AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it);
874 }
875 }
876 }
877
878 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
879 // - A loop iteration variable for a sequential loop in a parallel
880 // or task generating construct is private in the innermost such
881 // construct that encloses the loop
Pre(const parser::DoConstruct & x)882 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
883 if (!dirContext_.empty() && GetContext().withinConstruct) {
884 if (const auto &iv{GetLoopIndex(x)}; iv.symbol) {
885 if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) {
886 ResolveSeqLoopIndexInParallelOrTaskConstruct(iv);
887 } else {
888 // TODO: conflict checks with explicitly determined DSA
889 }
890 }
891 }
892 return true;
893 }
894
GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList & x)895 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses(
896 const parser::OmpClauseList &x) {
897 std::int64_t orderedLevel{0};
898 std::int64_t collapseLevel{0};
899
900 const parser::OmpClause *ordClause{nullptr};
901 const parser::OmpClause *collClause{nullptr};
902
903 for (const auto &clause : x.v) {
904 if (const auto *orderedClause{
905 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
906 if (const auto v{EvaluateInt64(context_, orderedClause->v)}) {
907 orderedLevel = *v;
908 }
909 ordClause = &clause;
910 }
911 if (const auto *collapseClause{
912 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
913 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
914 collapseLevel = *v;
915 }
916 collClause = &clause;
917 }
918 }
919
920 if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) {
921 SetAssociatedClause(*ordClause);
922 return orderedLevel;
923 } else if (!orderedLevel && collapseLevel) {
924 SetAssociatedClause(*collClause);
925 return collapseLevel;
926 } // orderedLevel < collapseLevel is an error handled in structural checks
927 return 1; // default is outermost loop
928 }
929
930 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
931 // - The loop iteration variable(s) in the associated do-loop(s) of a do,
932 // parallel do, taskloop, or distribute construct is (are) private.
933 // - The loop iteration variable in the associated do-loop of a simd construct
934 // with just one associated do-loop is linear with a linear-step that is the
935 // increment of the associated do-loop.
936 // - The loop iteration variables in the associated do-loops of a simd
937 // construct with multiple associated do-loops are lastprivate.
PrivatizeAssociatedLoopIndexAndCheckLoopLevel(const parser::OpenMPLoopConstruct & x)938 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
939 const parser::OpenMPLoopConstruct &x) {
940 std::int64_t level{GetContext().associatedLoopLevel};
941 if (level <= 0) {
942 return;
943 }
944 Symbol::Flag ivDSA;
945 if (!llvm::omp::simdSet.test(GetContext().directive)) {
946 ivDSA = Symbol::Flag::OmpPrivate;
947 } else if (level == 1) {
948 ivDSA = Symbol::Flag::OmpLinear;
949 } else {
950 ivDSA = Symbol::Flag::OmpLastPrivate;
951 }
952
953 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
954 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
955 // go through all the nested do-loops and resolve index variables
956 const parser::Name &iv{GetLoopIndex(*loop)};
957 if (auto *symbol{ResolveOmp(iv, ivDSA, currScope())}) {
958 symbol->set(Symbol::Flag::OmpPreDetermined);
959 iv.symbol = symbol; // adjust the symbol within region
960 AddToContextObjectWithDSA(*symbol, ivDSA);
961 }
962
963 const auto &block{std::get<parser::Block>(loop->t)};
964 const auto it{block.begin()};
965 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
966 }
967 CheckAssocLoopLevel(level, GetAssociatedClause());
968 }
CheckAssocLoopLevel(std::int64_t level,const parser::OmpClause * clause)969 void OmpAttributeVisitor::CheckAssocLoopLevel(
970 std::int64_t level, const parser::OmpClause *clause) {
971 if (clause && level != 0) {
972 context_.Say(clause->source,
973 "The value of the parameter in the COLLAPSE or ORDERED clause must"
974 " not be larger than the number of nested loops"
975 " following the construct."_err_en_US);
976 }
977 }
978
Pre(const parser::OpenMPSectionsConstruct & x)979 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
980 const auto &beginSectionsDir{
981 std::get<parser::OmpBeginSectionsDirective>(x.t)};
982 const auto &beginDir{
983 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
984 switch (beginDir.v) {
985 case llvm::omp::Directive::OMPD_parallel_sections:
986 case llvm::omp::Directive::OMPD_sections:
987 PushContext(beginDir.source, beginDir.v);
988 break;
989 default:
990 break;
991 }
992 ClearDataSharingAttributeObjects();
993 return true;
994 }
995
Pre(const parser::OpenMPThreadprivate & x)996 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
997 PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
998 const auto &list{std::get<parser::OmpObjectList>(x.t)};
999 ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
1000 return true;
1001 }
1002
Post(const parser::OmpDefaultClause & x)1003 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
1004 if (!dirContext_.empty()) {
1005 switch (x.v) {
1006 case parser::OmpDefaultClause::Type::Private:
1007 SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
1008 break;
1009 case parser::OmpDefaultClause::Type::Firstprivate:
1010 SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
1011 break;
1012 case parser::OmpDefaultClause::Type::Shared:
1013 SetContextDefaultDSA(Symbol::Flag::OmpShared);
1014 break;
1015 case parser::OmpDefaultClause::Type::None:
1016 SetContextDefaultDSA(Symbol::Flag::OmpNone);
1017 break;
1018 }
1019 }
1020 }
1021
1022 // For OpenMP constructs, check all the data-refs within the constructs
1023 // and adjust the symbol for each Name if necessary
Post(const parser::Name & name)1024 void OmpAttributeVisitor::Post(const parser::Name &name) {
1025 auto *symbol{name.symbol};
1026 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
1027 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
1028 !IsObjectWithDSA(*symbol)) {
1029 // TODO: create a separate function to go through the rules for
1030 // predetermined, explicitly determined, and implicitly
1031 // determined data-sharing attributes (2.15.1.1).
1032 if (Symbol * found{currScope().FindSymbol(name.source)}) {
1033 if (symbol != found) {
1034 name.symbol = found; // adjust the symbol within region
1035 } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
1036 context_.Say(name.source,
1037 "The DEFAULT(NONE) clause requires that '%s' must be listed in "
1038 "a data-sharing attribute clause"_err_en_US,
1039 symbol->name());
1040 }
1041 }
1042 }
1043 } // within OpenMP construct
1044 }
1045
ResolveName(const parser::Name * name)1046 Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) {
1047 if (auto *resolvedSymbol{
1048 name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {
1049 name->symbol = resolvedSymbol;
1050 return resolvedSymbol;
1051 } else {
1052 return nullptr;
1053 }
1054 }
1055
ResolveOmpName(const parser::Name & name,Symbol::Flag ompFlag)1056 void OmpAttributeVisitor::ResolveOmpName(
1057 const parser::Name &name, Symbol::Flag ompFlag) {
1058 if (ResolveName(&name)) {
1059 if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) {
1060 if (dataSharingAttributeFlags.test(ompFlag)) {
1061 AddToContextObjectWithDSA(*resolvedSymbol, ompFlag);
1062 }
1063 }
1064 }
1065 }
1066
ResolveOmpNameList(const std::list<parser::Name> & nameList,Symbol::Flag ompFlag)1067 void OmpAttributeVisitor::ResolveOmpNameList(
1068 const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) {
1069 for (const auto &name : nameList) {
1070 ResolveOmpName(name, ompFlag);
1071 }
1072 }
1073
ResolveOmpCommonBlockName(const parser::Name * name)1074 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
1075 const parser::Name *name) {
1076 if (auto *prev{name
1077 ? GetContext().scope.parent().FindCommonBlock(name->source)
1078 : nullptr}) {
1079 name->symbol = prev;
1080 return prev;
1081 }
1082 // Check if the Common Block is declared in the current scope
1083 if (auto *commonBlockSymbol{
1084 name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) {
1085 name->symbol = commonBlockSymbol;
1086 return commonBlockSymbol;
1087 }
1088 return nullptr;
1089 }
1090
ResolveOmpObjectList(const parser::OmpObjectList & ompObjectList,Symbol::Flag ompFlag)1091 void OmpAttributeVisitor::ResolveOmpObjectList(
1092 const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
1093 for (const auto &ompObject : ompObjectList.v) {
1094 ResolveOmpObject(ompObject, ompFlag);
1095 }
1096 }
1097
ResolveOmpObject(const parser::OmpObject & ompObject,Symbol::Flag ompFlag)1098 void OmpAttributeVisitor::ResolveOmpObject(
1099 const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
1100 std::visit(
1101 common::visitors{
1102 [&](const parser::Designator &designator) {
1103 if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
1104 if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
1105 if (dataCopyingAttributeFlags.test(ompFlag)) {
1106 CheckDataCopyingClause(*name, *symbol, ompFlag);
1107 } else {
1108 AddToContextObjectWithDSA(*symbol, ompFlag);
1109 if (dataSharingAttributeFlags.test(ompFlag)) {
1110 CheckMultipleAppearances(*name, *symbol, ompFlag);
1111 }
1112 if (privateDataSharingAttributeFlags.test(ompFlag)) {
1113 CheckObjectInNamelist(*name, *symbol, ompFlag);
1114 }
1115
1116 if (ompFlag == Symbol::Flag::OmpAllocate) {
1117 AddAllocateName(name);
1118 }
1119 }
1120 }
1121 } else {
1122 // Array sections to be changed to substrings as needed
1123 if (AnalyzeExpr(context_, designator)) {
1124 if (std::holds_alternative<parser::Substring>(designator.u)) {
1125 context_.Say(designator.source,
1126 "Substrings are not allowed on OpenMP "
1127 "directives or clauses"_err_en_US);
1128 }
1129 }
1130 // other checks, more TBD
1131 }
1132 },
1133 [&](const parser::Name &name) { // common block
1134 if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
1135 if (!dataCopyingAttributeFlags.test(ompFlag)) {
1136 CheckMultipleAppearances(
1137 name, *symbol, Symbol::Flag::OmpCommonBlock);
1138 }
1139 // 2.15.3 When a named common block appears in a list, it has the
1140 // same meaning as if every explicit member of the common block
1141 // appeared in the list
1142 for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
1143 if (auto *resolvedObject{
1144 ResolveOmp(*object, ompFlag, currScope())}) {
1145 if (dataCopyingAttributeFlags.test(ompFlag)) {
1146 CheckDataCopyingClause(name, *resolvedObject, ompFlag);
1147 } else {
1148 AddToContextObjectWithDSA(*resolvedObject, ompFlag);
1149 }
1150 }
1151 }
1152 } else {
1153 context_.Say(name.source, // 2.15.3
1154 "COMMON block must be declared in the same scoping unit "
1155 "in which the OpenMP directive or clause appears"_err_en_US);
1156 }
1157 },
1158 },
1159 ompObject.u);
1160 }
1161
ResolveOmp(const parser::Name & name,Symbol::Flag ompFlag,Scope & scope)1162 Symbol *OmpAttributeVisitor::ResolveOmp(
1163 const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) {
1164 if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1165 return DeclarePrivateAccessEntity(name, ompFlag, scope);
1166 } else {
1167 return DeclareOrMarkOtherAccessEntity(name, ompFlag);
1168 }
1169 }
1170
ResolveOmp(Symbol & symbol,Symbol::Flag ompFlag,Scope & scope)1171 Symbol *OmpAttributeVisitor::ResolveOmp(
1172 Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) {
1173 if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1174 return DeclarePrivateAccessEntity(symbol, ompFlag, scope);
1175 } else {
1176 return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
1177 }
1178 }
1179
DeclareOrMarkOtherAccessEntity(const parser::Name & name,Symbol::Flag ompFlag)1180 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1181 const parser::Name &name, Symbol::Flag ompFlag) {
1182 Symbol *prev{currScope().FindSymbol(name.source)};
1183 if (!name.symbol || !prev) {
1184 return nullptr;
1185 } else if (prev != name.symbol) {
1186 name.symbol = prev;
1187 }
1188 return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
1189 }
1190
DeclareOrMarkOtherAccessEntity(Symbol & object,Symbol::Flag ompFlag)1191 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
1192 Symbol &object, Symbol::Flag ompFlag) {
1193 if (ompFlagsRequireMark.test(ompFlag)) {
1194 object.set(ompFlag);
1195 }
1196 return &object;
1197 }
1198
WithMultipleAppearancesOmpException(const Symbol & symbol,Symbol::Flag flag)1199 static bool WithMultipleAppearancesOmpException(
1200 const Symbol &symbol, Symbol::Flag flag) {
1201 return (flag == Symbol::Flag::OmpFirstPrivate &&
1202 symbol.test(Symbol::Flag::OmpLastPrivate)) ||
1203 (flag == Symbol::Flag::OmpLastPrivate &&
1204 symbol.test(Symbol::Flag::OmpFirstPrivate));
1205 }
1206
CheckMultipleAppearances(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1207 void OmpAttributeVisitor::CheckMultipleAppearances(
1208 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1209 const auto *target{&symbol};
1210 if (ompFlagsRequireNewSymbol.test(ompFlag)) {
1211 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
1212 target = &details->symbol();
1213 }
1214 }
1215 if (HasDataSharingAttributeObject(*target) &&
1216 !WithMultipleAppearancesOmpException(symbol, ompFlag)) {
1217 context_.Say(name.source,
1218 "'%s' appears in more than one data-sharing clause "
1219 "on the same OpenMP directive"_err_en_US,
1220 name.ToString());
1221 } else {
1222 AddDataSharingAttributeObject(*target);
1223 if (privateDataSharingAttributeFlags.test(ompFlag)) {
1224 AddPrivateDataSharingAttributeObjects(*target);
1225 }
1226 }
1227 }
1228
ResolveAccParts(SemanticsContext & context,const parser::ProgramUnit & node)1229 void ResolveAccParts(
1230 SemanticsContext &context, const parser::ProgramUnit &node) {
1231 if (context.IsEnabled(common::LanguageFeature::OpenACC)) {
1232 AccAttributeVisitor{context}.Walk(node);
1233 }
1234 }
1235
ResolveOmpParts(SemanticsContext & context,const parser::ProgramUnit & node)1236 void ResolveOmpParts(
1237 SemanticsContext &context, const parser::ProgramUnit &node) {
1238 if (context.IsEnabled(common::LanguageFeature::OpenMP)) {
1239 OmpAttributeVisitor{context}.Walk(node);
1240 if (!context.AnyFatalError()) {
1241 // The data-sharing attribute of the loop iteration variable for a
1242 // sequential loop (2.15.1.1) can only be determined when visiting
1243 // the corresponding DoConstruct, a second walk is to adjust the
1244 // symbols for all the data-refs of that loop iteration variable
1245 // prior to the DoConstruct.
1246 OmpAttributeVisitor{context}.Walk(node);
1247 }
1248 }
1249 }
1250
CheckDataCopyingClause(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1251 void OmpAttributeVisitor::CheckDataCopyingClause(
1252 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1253 const auto *checkSymbol{&symbol};
1254 if (ompFlag == Symbol::Flag::OmpCopyIn) {
1255 if (const auto *details{symbol.detailsIf<HostAssocDetails>()})
1256 checkSymbol = &details->symbol();
1257
1258 // List of items/objects that can appear in a 'copyin' clause must be
1259 // 'threadprivate'
1260 if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate))
1261 context_.Say(name.source,
1262 "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,
1263 checkSymbol->name());
1264 }
1265 }
1266
CheckObjectInNamelist(const parser::Name & name,const Symbol & symbol,Symbol::Flag ompFlag)1267 void OmpAttributeVisitor::CheckObjectInNamelist(
1268 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
1269 if (symbol.GetUltimate().test(Symbol::Flag::InNamelist)) {
1270 llvm::StringRef clauseName{"PRIVATE"};
1271 if (ompFlag == Symbol::Flag::OmpFirstPrivate)
1272 clauseName = "FIRSTPRIVATE";
1273 else if (ompFlag == Symbol::Flag::OmpLastPrivate)
1274 clauseName = "LASTPRIVATE";
1275 context_.Say(name.source,
1276 "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,
1277 name.ToString(), clauseName.str());
1278 }
1279 }
1280
1281 } // namespace Fortran::semantics
1282