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 void Post(const parser::AccDefaultClause &); 144 145 bool Pre(const parser::AccClause::Copy &x) { 146 ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn); 147 ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut); 148 return false; 149 } 150 151 bool Pre(const parser::AccClause::Create &x) { 152 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 153 ResolveAccObjectList(objectList, Symbol::Flag::AccCreate); 154 return false; 155 } 156 157 bool Pre(const parser::AccClause::Copyin &x) { 158 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 159 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn); 160 return false; 161 } 162 163 bool Pre(const parser::AccClause::Copyout &x) { 164 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 165 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut); 166 return false; 167 } 168 169 bool Pre(const parser::AccClause::Present &x) { 170 ResolveAccObjectList(x.v, Symbol::Flag::AccPresent); 171 return false; 172 } 173 bool Pre(const parser::AccClause::Private &x) { 174 ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate); 175 return false; 176 } 177 bool Pre(const parser::AccClause::Firstprivate &x) { 178 ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate); 179 return false; 180 } 181 182 void Post(const parser::Name &); 183 184 private: 185 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &); 186 187 static constexpr Symbol::Flags dataSharingAttributeFlags{ 188 Symbol::Flag::AccShared, Symbol::Flag::AccPrivate, 189 Symbol::Flag::AccPresent, Symbol::Flag::AccFirstPrivate, 190 Symbol::Flag::AccReduction}; 191 192 static constexpr Symbol::Flags dataMappingAttributeFlags{ 193 Symbol::Flag::AccCreate, Symbol::Flag::AccCopyIn, 194 Symbol::Flag::AccCopyOut, Symbol::Flag::AccDelete}; 195 196 static constexpr Symbol::Flags accFlagsRequireNewSymbol{ 197 Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate, 198 Symbol::Flag::AccReduction}; 199 200 static constexpr Symbol::Flags accFlagsRequireMark{}; 201 202 void PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct &); 203 void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag); 204 void ResolveAccObject(const parser::AccObject &, Symbol::Flag); 205 Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &); 206 Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &); 207 Symbol *ResolveAccCommonBlockName(const parser::Name *); 208 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 209 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); 210 void CheckMultipleAppearances( 211 const parser::Name &, const Symbol &, Symbol::Flag); 212 }; 213 214 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct 215 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> { 216 public: 217 explicit OmpAttributeVisitor(SemanticsContext &context) 218 : DirectiveAttributeVisitor(context) {} 219 220 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } 221 template <typename A> bool Pre(const A &) { return true; } 222 template <typename A> void Post(const A &) {} 223 224 bool Pre(const parser::SpecificationPart &x) { 225 Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t)); 226 return true; 227 } 228 229 bool Pre(const parser::OpenMPBlockConstruct &); 230 void Post(const parser::OpenMPBlockConstruct &); 231 232 void Post(const parser::OmpBeginBlockDirective &) { 233 GetContext().withinConstruct = true; 234 } 235 236 bool Pre(const parser::OpenMPLoopConstruct &); 237 void Post(const parser::OpenMPLoopConstruct &) { PopContext(); } 238 void Post(const parser::OmpBeginLoopDirective &) { 239 GetContext().withinConstruct = true; 240 } 241 bool Pre(const parser::DoConstruct &); 242 243 bool Pre(const parser::OpenMPSectionsConstruct &); 244 void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); } 245 246 bool Pre(const parser::OpenMPThreadprivate &); 247 void Post(const parser::OpenMPThreadprivate &) { PopContext(); } 248 249 // 2.15.3 Data-Sharing Attribute Clauses 250 void Post(const parser::OmpDefaultClause &); 251 bool Pre(const parser::OmpClause::Shared &x) { 252 ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared); 253 return false; 254 } 255 bool Pre(const parser::OmpClause::Private &x) { 256 ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate); 257 return false; 258 } 259 bool Pre(const parser::OmpAllocateClause &x) { 260 const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; 261 ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate); 262 return false; 263 } 264 bool Pre(const parser::OmpClause::Firstprivate &x) { 265 ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate); 266 return false; 267 } 268 bool Pre(const parser::OmpClause::Lastprivate &x) { 269 ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate); 270 return false; 271 } 272 bool Pre(const parser::OmpClause::Copyin &x) { 273 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn); 274 return false; 275 } 276 277 void Post(const parser::Name &); 278 279 private: 280 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &); 281 282 static constexpr Symbol::Flags dataSharingAttributeFlags{ 283 Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate, 284 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate, 285 Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear}; 286 287 static constexpr Symbol::Flags privateDataSharingAttributeFlags{ 288 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate, 289 Symbol::Flag::OmpLastPrivate}; 290 291 static constexpr Symbol::Flags ompFlagsRequireNewSymbol{ 292 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear, 293 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate, 294 Symbol::Flag::OmpReduction}; 295 296 static constexpr Symbol::Flags ompFlagsRequireMark{ 297 Symbol::Flag::OmpThreadprivate}; 298 299 static constexpr Symbol::Flags dataCopyingAttributeFlags{ 300 Symbol::Flag::OmpCopyIn}; 301 302 std::vector<const parser::Name *> allocateNames_; // on one directive 303 SymbolSet privateDataSharingAttributeObjects_; // on one directive 304 305 void AddAllocateName(const parser::Name *&object) { 306 allocateNames_.push_back(object); 307 } 308 void ClearAllocateNames() { allocateNames_.clear(); } 309 310 void AddPrivateDataSharingAttributeObjects(SymbolRef object) { 311 privateDataSharingAttributeObjects_.insert(object); 312 } 313 void ClearPrivateDataSharingAttributeObjects() { 314 privateDataSharingAttributeObjects_.clear(); 315 } 316 317 // Predetermined DSA rules 318 void PrivatizeAssociatedLoopIndex(const parser::OpenMPLoopConstruct &); 319 void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &); 320 321 void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag); 322 void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag); 323 Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &); 324 Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &); 325 Symbol *ResolveOmpCommonBlockName(const parser::Name *); 326 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 327 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); 328 void CheckMultipleAppearances( 329 const parser::Name &, const Symbol &, Symbol::Flag); 330 331 void CheckDataCopyingClause( 332 const parser::Name &, const Symbol &, Symbol::Flag); 333 }; 334 335 template <typename T> 336 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject( 337 const Symbol &object) { 338 auto it{dataSharingAttributeObjects_.find(object)}; 339 return it != dataSharingAttributeObjects_.end(); 340 } 341 342 template <typename T> 343 const parser::Name &DirectiveAttributeVisitor<T>::GetLoopIndex( 344 const parser::DoConstruct &x) { 345 using Bounds = parser::LoopControl::Bounds; 346 return std::get<Bounds>(x.GetLoopControl()->u).name.thing; 347 } 348 349 template <typename T> 350 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf( 351 const parser::ExecutionPartConstruct &x) { 352 return parser::Unwrap<parser::DoConstruct>(x); 353 } 354 355 template <typename T> 356 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity( 357 const parser::Name &name, Symbol::Flag flag, Scope &scope) { 358 if (!name.symbol) { 359 return nullptr; // not resolved by Name Resolution step, do nothing 360 } 361 name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope); 362 return name.symbol; 363 } 364 365 template <typename T> 366 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity( 367 Symbol &object, Symbol::Flag flag, Scope &scope) { 368 if (object.owner() != currScope()) { 369 auto &symbol{MakeAssocSymbol(object.name(), object, scope)}; 370 symbol.set(flag); 371 return &symbol; 372 } else { 373 object.set(flag); 374 return &object; 375 } 376 } 377 378 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) { 379 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; 380 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; 381 switch (blockDir.v) { 382 case llvm::acc::Directive::ACCD_data: 383 case llvm::acc::Directive::ACCD_host_data: 384 case llvm::acc::Directive::ACCD_kernels: 385 case llvm::acc::Directive::ACCD_parallel: 386 case llvm::acc::Directive::ACCD_serial: 387 PushContext(blockDir.source, blockDir.v); 388 break; 389 default: 390 break; 391 } 392 ClearDataSharingAttributeObjects(); 393 return true; 394 } 395 396 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) { 397 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)}; 398 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)}; 399 const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)}; 400 if (loopDir.v == llvm::acc::Directive::ACCD_loop) { 401 PushContext(loopDir.source, loopDir.v); 402 } 403 ClearDataSharingAttributeObjects(); 404 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 405 PrivatizeAssociatedLoopIndex(x); 406 return true; 407 } 408 409 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) { 410 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)}; 411 switch (standaloneDir.v) { 412 case llvm::acc::Directive::ACCD_cache: 413 case llvm::acc::Directive::ACCD_enter_data: 414 case llvm::acc::Directive::ACCD_exit_data: 415 case llvm::acc::Directive::ACCD_init: 416 case llvm::acc::Directive::ACCD_set: 417 case llvm::acc::Directive::ACCD_shutdown: 418 case llvm::acc::Directive::ACCD_update: 419 PushContext(standaloneDir.source, standaloneDir.v); 420 break; 421 default: 422 break; 423 } 424 ClearDataSharingAttributeObjects(); 425 return true; 426 } 427 428 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) { 429 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)}; 430 const auto &combinedDir{ 431 std::get<parser::AccCombinedDirective>(beginBlockDir.t)}; 432 switch (combinedDir.v) { 433 case llvm::acc::Directive::ACCD_kernels_loop: 434 case llvm::acc::Directive::ACCD_parallel_loop: 435 case llvm::acc::Directive::ACCD_serial_loop: 436 PushContext(combinedDir.source, combinedDir.v); 437 break; 438 default: 439 break; 440 } 441 ClearDataSharingAttributeObjects(); 442 return true; 443 } 444 445 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses( 446 const parser::AccClauseList &x) { 447 std::int64_t collapseLevel{0}; 448 for (const auto &clause : x.v) { 449 if (const auto *collapseClause{ 450 std::get_if<parser::AccClause::Collapse>(&clause.u)}) { 451 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) { 452 collapseLevel = *v; 453 } 454 } 455 } 456 457 if (collapseLevel) { 458 return collapseLevel; 459 } 460 return 1; // default is outermost loop 461 } 462 463 void AccAttributeVisitor::PrivatizeAssociatedLoopIndex( 464 const parser::OpenACCLoopConstruct &x) { 465 std::int64_t level{GetContext().associatedLoopLevel}; 466 if (level <= 0) { // collpase value was negative or 0 467 return; 468 } 469 Symbol::Flag ivDSA{Symbol::Flag::AccPrivate}; 470 471 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 472 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) { 473 // go through all the nested do-loops and resolve index variables 474 const parser::Name &iv{GetLoopIndex(*loop)}; 475 if (auto *symbol{ResolveAcc(iv, ivDSA, currScope())}) { 476 symbol->set(Symbol::Flag::AccPreDetermined); 477 iv.symbol = symbol; // adjust the symbol within region 478 AddToContextObjectWithDSA(*symbol, ivDSA); 479 } 480 481 const auto &block{std::get<parser::Block>(loop->t)}; 482 const auto it{block.begin()}; 483 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr; 484 } 485 CHECK(level == 0); 486 } 487 488 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) { 489 if (!dirContext_.empty()) { 490 switch (x.v) { 491 case parser::AccDefaultClause::Arg::Present: 492 SetContextDefaultDSA(Symbol::Flag::AccPresent); 493 break; 494 case parser::AccDefaultClause::Arg::None: 495 SetContextDefaultDSA(Symbol::Flag::AccNone); 496 break; 497 } 498 } 499 } 500 501 // For OpenACC constructs, check all the data-refs within the constructs 502 // and adjust the symbol for each Name if necessary 503 void AccAttributeVisitor::Post(const parser::Name &name) { 504 auto *symbol{name.symbol}; 505 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) { 506 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() && 507 !IsObjectWithDSA(*symbol)) { 508 if (Symbol * found{currScope().FindSymbol(name.source)}) { 509 if (symbol != found) { 510 name.symbol = found; // adjust the symbol within region 511 } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) { 512 // 2.5.14. 513 context_.Say(name.source, 514 "The DEFAULT(NONE) clause requires that '%s' must be listed in " 515 "a data-mapping clause"_err_en_US, 516 symbol->name()); 517 } 518 } 519 } 520 } // within OpenACC construct 521 } 522 523 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName( 524 const parser::Name *name) { 525 if (!name) { 526 return nullptr; 527 } else if (auto *prev{ 528 GetContext().scope.parent().FindCommonBlock(name->source)}) { 529 name->symbol = prev; 530 return prev; 531 } else { 532 return nullptr; 533 } 534 } 535 536 void AccAttributeVisitor::ResolveAccObjectList( 537 const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) { 538 for (const auto &accObject : accObjectList.v) { 539 ResolveAccObject(accObject, accFlag); 540 } 541 } 542 543 void AccAttributeVisitor::ResolveAccObject( 544 const parser::AccObject &accObject, Symbol::Flag accFlag) { 545 std::visit( 546 common::visitors{ 547 [&](const parser::Designator &designator) { 548 if (const auto *name{GetDesignatorNameIfDataRef(designator)}) { 549 if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) { 550 AddToContextObjectWithDSA(*symbol, accFlag); 551 if (dataSharingAttributeFlags.test(accFlag)) { 552 CheckMultipleAppearances(*name, *symbol, accFlag); 553 } 554 } 555 } else { 556 // Array sections to be changed to substrings as needed 557 if (AnalyzeExpr(context_, designator)) { 558 if (std::holds_alternative<parser::Substring>(designator.u)) { 559 context_.Say(designator.source, 560 "Substrings are not allowed on OpenACC " 561 "directives or clauses"_err_en_US); 562 } 563 } 564 // other checks, more TBD 565 } 566 }, 567 [&](const parser::Name &name) { // common block 568 if (auto *symbol{ResolveAccCommonBlockName(&name)}) { 569 CheckMultipleAppearances( 570 name, *symbol, Symbol::Flag::AccCommonBlock); 571 for (auto &object : symbol->get<CommonBlockDetails>().objects()) { 572 if (auto *resolvedObject{ 573 ResolveAcc(*object, accFlag, currScope())}) { 574 AddToContextObjectWithDSA(*resolvedObject, accFlag); 575 } 576 } 577 } else { 578 context_.Say(name.source, 579 "COMMON block must be declared in the same scoping unit " 580 "in which the OpenACC directive or clause appears"_err_en_US); 581 } 582 }, 583 }, 584 accObject.u); 585 } 586 587 Symbol *AccAttributeVisitor::ResolveAcc( 588 const parser::Name &name, Symbol::Flag accFlag, Scope &scope) { 589 if (accFlagsRequireNewSymbol.test(accFlag)) { 590 return DeclarePrivateAccessEntity(name, accFlag, scope); 591 } else { 592 return DeclareOrMarkOtherAccessEntity(name, accFlag); 593 } 594 } 595 596 Symbol *AccAttributeVisitor::ResolveAcc( 597 Symbol &symbol, Symbol::Flag accFlag, Scope &scope) { 598 if (accFlagsRequireNewSymbol.test(accFlag)) { 599 return DeclarePrivateAccessEntity(symbol, accFlag, scope); 600 } else { 601 return DeclareOrMarkOtherAccessEntity(symbol, accFlag); 602 } 603 } 604 605 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity( 606 const parser::Name &name, Symbol::Flag accFlag) { 607 Symbol *prev{currScope().FindSymbol(name.source)}; 608 if (!name.symbol || !prev) { 609 return nullptr; 610 } else if (prev != name.symbol) { 611 name.symbol = prev; 612 } 613 return DeclareOrMarkOtherAccessEntity(*prev, accFlag); 614 } 615 616 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity( 617 Symbol &object, Symbol::Flag accFlag) { 618 if (accFlagsRequireMark.test(accFlag)) { 619 object.set(accFlag); 620 } 621 return &object; 622 } 623 624 static bool WithMultipleAppearancesAccException( 625 const Symbol &symbol, Symbol::Flag flag) { 626 return false; // Place holder 627 } 628 629 void AccAttributeVisitor::CheckMultipleAppearances( 630 const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) { 631 const auto *target{&symbol}; 632 if (accFlagsRequireNewSymbol.test(accFlag)) { 633 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 634 target = &details->symbol(); 635 } 636 } 637 if (HasDataSharingAttributeObject(*target) && 638 !WithMultipleAppearancesAccException(symbol, accFlag)) { 639 context_.Say(name.source, 640 "'%s' appears in more than one data-sharing clause " 641 "on the same OpenACC directive"_err_en_US, 642 name.ToString()); 643 } else { 644 AddDataSharingAttributeObject(*target); 645 } 646 } 647 648 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) { 649 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 650 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 651 switch (beginDir.v) { 652 case llvm::omp::Directive::OMPD_master: 653 case llvm::omp::Directive::OMPD_ordered: 654 case llvm::omp::Directive::OMPD_parallel: 655 case llvm::omp::Directive::OMPD_single: 656 case llvm::omp::Directive::OMPD_target: 657 case llvm::omp::Directive::OMPD_target_data: 658 case llvm::omp::Directive::OMPD_task: 659 case llvm::omp::Directive::OMPD_teams: 660 case llvm::omp::Directive::OMPD_workshare: 661 case llvm::omp::Directive::OMPD_parallel_workshare: 662 case llvm::omp::Directive::OMPD_target_teams: 663 case llvm::omp::Directive::OMPD_target_parallel: 664 PushContext(beginDir.source, beginDir.v); 665 break; 666 default: 667 // TODO others 668 break; 669 } 670 ClearDataSharingAttributeObjects(); 671 ClearPrivateDataSharingAttributeObjects(); 672 ClearAllocateNames(); 673 return true; 674 } 675 676 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) { 677 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 678 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 679 switch (beginDir.v) { 680 case llvm::omp::Directive::OMPD_parallel: 681 case llvm::omp::Directive::OMPD_single: 682 case llvm::omp::Directive::OMPD_target: 683 case llvm::omp::Directive::OMPD_task: 684 case llvm::omp::Directive::OMPD_teams: 685 case llvm::omp::Directive::OMPD_parallel_workshare: 686 case llvm::omp::Directive::OMPD_target_teams: 687 case llvm::omp::Directive::OMPD_target_parallel: { 688 bool hasPrivate; 689 for (const auto *allocName : allocateNames_) { 690 hasPrivate = false; 691 for (auto privateObj : privateDataSharingAttributeObjects_) { 692 const Symbol &symbolPrivate{*privateObj}; 693 if (allocName->source == symbolPrivate.name()) { 694 hasPrivate = true; 695 break; 696 } 697 } 698 if (!hasPrivate) { 699 context_.Say(allocName->source, 700 "The ALLOCATE clause requires that '%s' must be listed in a " 701 "private " 702 "data-sharing attribute clause on the same directive"_err_en_US, 703 allocName->ToString()); 704 } 705 } 706 break; 707 } 708 default: 709 break; 710 } 711 PopContext(); 712 } 713 714 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) { 715 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 716 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 717 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)}; 718 switch (beginDir.v) { 719 case llvm::omp::Directive::OMPD_distribute: 720 case llvm::omp::Directive::OMPD_distribute_parallel_do: 721 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd: 722 case llvm::omp::Directive::OMPD_distribute_simd: 723 case llvm::omp::Directive::OMPD_do: 724 case llvm::omp::Directive::OMPD_do_simd: 725 case llvm::omp::Directive::OMPD_parallel_do: 726 case llvm::omp::Directive::OMPD_parallel_do_simd: 727 case llvm::omp::Directive::OMPD_simd: 728 case llvm::omp::Directive::OMPD_target_parallel_do: 729 case llvm::omp::Directive::OMPD_target_parallel_do_simd: 730 case llvm::omp::Directive::OMPD_target_teams_distribute: 731 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 732 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 733 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 734 case llvm::omp::Directive::OMPD_target_simd: 735 case llvm::omp::Directive::OMPD_taskloop: 736 case llvm::omp::Directive::OMPD_taskloop_simd: 737 case llvm::omp::Directive::OMPD_teams_distribute: 738 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do: 739 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd: 740 case llvm::omp::Directive::OMPD_teams_distribute_simd: 741 PushContext(beginDir.source, beginDir.v); 742 break; 743 default: 744 break; 745 } 746 ClearDataSharingAttributeObjects(); 747 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 748 PrivatizeAssociatedLoopIndex(x); 749 return true; 750 } 751 752 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct( 753 const parser::Name &iv) { 754 auto targetIt{dirContext_.rbegin()}; 755 for (;; ++targetIt) { 756 if (targetIt == dirContext_.rend()) { 757 return; 758 } 759 if (llvm::omp::parallelSet.test(targetIt->directive) || 760 llvm::omp::taskGeneratingSet.test(targetIt->directive)) { 761 break; 762 } 763 } 764 if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) { 765 targetIt++; 766 symbol->set(Symbol::Flag::OmpPreDetermined); 767 iv.symbol = symbol; // adjust the symbol within region 768 for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) { 769 AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it); 770 } 771 } 772 } 773 774 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined 775 // - A loop iteration variable for a sequential loop in a parallel 776 // or task generating construct is private in the innermost such 777 // construct that encloses the loop 778 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) { 779 if (!dirContext_.empty() && GetContext().withinConstruct) { 780 if (const auto &iv{GetLoopIndex(x)}; iv.symbol) { 781 if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) { 782 ResolveSeqLoopIndexInParallelOrTaskConstruct(iv); 783 } else { 784 // TODO: conflict checks with explicitly determined DSA 785 } 786 } 787 } 788 return true; 789 } 790 791 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses( 792 const parser::OmpClauseList &x) { 793 std::int64_t orderedLevel{0}; 794 std::int64_t collapseLevel{0}; 795 for (const auto &clause : x.v) { 796 if (const auto *orderedClause{ 797 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) { 798 if (const auto v{EvaluateInt64(context_, orderedClause->v)}) { 799 orderedLevel = *v; 800 } 801 } 802 if (const auto *collapseClause{ 803 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) { 804 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) { 805 collapseLevel = *v; 806 } 807 } 808 } 809 810 if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) { 811 return orderedLevel; 812 } else if (!orderedLevel && collapseLevel) { 813 return collapseLevel; 814 } // orderedLevel < collapseLevel is an error handled in structural checks 815 return 1; // default is outermost loop 816 } 817 818 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined 819 // - The loop iteration variable(s) in the associated do-loop(s) of a do, 820 // parallel do, taskloop, or distribute construct is (are) private. 821 // - The loop iteration variable in the associated do-loop of a simd construct 822 // with just one associated do-loop is linear with a linear-step that is the 823 // increment of the associated do-loop. 824 // - The loop iteration variables in the associated do-loops of a simd 825 // construct with multiple associated do-loops are lastprivate. 826 // 827 // TODO: revisit after semantics checks are completed for do-loop association of 828 // collapse and ordered 829 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndex( 830 const parser::OpenMPLoopConstruct &x) { 831 std::int64_t level{GetContext().associatedLoopLevel}; 832 if (level <= 0) { 833 return; 834 } 835 Symbol::Flag ivDSA; 836 if (!llvm::omp::simdSet.test(GetContext().directive)) { 837 ivDSA = Symbol::Flag::OmpPrivate; 838 } else if (level == 1) { 839 ivDSA = Symbol::Flag::OmpLinear; 840 } else { 841 ivDSA = Symbol::Flag::OmpLastPrivate; 842 } 843 844 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 845 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) { 846 // go through all the nested do-loops and resolve index variables 847 const parser::Name &iv{GetLoopIndex(*loop)}; 848 if (auto *symbol{ResolveOmp(iv, ivDSA, currScope())}) { 849 symbol->set(Symbol::Flag::OmpPreDetermined); 850 iv.symbol = symbol; // adjust the symbol within region 851 AddToContextObjectWithDSA(*symbol, ivDSA); 852 } 853 854 const auto &block{std::get<parser::Block>(loop->t)}; 855 const auto it{block.begin()}; 856 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr; 857 } 858 CHECK(level == 0); 859 } 860 861 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) { 862 const auto &beginSectionsDir{ 863 std::get<parser::OmpBeginSectionsDirective>(x.t)}; 864 const auto &beginDir{ 865 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 866 switch (beginDir.v) { 867 case llvm::omp::Directive::OMPD_parallel_sections: 868 case llvm::omp::Directive::OMPD_sections: 869 PushContext(beginDir.source, beginDir.v); 870 break; 871 default: 872 break; 873 } 874 ClearDataSharingAttributeObjects(); 875 return true; 876 } 877 878 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { 879 PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate); 880 const auto &list{std::get<parser::OmpObjectList>(x.t)}; 881 ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate); 882 return true; 883 } 884 885 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) { 886 if (!dirContext_.empty()) { 887 switch (x.v) { 888 case parser::OmpDefaultClause::Type::Private: 889 SetContextDefaultDSA(Symbol::Flag::OmpPrivate); 890 break; 891 case parser::OmpDefaultClause::Type::Firstprivate: 892 SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate); 893 break; 894 case parser::OmpDefaultClause::Type::Shared: 895 SetContextDefaultDSA(Symbol::Flag::OmpShared); 896 break; 897 case parser::OmpDefaultClause::Type::None: 898 SetContextDefaultDSA(Symbol::Flag::OmpNone); 899 break; 900 } 901 } 902 } 903 904 // For OpenMP constructs, check all the data-refs within the constructs 905 // and adjust the symbol for each Name if necessary 906 void OmpAttributeVisitor::Post(const parser::Name &name) { 907 auto *symbol{name.symbol}; 908 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) { 909 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() && 910 !IsObjectWithDSA(*symbol)) { 911 // TODO: create a separate function to go through the rules for 912 // predetermined, explicitly determined, and implicitly 913 // determined data-sharing attributes (2.15.1.1). 914 if (Symbol * found{currScope().FindSymbol(name.source)}) { 915 if (symbol != found) { 916 name.symbol = found; // adjust the symbol within region 917 } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) { 918 context_.Say(name.source, 919 "The DEFAULT(NONE) clause requires that '%s' must be listed in " 920 "a data-sharing attribute clause"_err_en_US, 921 symbol->name()); 922 } 923 } 924 } 925 } // within OpenMP construct 926 } 927 928 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName( 929 const parser::Name *name) { 930 if (auto *prev{name 931 ? GetContext().scope.parent().FindCommonBlock(name->source) 932 : nullptr}) { 933 name->symbol = prev; 934 return prev; 935 } 936 // Check if the Common Block is declared in the current scope 937 if (auto *commonBlockSymbol{ 938 name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) { 939 name->symbol = commonBlockSymbol; 940 return commonBlockSymbol; 941 } 942 return nullptr; 943 } 944 945 void OmpAttributeVisitor::ResolveOmpObjectList( 946 const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) { 947 for (const auto &ompObject : ompObjectList.v) { 948 ResolveOmpObject(ompObject, ompFlag); 949 } 950 } 951 952 void OmpAttributeVisitor::ResolveOmpObject( 953 const parser::OmpObject &ompObject, Symbol::Flag ompFlag) { 954 std::visit( 955 common::visitors{ 956 [&](const parser::Designator &designator) { 957 if (const auto *name{GetDesignatorNameIfDataRef(designator)}) { 958 if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) { 959 if (dataCopyingAttributeFlags.test(ompFlag)) { 960 CheckDataCopyingClause(*name, *symbol, ompFlag); 961 } else { 962 AddToContextObjectWithDSA(*symbol, ompFlag); 963 if (dataSharingAttributeFlags.test(ompFlag)) { 964 CheckMultipleAppearances(*name, *symbol, ompFlag); 965 } 966 if (ompFlag == Symbol::Flag::OmpAllocate) { 967 AddAllocateName(name); 968 } 969 } 970 } 971 } else { 972 // Array sections to be changed to substrings as needed 973 if (AnalyzeExpr(context_, designator)) { 974 if (std::holds_alternative<parser::Substring>(designator.u)) { 975 context_.Say(designator.source, 976 "Substrings are not allowed on OpenMP " 977 "directives or clauses"_err_en_US); 978 } 979 } 980 // other checks, more TBD 981 } 982 }, 983 [&](const parser::Name &name) { // common block 984 if (auto *symbol{ResolveOmpCommonBlockName(&name)}) { 985 if (!dataCopyingAttributeFlags.test(ompFlag)) { 986 CheckMultipleAppearances( 987 name, *symbol, Symbol::Flag::OmpCommonBlock); 988 } 989 // 2.15.3 When a named common block appears in a list, it has the 990 // same meaning as if every explicit member of the common block 991 // appeared in the list 992 for (auto &object : symbol->get<CommonBlockDetails>().objects()) { 993 if (auto *resolvedObject{ 994 ResolveOmp(*object, ompFlag, currScope())}) { 995 if (dataCopyingAttributeFlags.test(ompFlag)) { 996 CheckDataCopyingClause(name, *resolvedObject, ompFlag); 997 } else { 998 AddToContextObjectWithDSA(*resolvedObject, ompFlag); 999 } 1000 } 1001 } 1002 } else { 1003 context_.Say(name.source, // 2.15.3 1004 "COMMON block must be declared in the same scoping unit " 1005 "in which the OpenMP directive or clause appears"_err_en_US); 1006 } 1007 }, 1008 }, 1009 ompObject.u); 1010 } 1011 1012 Symbol *OmpAttributeVisitor::ResolveOmp( 1013 const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) { 1014 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1015 return DeclarePrivateAccessEntity(name, ompFlag, scope); 1016 } else { 1017 return DeclareOrMarkOtherAccessEntity(name, ompFlag); 1018 } 1019 } 1020 1021 Symbol *OmpAttributeVisitor::ResolveOmp( 1022 Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) { 1023 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1024 return DeclarePrivateAccessEntity(symbol, ompFlag, scope); 1025 } else { 1026 return DeclareOrMarkOtherAccessEntity(symbol, ompFlag); 1027 } 1028 } 1029 1030 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1031 const parser::Name &name, Symbol::Flag ompFlag) { 1032 Symbol *prev{currScope().FindSymbol(name.source)}; 1033 if (!name.symbol || !prev) { 1034 return nullptr; 1035 } else if (prev != name.symbol) { 1036 name.symbol = prev; 1037 } 1038 return DeclareOrMarkOtherAccessEntity(*prev, ompFlag); 1039 } 1040 1041 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1042 Symbol &object, Symbol::Flag ompFlag) { 1043 if (ompFlagsRequireMark.test(ompFlag)) { 1044 object.set(ompFlag); 1045 } 1046 return &object; 1047 } 1048 1049 static bool WithMultipleAppearancesOmpException( 1050 const Symbol &symbol, Symbol::Flag flag) { 1051 return (flag == Symbol::Flag::OmpFirstPrivate && 1052 symbol.test(Symbol::Flag::OmpLastPrivate)) || 1053 (flag == Symbol::Flag::OmpLastPrivate && 1054 symbol.test(Symbol::Flag::OmpFirstPrivate)); 1055 } 1056 1057 void OmpAttributeVisitor::CheckMultipleAppearances( 1058 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 1059 const auto *target{&symbol}; 1060 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1061 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 1062 target = &details->symbol(); 1063 } 1064 } 1065 if (HasDataSharingAttributeObject(*target) && 1066 !WithMultipleAppearancesOmpException(symbol, ompFlag)) { 1067 context_.Say(name.source, 1068 "'%s' appears in more than one data-sharing clause " 1069 "on the same OpenMP directive"_err_en_US, 1070 name.ToString()); 1071 } else { 1072 AddDataSharingAttributeObject(*target); 1073 if (privateDataSharingAttributeFlags.test(ompFlag)) { 1074 AddPrivateDataSharingAttributeObjects(*target); 1075 } 1076 } 1077 } 1078 1079 void ResolveAccParts( 1080 SemanticsContext &context, const parser::ProgramUnit &node) { 1081 if (context.IsEnabled(common::LanguageFeature::OpenACC)) { 1082 AccAttributeVisitor{context}.Walk(node); 1083 } 1084 } 1085 1086 void ResolveOmpParts( 1087 SemanticsContext &context, const parser::ProgramUnit &node) { 1088 if (context.IsEnabled(common::LanguageFeature::OpenMP)) { 1089 OmpAttributeVisitor{context}.Walk(node); 1090 if (!context.AnyFatalError()) { 1091 // The data-sharing attribute of the loop iteration variable for a 1092 // sequential loop (2.15.1.1) can only be determined when visiting 1093 // the corresponding DoConstruct, a second walk is to adjust the 1094 // symbols for all the data-refs of that loop iteration variable 1095 // prior to the DoConstruct. 1096 OmpAttributeVisitor{context}.Walk(node); 1097 } 1098 } 1099 } 1100 1101 void OmpAttributeVisitor::CheckDataCopyingClause( 1102 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 1103 const auto *checkSymbol{&symbol}; 1104 if (ompFlag == Symbol::Flag::OmpCopyIn) { 1105 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) 1106 checkSymbol = &details->symbol(); 1107 1108 // List of items/objects that can appear in a 'copyin' clause must be 1109 // 'threadprivate' 1110 if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate)) 1111 context_.Say(name.source, 1112 "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US, 1113 checkSymbol->name()); 1114 } 1115 } 1116 1117 } // namespace Fortran::semantics 1118