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