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 std::optional<DirContext> GetContextIf() { 52 return dirContext_.empty() 53 ? std::nullopt 54 : std::make_optional<DirContext>(dirContext_.back()); 55 } 56 void PushContext(const parser::CharBlock &source, T dir) { 57 dirContext_.emplace_back(source, dir, context_.FindScope(source)); 58 } 59 void PopContext() { dirContext_.pop_back(); } 60 void SetContextDirectiveSource(parser::CharBlock &dir) { 61 GetContext().directiveSource = dir; 62 } 63 Scope &currScope() { return GetContext().scope; } 64 void SetContextDefaultDSA(Symbol::Flag flag) { 65 GetContext().defaultDSA = flag; 66 } 67 void AddToContextObjectWithDSA( 68 const Symbol &symbol, Symbol::Flag flag, DirContext &context) { 69 context.objectWithDSA.emplace(&symbol, flag); 70 } 71 void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) { 72 AddToContextObjectWithDSA(symbol, flag, GetContext()); 73 } 74 bool IsObjectWithDSA(const Symbol &symbol) { 75 auto it{GetContext().objectWithDSA.find(&symbol)}; 76 return it != GetContext().objectWithDSA.end(); 77 } 78 void SetContextAssociatedLoopLevel(std::int64_t level) { 79 GetContext().associatedLoopLevel = level; 80 } 81 Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev, Scope &scope) { 82 const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})}; 83 return *pair.first->second; 84 } 85 Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) { 86 return MakeAssocSymbol(name, prev, currScope()); 87 } 88 static const parser::Name *GetDesignatorNameIfDataRef( 89 const parser::Designator &designator) { 90 const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)}; 91 return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr; 92 } 93 void AddDataSharingAttributeObject(SymbolRef object) { 94 dataSharingAttributeObjects_.insert(object); 95 } 96 void ClearDataSharingAttributeObjects() { 97 dataSharingAttributeObjects_.clear(); 98 } 99 bool HasDataSharingAttributeObject(const Symbol &); 100 const parser::Name &GetLoopIndex(const parser::DoConstruct &); 101 const parser::DoConstruct *GetDoConstructIf( 102 const parser::ExecutionPartConstruct &); 103 Symbol *DeclarePrivateAccessEntity( 104 const parser::Name &, Symbol::Flag, Scope &); 105 Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &); 106 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 107 108 UnorderedSymbolSet dataSharingAttributeObjects_; // on one directive 109 SemanticsContext &context_; 110 std::vector<DirContext> dirContext_; // used as a stack 111 }; 112 113 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> { 114 public: 115 explicit AccAttributeVisitor(SemanticsContext &context) 116 : DirectiveAttributeVisitor(context) {} 117 118 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } 119 template <typename A> bool Pre(const A &) { return true; } 120 template <typename A> void Post(const A &) {} 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 bool Pre(const parser::OpenACCDeclarativeConstruct &); 128 void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); } 129 130 bool Pre(const parser::OpenACCRoutineConstruct &); 131 bool Pre(const parser::AccBindClause &); 132 void Post(const parser::OpenACCStandaloneDeclarativeConstruct &); 133 134 void Post(const parser::AccBeginBlockDirective &) { 135 GetContext().withinConstruct = true; 136 } 137 138 bool Pre(const parser::OpenACCLoopConstruct &); 139 void Post(const parser::OpenACCLoopConstruct &) { PopContext(); } 140 void Post(const parser::AccLoopDirective &) { 141 GetContext().withinConstruct = true; 142 } 143 144 bool Pre(const parser::OpenACCStandaloneConstruct &); 145 void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); } 146 void Post(const parser::AccStandaloneDirective &) { 147 GetContext().withinConstruct = true; 148 } 149 150 bool Pre(const parser::OpenACCCacheConstruct &); 151 void Post(const parser::OpenACCCacheConstruct &) { PopContext(); } 152 153 void Post(const parser::AccDefaultClause &); 154 155 bool Pre(const parser::AccClause::Attach &); 156 bool Pre(const parser::AccClause::Detach &); 157 158 bool Pre(const parser::AccClause::Copy &x) { 159 ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn); 160 ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut); 161 return false; 162 } 163 164 bool Pre(const parser::AccClause::Create &x) { 165 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 166 ResolveAccObjectList(objectList, Symbol::Flag::AccCreate); 167 return false; 168 } 169 170 bool Pre(const parser::AccClause::Copyin &x) { 171 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 172 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn); 173 return false; 174 } 175 176 bool Pre(const parser::AccClause::Copyout &x) { 177 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 178 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut); 179 return false; 180 } 181 182 bool Pre(const parser::AccClause::Present &x) { 183 ResolveAccObjectList(x.v, Symbol::Flag::AccPresent); 184 return false; 185 } 186 bool Pre(const parser::AccClause::Private &x) { 187 ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate); 188 return false; 189 } 190 bool Pre(const parser::AccClause::Firstprivate &x) { 191 ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate); 192 return false; 193 } 194 195 void Post(const parser::Name &); 196 197 private: 198 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &); 199 200 static constexpr Symbol::Flags dataSharingAttributeFlags{ 201 Symbol::Flag::AccShared, Symbol::Flag::AccPrivate, 202 Symbol::Flag::AccPresent, Symbol::Flag::AccFirstPrivate, 203 Symbol::Flag::AccReduction}; 204 205 static constexpr Symbol::Flags dataMappingAttributeFlags{ 206 Symbol::Flag::AccCreate, Symbol::Flag::AccCopyIn, 207 Symbol::Flag::AccCopyOut, Symbol::Flag::AccDelete}; 208 209 static constexpr Symbol::Flags accFlagsRequireNewSymbol{ 210 Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate, 211 Symbol::Flag::AccReduction}; 212 213 static constexpr Symbol::Flags accFlagsRequireMark{}; 214 215 void PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct &); 216 void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag); 217 void ResolveAccObject(const parser::AccObject &, Symbol::Flag); 218 Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &); 219 Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &); 220 Symbol *ResolveName(const parser::Name &); 221 Symbol *ResolveAccCommonBlockName(const parser::Name *); 222 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 223 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); 224 void CheckMultipleAppearances( 225 const parser::Name &, const Symbol &, Symbol::Flag); 226 void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList); 227 void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList); 228 void EnsureAllocatableOrPointer( 229 const llvm::acc::Clause clause, const parser::AccObjectList &objectList); 230 }; 231 232 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct 233 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> { 234 public: 235 explicit OmpAttributeVisitor(SemanticsContext &context) 236 : DirectiveAttributeVisitor(context) {} 237 238 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } 239 template <typename A> bool Pre(const A &) { return true; } 240 template <typename A> void Post(const A &) {} 241 242 template <typename A> bool Pre(const parser::Statement<A> &statement) { 243 currentStatementSource_ = statement.source; 244 // Keep track of the labels in all the labelled statements 245 if (statement.label) { 246 auto label{statement.label.value()}; 247 // Get the context to check if the labelled statement is in an 248 // enclosing OpenMP construct 249 std::optional<DirContext> thisContext{GetContextIf()}; 250 targetLabels_.emplace( 251 label, std::make_pair(currentStatementSource_, thisContext)); 252 // Check if a statement that causes a jump to the 'label' 253 // has already been encountered 254 auto range{sourceLabels_.equal_range(label)}; 255 for (auto it{range.first}; it != range.second; ++it) { 256 // Check if both the statement with 'label' and the statement that 257 // causes a jump to the 'label' are in the same scope 258 CheckLabelContext(it->second.first, currentStatementSource_, 259 it->second.second, thisContext); 260 } 261 } 262 return true; 263 } 264 265 bool Pre(const parser::InternalSubprogram &) { 266 // Clear the labels being tracked in the previous scope 267 ClearLabels(); 268 return true; 269 } 270 271 bool Pre(const parser::ModuleSubprogram &) { 272 // Clear the labels being tracked in the previous scope 273 ClearLabels(); 274 return true; 275 } 276 277 bool Pre(const parser::SpecificationPart &x) { 278 Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t)); 279 return true; 280 } 281 282 bool Pre(const parser::StmtFunctionStmt &x) { 283 const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)}; 284 if (const auto *expr{GetExpr(parsedExpr)}) { 285 for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) { 286 if (!IsStmtFunctionDummy(symbol)) { 287 stmtFunctionExprSymbols_.insert(symbol.GetUltimate()); 288 } 289 } 290 } 291 return true; 292 } 293 294 bool Pre(const parser::OpenMPBlockConstruct &); 295 void Post(const parser::OpenMPBlockConstruct &); 296 bool Pre(const parser::OmpCriticalDirective &x); 297 bool Pre(const parser::OmpEndCriticalDirective &x); 298 299 void Post(const parser::OmpBeginBlockDirective &) { 300 GetContext().withinConstruct = true; 301 } 302 303 bool Pre(const parser::OpenMPSimpleStandaloneConstruct &); 304 void Post(const parser::OpenMPSimpleStandaloneConstruct &) { PopContext(); } 305 306 bool Pre(const parser::OpenMPLoopConstruct &); 307 void Post(const parser::OpenMPLoopConstruct &) { PopContext(); } 308 void Post(const parser::OmpBeginLoopDirective &) { 309 GetContext().withinConstruct = true; 310 } 311 bool Pre(const parser::DoConstruct &); 312 313 bool Pre(const parser::OpenMPSectionsConstruct &); 314 void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); } 315 316 bool Pre(const parser::OpenMPCriticalConstruct &); 317 void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); } 318 319 bool Pre(const parser::OpenMPDeclareSimdConstruct &x) { 320 PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd); 321 const auto &name{std::get<std::optional<parser::Name>>(x.t)}; 322 if (name) { 323 ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd); 324 } 325 return true; 326 } 327 void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); } 328 bool Pre(const parser::OpenMPThreadprivate &); 329 void Post(const parser::OpenMPThreadprivate &) { PopContext(); } 330 331 bool Pre(const parser::OpenMPDeclarativeAllocate &); 332 void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); } 333 334 bool Pre(const parser::OpenMPExecutableAllocate &); 335 void Post(const parser::OpenMPExecutableAllocate &); 336 337 // 2.15.3 Data-Sharing Attribute Clauses 338 void Post(const parser::OmpDefaultClause &); 339 bool Pre(const parser::OmpClause::Shared &x) { 340 ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared); 341 return false; 342 } 343 bool Pre(const parser::OmpClause::Private &x) { 344 ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate); 345 return false; 346 } 347 bool Pre(const parser::OmpAllocateClause &x) { 348 const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; 349 ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate); 350 return false; 351 } 352 bool Pre(const parser::OmpClause::Firstprivate &x) { 353 ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate); 354 return false; 355 } 356 bool Pre(const parser::OmpClause::Lastprivate &x) { 357 ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate); 358 return false; 359 } 360 bool Pre(const parser::OmpClause::Copyin &x) { 361 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn); 362 return false; 363 } 364 bool Pre(const parser::OmpClause::Copyprivate &x) { 365 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyPrivate); 366 return false; 367 } 368 bool Pre(const parser::OmpLinearClause &x) { 369 std::visit(common::visitors{ 370 [&](const parser::OmpLinearClause::WithoutModifier 371 &linearWithoutModifier) { 372 ResolveOmpNameList( 373 linearWithoutModifier.names, Symbol::Flag::OmpLinear); 374 }, 375 [&](const parser::OmpLinearClause::WithModifier 376 &linearWithModifier) { 377 ResolveOmpNameList( 378 linearWithModifier.names, Symbol::Flag::OmpLinear); 379 }, 380 }, 381 x.u); 382 return false; 383 } 384 385 bool Pre(const parser::OmpClause::Reduction &x) { 386 const parser::OmpReductionOperator &opr{ 387 std::get<parser::OmpReductionOperator>(x.v.t)}; 388 if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) { 389 if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) { 390 if (!name->symbol) { 391 const auto namePair{currScope().try_emplace( 392 name->source, Attrs{}, ProcEntityDetails{})}; 393 auto &symbol{*namePair.first->second}; 394 name->symbol = &symbol; 395 name->symbol->set(Symbol::Flag::OmpReduction); 396 AddToContextObjectWithDSA(*name->symbol, Symbol::Flag::OmpReduction); 397 } 398 } 399 if (const auto *procRef{ 400 parser::Unwrap<parser::ProcComponentRef>(procD->u)}) { 401 ResolveOmp(*procRef->v.thing.component.symbol, 402 Symbol::Flag::OmpReduction, currScope()); 403 } 404 } 405 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; 406 ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction); 407 return false; 408 } 409 410 bool Pre(const parser::OmpAlignedClause &x) { 411 const auto &alignedNameList{std::get<std::list<parser::Name>>(x.t)}; 412 ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned); 413 return false; 414 } 415 416 bool Pre(const parser::OmpClause::Nontemporal &x) { 417 const auto &nontemporalNameList{x.v}; 418 ResolveOmpNameList(nontemporalNameList, Symbol::Flag::OmpNontemporal); 419 return false; 420 } 421 422 bool Pre(const parser::OmpDependClause &x) { 423 if (const auto *dependSink{ 424 std::get_if<parser::OmpDependClause::Sink>(&x.u)}) { 425 const auto &dependSinkVec{dependSink->v}; 426 for (const auto &dependSinkElement : dependSinkVec) { 427 const auto &name{std::get<parser::Name>(dependSinkElement.t)}; 428 ResolveName(&name); 429 } 430 } 431 return false; 432 } 433 434 void Post(const parser::Name &); 435 436 // Keep track of labels in the statements that causes jumps to target labels 437 void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); } 438 void Post(const parser::ComputedGotoStmt &computedGotoStmt) { 439 for (auto &label : std::get<std::list<parser::Label>>(computedGotoStmt.t)) { 440 CheckSourceLabel(label); 441 } 442 } 443 void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) { 444 CheckSourceLabel(std::get<1>(arithmeticIfStmt.t)); 445 CheckSourceLabel(std::get<2>(arithmeticIfStmt.t)); 446 CheckSourceLabel(std::get<3>(arithmeticIfStmt.t)); 447 } 448 void Post(const parser::AssignedGotoStmt &assignedGotoStmt) { 449 for (auto &label : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) { 450 CheckSourceLabel(label); 451 } 452 } 453 void Post(const parser::AltReturnSpec &altReturnSpec) { 454 CheckSourceLabel(altReturnSpec.v); 455 } 456 void Post(const parser::ErrLabel &errLabel) { CheckSourceLabel(errLabel.v); } 457 void Post(const parser::EndLabel &endLabel) { CheckSourceLabel(endLabel.v); } 458 void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); } 459 460 const parser::OmpClause *associatedClause{nullptr}; 461 void SetAssociatedClause(const parser::OmpClause &c) { 462 associatedClause = &c; 463 } 464 const parser::OmpClause *GetAssociatedClause() { return associatedClause; } 465 466 private: 467 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &); 468 469 static constexpr Symbol::Flags dataSharingAttributeFlags{ 470 Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate, 471 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate, 472 Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear}; 473 474 static constexpr Symbol::Flags privateDataSharingAttributeFlags{ 475 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate, 476 Symbol::Flag::OmpLastPrivate}; 477 478 static constexpr Symbol::Flags ompFlagsRequireNewSymbol{ 479 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear, 480 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate, 481 Symbol::Flag::OmpReduction, Symbol::Flag::OmpCriticalLock}; 482 483 static constexpr Symbol::Flags ompFlagsRequireMark{ 484 Symbol::Flag::OmpThreadprivate}; 485 486 static constexpr Symbol::Flags dataCopyingAttributeFlags{ 487 Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpCopyPrivate}; 488 489 std::vector<const parser::Name *> allocateNames_; // on one directive 490 UnorderedSymbolSet privateDataSharingAttributeObjects_; // on one directive 491 UnorderedSymbolSet stmtFunctionExprSymbols_; 492 std::multimap<const parser::Label, 493 std::pair<parser::CharBlock, std::optional<DirContext>>> 494 sourceLabels_; 495 std::map<const parser::Label, 496 std::pair<parser::CharBlock, std::optional<DirContext>>> 497 targetLabels_; 498 parser::CharBlock currentStatementSource_; 499 500 void AddAllocateName(const parser::Name *&object) { 501 allocateNames_.push_back(object); 502 } 503 void ClearAllocateNames() { allocateNames_.clear(); } 504 505 void AddPrivateDataSharingAttributeObjects(SymbolRef object) { 506 privateDataSharingAttributeObjects_.insert(object); 507 } 508 void ClearPrivateDataSharingAttributeObjects() { 509 privateDataSharingAttributeObjects_.clear(); 510 } 511 512 // Predetermined DSA rules 513 void PrivatizeAssociatedLoopIndexAndCheckLoopLevel( 514 const parser::OpenMPLoopConstruct &); 515 void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &); 516 517 bool IsNestedInDirective(llvm::omp::Directive directive); 518 void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag); 519 void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag); 520 Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &); 521 Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &); 522 Symbol *ResolveOmpCommonBlockName(const parser::Name *); 523 void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag); 524 void ResolveOmpName(const parser::Name &, Symbol::Flag); 525 Symbol *ResolveName(const parser::Name *); 526 Symbol *ResolveOmpObjectScope(const parser::Name *); 527 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 528 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); 529 void CheckMultipleAppearances( 530 const parser::Name &, const Symbol &, Symbol::Flag); 531 532 void CheckDataCopyingClause( 533 const parser::Name &, const Symbol &, Symbol::Flag); 534 void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause); 535 void CheckPrivateDSAObject( 536 const parser::Name &, const Symbol &, Symbol::Flag); 537 void CheckSourceLabel(const parser::Label &); 538 void CheckLabelContext(const parser::CharBlock, const parser::CharBlock, 539 std::optional<DirContext>, std::optional<DirContext>); 540 void ClearLabels() { 541 sourceLabels_.clear(); 542 targetLabels_.clear(); 543 }; 544 545 bool HasSymbolInEnclosingScope(const Symbol &, Scope &); 546 std::int64_t ordCollapseLevel{0}; 547 }; 548 549 template <typename T> 550 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject( 551 const Symbol &object) { 552 auto it{dataSharingAttributeObjects_.find(object)}; 553 return it != dataSharingAttributeObjects_.end(); 554 } 555 556 template <typename T> 557 const parser::Name &DirectiveAttributeVisitor<T>::GetLoopIndex( 558 const parser::DoConstruct &x) { 559 using Bounds = parser::LoopControl::Bounds; 560 return std::get<Bounds>(x.GetLoopControl()->u).name.thing; 561 } 562 563 template <typename T> 564 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf( 565 const parser::ExecutionPartConstruct &x) { 566 return parser::Unwrap<parser::DoConstruct>(x); 567 } 568 569 template <typename T> 570 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity( 571 const parser::Name &name, Symbol::Flag flag, Scope &scope) { 572 if (!name.symbol) { 573 return nullptr; // not resolved by Name Resolution step, do nothing 574 } 575 name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope); 576 return name.symbol; 577 } 578 579 template <typename T> 580 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity( 581 Symbol &object, Symbol::Flag flag, Scope &scope) { 582 if (object.owner() != currScope()) { 583 auto &symbol{MakeAssocSymbol(object.name(), object, scope)}; 584 symbol.set(flag); 585 return &symbol; 586 } else { 587 object.set(flag); 588 return &object; 589 } 590 } 591 592 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) { 593 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; 594 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; 595 switch (blockDir.v) { 596 case llvm::acc::Directive::ACCD_data: 597 case llvm::acc::Directive::ACCD_host_data: 598 case llvm::acc::Directive::ACCD_kernels: 599 case llvm::acc::Directive::ACCD_parallel: 600 case llvm::acc::Directive::ACCD_serial: 601 PushContext(blockDir.source, blockDir.v); 602 break; 603 default: 604 break; 605 } 606 ClearDataSharingAttributeObjects(); 607 return true; 608 } 609 610 bool AccAttributeVisitor::Pre(const parser::OpenACCDeclarativeConstruct &x) { 611 if (const auto *declConstruct{ 612 std::get_if<parser::OpenACCStandaloneDeclarativeConstruct>(&x.u)}) { 613 const auto &declDir{ 614 std::get<parser::AccDeclarativeDirective>(declConstruct->t)}; 615 PushContext(declDir.source, llvm::acc::Directive::ACCD_declare); 616 } else if (const auto *routineConstruct{ 617 std::get_if<parser::OpenACCRoutineConstruct>(&x.u)}) { 618 const auto &verbatim{std::get<parser::Verbatim>(routineConstruct->t)}; 619 PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine); 620 } 621 ClearDataSharingAttributeObjects(); 622 return true; 623 } 624 625 static const parser::AccObjectList &GetAccObjectList( 626 const parser::AccClause &clause) { 627 if (const auto *copyClause = 628 std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) { 629 return copyClause->v; 630 } else if (const auto *createClause = 631 std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) { 632 const Fortran::parser::AccObjectListWithModifier &listWithModifier = 633 createClause->v; 634 const Fortran::parser::AccObjectList &accObjectList = 635 std::get<Fortran::parser::AccObjectList>(listWithModifier.t); 636 return accObjectList; 637 } else if (const auto *copyinClause = 638 std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) { 639 const Fortran::parser::AccObjectListWithModifier &listWithModifier = 640 copyinClause->v; 641 const Fortran::parser::AccObjectList &accObjectList = 642 std::get<Fortran::parser::AccObjectList>(listWithModifier.t); 643 return accObjectList; 644 } else if (const auto *copyoutClause = 645 std::get_if<Fortran::parser::AccClause::Copyout>(&clause.u)) { 646 const Fortran::parser::AccObjectListWithModifier &listWithModifier = 647 copyoutClause->v; 648 const Fortran::parser::AccObjectList &accObjectList = 649 std::get<Fortran::parser::AccObjectList>(listWithModifier.t); 650 return accObjectList; 651 } else if (const auto *presentClause = 652 std::get_if<Fortran::parser::AccClause::Present>(&clause.u)) { 653 return presentClause->v; 654 } else if (const auto *deviceptrClause = 655 std::get_if<Fortran::parser::AccClause::Deviceptr>( 656 &clause.u)) { 657 return deviceptrClause->v; 658 } else if (const auto *deviceResidentClause = 659 std::get_if<Fortran::parser::AccClause::DeviceResident>( 660 &clause.u)) { 661 return deviceResidentClause->v; 662 } else if (const auto *linkClause = 663 std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) { 664 return linkClause->v; 665 } else { 666 llvm_unreachable("Clause without object list!"); 667 } 668 } 669 670 void AccAttributeVisitor::Post( 671 const parser::OpenACCStandaloneDeclarativeConstruct &x) { 672 const auto &clauseList = std::get<parser::AccClauseList>(x.t); 673 for (const auto &clause : clauseList.v) { 674 // Restriction - line 2414 675 DoNotAllowAssumedSizedArray(GetAccObjectList(clause)); 676 } 677 } 678 679 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) { 680 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)}; 681 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)}; 682 const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)}; 683 if (loopDir.v == llvm::acc::Directive::ACCD_loop) { 684 PushContext(loopDir.source, loopDir.v); 685 } 686 ClearDataSharingAttributeObjects(); 687 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 688 PrivatizeAssociatedLoopIndex(x); 689 return true; 690 } 691 692 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) { 693 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)}; 694 switch (standaloneDir.v) { 695 case llvm::acc::Directive::ACCD_enter_data: 696 case llvm::acc::Directive::ACCD_exit_data: 697 case llvm::acc::Directive::ACCD_init: 698 case llvm::acc::Directive::ACCD_set: 699 case llvm::acc::Directive::ACCD_shutdown: 700 case llvm::acc::Directive::ACCD_update: 701 PushContext(standaloneDir.source, standaloneDir.v); 702 break; 703 default: 704 break; 705 } 706 ClearDataSharingAttributeObjects(); 707 return true; 708 } 709 710 Symbol *AccAttributeVisitor::ResolveName(const parser::Name &name) { 711 Symbol *prev{currScope().FindSymbol(name.source)}; 712 if (prev != name.symbol) { 713 name.symbol = prev; 714 } 715 return prev; 716 } 717 718 bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) { 719 const auto &optName{std::get<std::optional<parser::Name>>(x.t)}; 720 if (optName) { 721 if (!ResolveName(*optName)) { 722 context_.Say((*optName).source, 723 "No function or subroutine declared for '%s'"_err_en_US, 724 (*optName).source); 725 } 726 } 727 return true; 728 } 729 730 bool AccAttributeVisitor::Pre(const parser::AccBindClause &x) { 731 if (const auto *name{std::get_if<parser::Name>(&x.u)}) { 732 if (!ResolveName(*name)) { 733 context_.Say(name->source, 734 "No function or subroutine declared for '%s'"_err_en_US, 735 name->source); 736 } 737 } 738 return true; 739 } 740 741 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) { 742 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)}; 743 const auto &combinedDir{ 744 std::get<parser::AccCombinedDirective>(beginBlockDir.t)}; 745 switch (combinedDir.v) { 746 case llvm::acc::Directive::ACCD_kernels_loop: 747 case llvm::acc::Directive::ACCD_parallel_loop: 748 case llvm::acc::Directive::ACCD_serial_loop: 749 PushContext(combinedDir.source, combinedDir.v); 750 break; 751 default: 752 break; 753 } 754 ClearDataSharingAttributeObjects(); 755 return true; 756 } 757 758 static bool IsLastNameArray(const parser::Designator &designator) { 759 const auto &name{GetLastName(designator)}; 760 const evaluate::DataRef dataRef{*(name.symbol)}; 761 return std::visit( 762 common::visitors{ 763 [](const evaluate::SymbolRef &ref) { return ref->Rank() > 0; }, 764 [](const evaluate::ArrayRef &aref) { 765 return aref.base().IsSymbol() || 766 aref.base().GetComponent().base().Rank() == 0; 767 }, 768 [](const auto &) { return false; }, 769 }, 770 dataRef.u); 771 } 772 773 void AccAttributeVisitor::AllowOnlyArrayAndSubArray( 774 const parser::AccObjectList &objectList) { 775 for (const auto &accObject : objectList.v) { 776 std::visit( 777 common::visitors{ 778 [&](const parser::Designator &designator) { 779 if (!IsLastNameArray(designator)) { 780 context_.Say(designator.source, 781 "Only array element or subarray are allowed in %s directive"_err_en_US, 782 parser::ToUpperCaseLetters( 783 llvm::acc::getOpenACCDirectiveName( 784 GetContext().directive) 785 .str())); 786 } 787 }, 788 [&](const auto &name) { 789 context_.Say(name.source, 790 "Only array element or subarray are allowed in %s directive"_err_en_US, 791 parser::ToUpperCaseLetters( 792 llvm::acc::getOpenACCDirectiveName(GetContext().directive) 793 .str())); 794 }, 795 }, 796 accObject.u); 797 } 798 } 799 800 void AccAttributeVisitor::DoNotAllowAssumedSizedArray( 801 const parser::AccObjectList &objectList) { 802 for (const auto &accObject : objectList.v) { 803 std::visit( 804 common::visitors{ 805 [&](const parser::Designator &designator) { 806 const auto &name{GetLastName(designator)}; 807 if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol)) { 808 context_.Say(designator.source, 809 "Assumed-size dummy arrays may not appear on the %s " 810 "directive"_err_en_US, 811 parser::ToUpperCaseLetters( 812 llvm::acc::getOpenACCDirectiveName( 813 GetContext().directive) 814 .str())); 815 } 816 }, 817 [&](const auto &name) { 818 819 }, 820 }, 821 accObject.u); 822 } 823 } 824 825 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) { 826 const auto &verbatim{std::get<parser::Verbatim>(x.t)}; 827 PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache); 828 ClearDataSharingAttributeObjects(); 829 830 const auto &objectListWithModifier = 831 std::get<parser::AccObjectListWithModifier>(x.t); 832 const auto &objectList = 833 std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t); 834 835 // 2.10 Cache directive restriction: A var in a cache directive must be a 836 // single array element or a simple subarray. 837 AllowOnlyArrayAndSubArray(objectList); 838 839 return true; 840 } 841 842 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses( 843 const parser::AccClauseList &x) { 844 std::int64_t collapseLevel{0}; 845 for (const auto &clause : x.v) { 846 if (const auto *collapseClause{ 847 std::get_if<parser::AccClause::Collapse>(&clause.u)}) { 848 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) { 849 collapseLevel = *v; 850 } 851 } 852 } 853 854 if (collapseLevel) { 855 return collapseLevel; 856 } 857 return 1; // default is outermost loop 858 } 859 860 void AccAttributeVisitor::PrivatizeAssociatedLoopIndex( 861 const parser::OpenACCLoopConstruct &x) { 862 std::int64_t level{GetContext().associatedLoopLevel}; 863 if (level <= 0) { // collpase value was negative or 0 864 return; 865 } 866 Symbol::Flag ivDSA{Symbol::Flag::AccPrivate}; 867 868 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 869 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) { 870 // go through all the nested do-loops and resolve index variables 871 const parser::Name &iv{GetLoopIndex(*loop)}; 872 if (auto *symbol{ResolveAcc(iv, ivDSA, currScope())}) { 873 symbol->set(Symbol::Flag::AccPreDetermined); 874 iv.symbol = symbol; // adjust the symbol within region 875 AddToContextObjectWithDSA(*symbol, ivDSA); 876 } 877 878 const auto &block{std::get<parser::Block>(loop->t)}; 879 const auto it{block.begin()}; 880 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr; 881 } 882 CHECK(level == 0); 883 } 884 885 void AccAttributeVisitor::EnsureAllocatableOrPointer( 886 const llvm::acc::Clause clause, const parser::AccObjectList &objectList) { 887 for (const auto &accObject : objectList.v) { 888 std::visit( 889 common::visitors{ 890 [&](const parser::Designator &designator) { 891 const auto &lastName{GetLastName(designator)}; 892 if (!IsAllocatableOrPointer(*lastName.symbol)) { 893 context_.Say(designator.source, 894 "Argument `%s` on the %s clause must be a variable or " 895 "array with the POINTER or ALLOCATABLE attribute"_err_en_US, 896 lastName.symbol->name(), 897 parser::ToUpperCaseLetters( 898 llvm::acc::getOpenACCClauseName(clause).str())); 899 } 900 }, 901 [&](const auto &name) { 902 context_.Say(name.source, 903 "Argument on the %s clause must be a variable or " 904 "array with the POINTER or ALLOCATABLE attribute"_err_en_US, 905 parser::ToUpperCaseLetters( 906 llvm::acc::getOpenACCClauseName(clause).str())); 907 }, 908 }, 909 accObject.u); 910 } 911 } 912 913 bool AccAttributeVisitor::Pre(const parser::AccClause::Attach &x) { 914 // Restriction - line 1708-1709 915 EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_attach, x.v); 916 return true; 917 } 918 919 bool AccAttributeVisitor::Pre(const parser::AccClause::Detach &x) { 920 // Restriction - line 1715-1717 921 EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_detach, x.v); 922 return true; 923 } 924 925 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) { 926 if (!dirContext_.empty()) { 927 switch (x.v) { 928 case llvm::acc::DefaultValue::ACC_Default_present: 929 SetContextDefaultDSA(Symbol::Flag::AccPresent); 930 break; 931 case llvm::acc::DefaultValue::ACC_Default_none: 932 SetContextDefaultDSA(Symbol::Flag::AccNone); 933 break; 934 } 935 } 936 } 937 938 // For OpenACC constructs, check all the data-refs within the constructs 939 // and adjust the symbol for each Name if necessary 940 void AccAttributeVisitor::Post(const parser::Name &name) { 941 auto *symbol{name.symbol}; 942 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) { 943 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() && 944 !IsObjectWithDSA(*symbol)) { 945 if (Symbol * found{currScope().FindSymbol(name.source)}) { 946 if (symbol != found) { 947 name.symbol = found; // adjust the symbol within region 948 } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) { 949 // 2.5.14. 950 context_.Say(name.source, 951 "The DEFAULT(NONE) clause requires that '%s' must be listed in " 952 "a data-mapping clause"_err_en_US, 953 symbol->name()); 954 } 955 } 956 } 957 } // within OpenACC construct 958 } 959 960 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName( 961 const parser::Name *name) { 962 if (!name) { 963 return nullptr; 964 } else if (auto *prev{ 965 GetContext().scope.parent().FindCommonBlock(name->source)}) { 966 name->symbol = prev; 967 return prev; 968 } else { 969 return nullptr; 970 } 971 } 972 973 void AccAttributeVisitor::ResolveAccObjectList( 974 const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) { 975 for (const auto &accObject : accObjectList.v) { 976 ResolveAccObject(accObject, accFlag); 977 } 978 } 979 980 void AccAttributeVisitor::ResolveAccObject( 981 const parser::AccObject &accObject, Symbol::Flag accFlag) { 982 std::visit( 983 common::visitors{ 984 [&](const parser::Designator &designator) { 985 if (const auto *name{GetDesignatorNameIfDataRef(designator)}) { 986 if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) { 987 AddToContextObjectWithDSA(*symbol, accFlag); 988 if (dataSharingAttributeFlags.test(accFlag)) { 989 CheckMultipleAppearances(*name, *symbol, accFlag); 990 } 991 } 992 } else { 993 // Array sections to be changed to substrings as needed 994 if (AnalyzeExpr(context_, designator)) { 995 if (std::holds_alternative<parser::Substring>(designator.u)) { 996 context_.Say(designator.source, 997 "Substrings are not allowed on OpenACC " 998 "directives or clauses"_err_en_US); 999 } 1000 } 1001 // other checks, more TBD 1002 } 1003 }, 1004 [&](const parser::Name &name) { // common block 1005 if (auto *symbol{ResolveAccCommonBlockName(&name)}) { 1006 CheckMultipleAppearances( 1007 name, *symbol, Symbol::Flag::AccCommonBlock); 1008 for (auto &object : symbol->get<CommonBlockDetails>().objects()) { 1009 if (auto *resolvedObject{ 1010 ResolveAcc(*object, accFlag, currScope())}) { 1011 AddToContextObjectWithDSA(*resolvedObject, accFlag); 1012 } 1013 } 1014 } else { 1015 context_.Say(name.source, 1016 "COMMON block must be declared in the same scoping unit " 1017 "in which the OpenACC directive or clause appears"_err_en_US); 1018 } 1019 }, 1020 }, 1021 accObject.u); 1022 } 1023 1024 Symbol *AccAttributeVisitor::ResolveAcc( 1025 const parser::Name &name, Symbol::Flag accFlag, Scope &scope) { 1026 if (accFlagsRequireNewSymbol.test(accFlag)) { 1027 return DeclarePrivateAccessEntity(name, accFlag, scope); 1028 } else { 1029 return DeclareOrMarkOtherAccessEntity(name, accFlag); 1030 } 1031 } 1032 1033 Symbol *AccAttributeVisitor::ResolveAcc( 1034 Symbol &symbol, Symbol::Flag accFlag, Scope &scope) { 1035 if (accFlagsRequireNewSymbol.test(accFlag)) { 1036 return DeclarePrivateAccessEntity(symbol, accFlag, scope); 1037 } else { 1038 return DeclareOrMarkOtherAccessEntity(symbol, accFlag); 1039 } 1040 } 1041 1042 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1043 const parser::Name &name, Symbol::Flag accFlag) { 1044 Symbol *prev{currScope().FindSymbol(name.source)}; 1045 if (!name.symbol || !prev) { 1046 return nullptr; 1047 } else if (prev != name.symbol) { 1048 name.symbol = prev; 1049 } 1050 return DeclareOrMarkOtherAccessEntity(*prev, accFlag); 1051 } 1052 1053 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1054 Symbol &object, Symbol::Flag accFlag) { 1055 if (accFlagsRequireMark.test(accFlag)) { 1056 object.set(accFlag); 1057 } 1058 return &object; 1059 } 1060 1061 static bool WithMultipleAppearancesAccException( 1062 const Symbol &symbol, Symbol::Flag flag) { 1063 return false; // Place holder 1064 } 1065 1066 void AccAttributeVisitor::CheckMultipleAppearances( 1067 const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) { 1068 const auto *target{&symbol}; 1069 if (accFlagsRequireNewSymbol.test(accFlag)) { 1070 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 1071 target = &details->symbol(); 1072 } 1073 } 1074 if (HasDataSharingAttributeObject(*target) && 1075 !WithMultipleAppearancesAccException(symbol, accFlag)) { 1076 context_.Say(name.source, 1077 "'%s' appears in more than one data-sharing clause " 1078 "on the same OpenACC directive"_err_en_US, 1079 name.ToString()); 1080 } else { 1081 AddDataSharingAttributeObject(*target); 1082 } 1083 } 1084 1085 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) { 1086 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 1087 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1088 switch (beginDir.v) { 1089 case llvm::omp::Directive::OMPD_master: 1090 case llvm::omp::Directive::OMPD_ordered: 1091 case llvm::omp::Directive::OMPD_parallel: 1092 case llvm::omp::Directive::OMPD_single: 1093 case llvm::omp::Directive::OMPD_target: 1094 case llvm::omp::Directive::OMPD_target_data: 1095 case llvm::omp::Directive::OMPD_task: 1096 case llvm::omp::Directive::OMPD_taskgroup: 1097 case llvm::omp::Directive::OMPD_teams: 1098 case llvm::omp::Directive::OMPD_workshare: 1099 case llvm::omp::Directive::OMPD_parallel_workshare: 1100 case llvm::omp::Directive::OMPD_target_teams: 1101 case llvm::omp::Directive::OMPD_target_parallel: 1102 PushContext(beginDir.source, beginDir.v); 1103 break; 1104 default: 1105 // TODO others 1106 break; 1107 } 1108 ClearDataSharingAttributeObjects(); 1109 ClearPrivateDataSharingAttributeObjects(); 1110 ClearAllocateNames(); 1111 return true; 1112 } 1113 1114 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) { 1115 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 1116 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1117 switch (beginDir.v) { 1118 case llvm::omp::Directive::OMPD_parallel: 1119 case llvm::omp::Directive::OMPD_single: 1120 case llvm::omp::Directive::OMPD_target: 1121 case llvm::omp::Directive::OMPD_task: 1122 case llvm::omp::Directive::OMPD_teams: 1123 case llvm::omp::Directive::OMPD_parallel_workshare: 1124 case llvm::omp::Directive::OMPD_target_teams: 1125 case llvm::omp::Directive::OMPD_target_parallel: { 1126 bool hasPrivate; 1127 for (const auto *allocName : allocateNames_) { 1128 hasPrivate = false; 1129 for (auto privateObj : privateDataSharingAttributeObjects_) { 1130 const Symbol &symbolPrivate{*privateObj}; 1131 if (allocName->source == symbolPrivate.name()) { 1132 hasPrivate = true; 1133 break; 1134 } 1135 } 1136 if (!hasPrivate) { 1137 context_.Say(allocName->source, 1138 "The ALLOCATE clause requires that '%s' must be listed in a " 1139 "private " 1140 "data-sharing attribute clause on the same directive"_err_en_US, 1141 allocName->ToString()); 1142 } 1143 } 1144 break; 1145 } 1146 default: 1147 break; 1148 } 1149 PopContext(); 1150 } 1151 1152 bool OmpAttributeVisitor::Pre( 1153 const parser::OpenMPSimpleStandaloneConstruct &x) { 1154 const auto &standaloneDir{ 1155 std::get<parser::OmpSimpleStandaloneDirective>(x.t)}; 1156 switch (standaloneDir.v) { 1157 case llvm::omp::Directive::OMPD_barrier: 1158 case llvm::omp::Directive::OMPD_ordered: 1159 case llvm::omp::Directive::OMPD_target_enter_data: 1160 case llvm::omp::Directive::OMPD_target_exit_data: 1161 case llvm::omp::Directive::OMPD_target_update: 1162 case llvm::omp::Directive::OMPD_taskwait: 1163 case llvm::omp::Directive::OMPD_taskyield: 1164 PushContext(standaloneDir.source, standaloneDir.v); 1165 break; 1166 default: 1167 break; 1168 } 1169 ClearDataSharingAttributeObjects(); 1170 return true; 1171 } 1172 1173 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) { 1174 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 1175 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 1176 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)}; 1177 switch (beginDir.v) { 1178 case llvm::omp::Directive::OMPD_distribute: 1179 case llvm::omp::Directive::OMPD_distribute_parallel_do: 1180 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd: 1181 case llvm::omp::Directive::OMPD_distribute_simd: 1182 case llvm::omp::Directive::OMPD_do: 1183 case llvm::omp::Directive::OMPD_do_simd: 1184 case llvm::omp::Directive::OMPD_parallel_do: 1185 case llvm::omp::Directive::OMPD_parallel_do_simd: 1186 case llvm::omp::Directive::OMPD_simd: 1187 case llvm::omp::Directive::OMPD_target_parallel_do: 1188 case llvm::omp::Directive::OMPD_target_parallel_do_simd: 1189 case llvm::omp::Directive::OMPD_target_teams_distribute: 1190 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 1191 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 1192 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 1193 case llvm::omp::Directive::OMPD_target_simd: 1194 case llvm::omp::Directive::OMPD_taskloop: 1195 case llvm::omp::Directive::OMPD_taskloop_simd: 1196 case llvm::omp::Directive::OMPD_teams_distribute: 1197 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do: 1198 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd: 1199 case llvm::omp::Directive::OMPD_teams_distribute_simd: 1200 PushContext(beginDir.source, beginDir.v); 1201 break; 1202 default: 1203 break; 1204 } 1205 ClearDataSharingAttributeObjects(); 1206 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 1207 1208 if (beginDir.v == llvm::omp::Directive::OMPD_do) { 1209 if (const auto &doConstruct{ 1210 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 1211 if (doConstruct.value().IsDoWhile()) { 1212 return true; 1213 } 1214 } 1215 } 1216 PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x); 1217 ordCollapseLevel = GetAssociatedLoopLevelFromClauses(clauseList) + 1; 1218 return true; 1219 } 1220 1221 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct( 1222 const parser::Name &iv) { 1223 auto targetIt{dirContext_.rbegin()}; 1224 for (;; ++targetIt) { 1225 if (targetIt == dirContext_.rend()) { 1226 return; 1227 } 1228 if (llvm::omp::parallelSet.test(targetIt->directive) || 1229 llvm::omp::taskGeneratingSet.test(targetIt->directive)) { 1230 break; 1231 } 1232 } 1233 if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) { 1234 targetIt++; 1235 symbol->set(Symbol::Flag::OmpPreDetermined); 1236 iv.symbol = symbol; // adjust the symbol within region 1237 for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) { 1238 AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it); 1239 } 1240 } 1241 } 1242 1243 // [OMP-4.5]2.15.1.1 Data-sharing Attribute Rules - Predetermined 1244 // - A loop iteration variable for a sequential loop in a parallel 1245 // or task generating construct is private in the innermost such 1246 // construct that encloses the loop 1247 // Loop iteration variables are not well defined for DO WHILE loop. 1248 // Use of DO CONCURRENT inside OpenMP construct is unspecified behavior 1249 // till OpenMP-5.0 standard. 1250 // In above both cases we skip the privatization of iteration variables. 1251 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) { 1252 // TODO:[OpenMP 5.1] DO CONCURRENT indices are private 1253 if (x.IsDoNormal()) { 1254 if (!dirContext_.empty() && GetContext().withinConstruct) { 1255 if (const auto &iv{GetLoopIndex(x)}; iv.symbol) { 1256 if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) { 1257 ResolveSeqLoopIndexInParallelOrTaskConstruct(iv); 1258 } else { 1259 // TODO: conflict checks with explicitly determined DSA 1260 } 1261 ordCollapseLevel--; 1262 if (ordCollapseLevel) { 1263 if (const auto *details{iv.symbol->detailsIf<HostAssocDetails>()}) { 1264 const Symbol *tpSymbol = &details->symbol(); 1265 if (tpSymbol->test(Symbol::Flag::OmpThreadprivate)) { 1266 context_.Say(iv.source, 1267 "Loop iteration variable %s is not allowed in THREADPRIVATE."_err_en_US, 1268 iv.ToString()); 1269 } 1270 } 1271 } 1272 } 1273 } 1274 } 1275 return true; 1276 } 1277 1278 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses( 1279 const parser::OmpClauseList &x) { 1280 std::int64_t orderedLevel{0}; 1281 std::int64_t collapseLevel{0}; 1282 1283 const parser::OmpClause *ordClause{nullptr}; 1284 const parser::OmpClause *collClause{nullptr}; 1285 1286 for (const auto &clause : x.v) { 1287 if (const auto *orderedClause{ 1288 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) { 1289 if (const auto v{EvaluateInt64(context_, orderedClause->v)}) { 1290 orderedLevel = *v; 1291 } 1292 ordClause = &clause; 1293 } 1294 if (const auto *collapseClause{ 1295 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) { 1296 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) { 1297 collapseLevel = *v; 1298 } 1299 collClause = &clause; 1300 } 1301 } 1302 1303 if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) { 1304 SetAssociatedClause(*ordClause); 1305 return orderedLevel; 1306 } else if (!orderedLevel && collapseLevel) { 1307 SetAssociatedClause(*collClause); 1308 return collapseLevel; 1309 } // orderedLevel < collapseLevel is an error handled in structural checks 1310 return 1; // default is outermost loop 1311 } 1312 1313 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined 1314 // - The loop iteration variable(s) in the associated do-loop(s) of a do, 1315 // parallel do, taskloop, or distribute construct is (are) private. 1316 // - The loop iteration variable in the associated do-loop of a simd construct 1317 // with just one associated do-loop is linear with a linear-step that is the 1318 // increment of the associated do-loop. 1319 // - The loop iteration variables in the associated do-loops of a simd 1320 // construct with multiple associated do-loops are lastprivate. 1321 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel( 1322 const parser::OpenMPLoopConstruct &x) { 1323 std::int64_t level{GetContext().associatedLoopLevel}; 1324 if (level <= 0) { 1325 return; 1326 } 1327 Symbol::Flag ivDSA; 1328 if (!llvm::omp::simdSet.test(GetContext().directive)) { 1329 ivDSA = Symbol::Flag::OmpPrivate; 1330 } else if (level == 1) { 1331 ivDSA = Symbol::Flag::OmpLinear; 1332 } else { 1333 ivDSA = Symbol::Flag::OmpLastPrivate; 1334 } 1335 1336 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 1337 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) { 1338 // go through all the nested do-loops and resolve index variables 1339 const parser::Name &iv{GetLoopIndex(*loop)}; 1340 if (auto *symbol{ResolveOmp(iv, ivDSA, currScope())}) { 1341 symbol->set(Symbol::Flag::OmpPreDetermined); 1342 iv.symbol = symbol; // adjust the symbol within region 1343 AddToContextObjectWithDSA(*symbol, ivDSA); 1344 } 1345 1346 const auto &block{std::get<parser::Block>(loop->t)}; 1347 const auto it{block.begin()}; 1348 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr; 1349 } 1350 CheckAssocLoopLevel(level, GetAssociatedClause()); 1351 } 1352 void OmpAttributeVisitor::CheckAssocLoopLevel( 1353 std::int64_t level, const parser::OmpClause *clause) { 1354 if (clause && level != 0) { 1355 context_.Say(clause->source, 1356 "The value of the parameter in the COLLAPSE or ORDERED clause must" 1357 " not be larger than the number of nested loops" 1358 " following the construct."_err_en_US); 1359 } 1360 } 1361 1362 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) { 1363 const auto &beginSectionsDir{ 1364 std::get<parser::OmpBeginSectionsDirective>(x.t)}; 1365 const auto &beginDir{ 1366 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 1367 switch (beginDir.v) { 1368 case llvm::omp::Directive::OMPD_parallel_sections: 1369 case llvm::omp::Directive::OMPD_sections: 1370 PushContext(beginDir.source, beginDir.v); 1371 break; 1372 default: 1373 break; 1374 } 1375 ClearDataSharingAttributeObjects(); 1376 return true; 1377 } 1378 1379 bool OmpAttributeVisitor::Pre(const parser::OmpCriticalDirective &x) { 1380 const auto &name{std::get<std::optional<parser::Name>>(x.t)}; 1381 if (name) { 1382 ResolveOmpName(*name, Symbol::Flag::OmpCriticalLock); 1383 } 1384 return true; 1385 } 1386 1387 bool OmpAttributeVisitor::Pre(const parser::OmpEndCriticalDirective &x) { 1388 const auto &name{std::get<std::optional<parser::Name>>(x.t)}; 1389 if (name) { 1390 ResolveOmpName(*name, Symbol::Flag::OmpCriticalLock); 1391 } 1392 return true; 1393 } 1394 1395 bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { 1396 const auto &criticalDir{std::get<parser::OmpCriticalDirective>(x.t)}; 1397 PushContext(criticalDir.source, llvm::omp::Directive::OMPD_critical); 1398 return true; 1399 } 1400 1401 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { 1402 PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate); 1403 const auto &list{std::get<parser::OmpObjectList>(x.t)}; 1404 ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate); 1405 return true; 1406 } 1407 1408 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) { 1409 PushContext(x.source, llvm::omp::Directive::OMPD_allocate); 1410 const auto &list{std::get<parser::OmpObjectList>(x.t)}; 1411 ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective); 1412 return false; 1413 } 1414 1415 bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) { 1416 PushContext(x.source, llvm::omp::Directive::OMPD_allocate); 1417 const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}; 1418 if (list) { 1419 ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective); 1420 } 1421 return true; 1422 } 1423 1424 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) { 1425 if (!dirContext_.empty()) { 1426 switch (x.v) { 1427 case parser::OmpDefaultClause::Type::Private: 1428 SetContextDefaultDSA(Symbol::Flag::OmpPrivate); 1429 break; 1430 case parser::OmpDefaultClause::Type::Firstprivate: 1431 SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate); 1432 break; 1433 case parser::OmpDefaultClause::Type::Shared: 1434 SetContextDefaultDSA(Symbol::Flag::OmpShared); 1435 break; 1436 case parser::OmpDefaultClause::Type::None: 1437 SetContextDefaultDSA(Symbol::Flag::OmpNone); 1438 break; 1439 } 1440 } 1441 } 1442 1443 bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) { 1444 if (dirContext_.size() >= 1) { 1445 for (std::size_t i = dirContext_.size() - 1; i > 0; --i) { 1446 if (dirContext_[i - 1].directive == directive) { 1447 return true; 1448 } 1449 } 1450 } 1451 return false; 1452 } 1453 1454 void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) { 1455 bool hasAllocator = false; 1456 // TODO: Investigate whether searching the clause list can be done with 1457 // parser::Unwrap instead of the following loop 1458 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)}; 1459 for (const auto &clause : clauseList.v) { 1460 if (std::get_if<parser::OmpClause::Allocator>(&clause.u)) { 1461 hasAllocator = true; 1462 } 1463 } 1464 1465 if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) { 1466 // TODO: expand this check to exclude the case when a requires 1467 // directive with the dynamic_allocators clause is present 1468 // in the same compilation unit (OMP5.0 2.11.3). 1469 context_.Say(x.source, 1470 "ALLOCATE directives that appear in a TARGET region " 1471 "must specify an allocator clause"_err_en_US); 1472 } 1473 PopContext(); 1474 } 1475 1476 // For OpenMP constructs, check all the data-refs within the constructs 1477 // and adjust the symbol for each Name if necessary 1478 void OmpAttributeVisitor::Post(const parser::Name &name) { 1479 auto *symbol{name.symbol}; 1480 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) { 1481 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() && 1482 !IsObjectWithDSA(*symbol)) { 1483 // TODO: create a separate function to go through the rules for 1484 // predetermined, explicitly determined, and implicitly 1485 // determined data-sharing attributes (2.15.1.1). 1486 if (Symbol * found{currScope().FindSymbol(name.source)}) { 1487 if (symbol != found) { 1488 name.symbol = found; // adjust the symbol within region 1489 } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) { 1490 context_.Say(name.source, 1491 "The DEFAULT(NONE) clause requires that '%s' must be listed in " 1492 "a data-sharing attribute clause"_err_en_US, 1493 symbol->name()); 1494 } 1495 } 1496 } 1497 } // within OpenMP construct 1498 } 1499 1500 Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) { 1501 if (auto *resolvedSymbol{ 1502 name ? GetContext().scope.FindSymbol(name->source) : nullptr}) { 1503 name->symbol = resolvedSymbol; 1504 return resolvedSymbol; 1505 } else { 1506 return nullptr; 1507 } 1508 } 1509 1510 void OmpAttributeVisitor::ResolveOmpName( 1511 const parser::Name &name, Symbol::Flag ompFlag) { 1512 if (ResolveName(&name)) { 1513 if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) { 1514 if (dataSharingAttributeFlags.test(ompFlag)) { 1515 AddToContextObjectWithDSA(*resolvedSymbol, ompFlag); 1516 } 1517 } 1518 } else if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1519 const auto pair{GetContext().scope.try_emplace( 1520 name.source, Attrs{}, ObjectEntityDetails{})}; 1521 CHECK(pair.second); 1522 name.symbol = &pair.first->second.get(); 1523 } else { 1524 DIE("OpenMP Name resolution failed"); 1525 } 1526 } 1527 1528 void OmpAttributeVisitor::ResolveOmpNameList( 1529 const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) { 1530 for (const auto &name : nameList) { 1531 ResolveOmpName(name, ompFlag); 1532 } 1533 } 1534 1535 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName( 1536 const parser::Name *name) { 1537 if (auto *prev{name 1538 ? GetContext().scope.parent().FindCommonBlock(name->source) 1539 : nullptr}) { 1540 name->symbol = prev; 1541 return prev; 1542 } 1543 // Check if the Common Block is declared in the current scope 1544 if (auto *commonBlockSymbol{ 1545 name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) { 1546 name->symbol = commonBlockSymbol; 1547 return commonBlockSymbol; 1548 } 1549 return nullptr; 1550 } 1551 1552 // Use this function over ResolveOmpName when an omp object's scope needs 1553 // resolving, it's symbol flag isn't important and a simple check for resolution 1554 // failure is desired. Using ResolveOmpName means needing to work with the 1555 // context to check for failure, whereas here a pointer comparison is all that's 1556 // needed. 1557 Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) { 1558 1559 // TODO: Investigate whether the following block can be replaced by, or 1560 // included in, the ResolveOmpName function 1561 if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source) 1562 : nullptr}) { 1563 name->symbol = prev; 1564 return nullptr; 1565 } 1566 1567 // TODO: Investigate whether the following block can be replaced by, or 1568 // included in, the ResolveOmpName function 1569 if (auto *ompSymbol{ 1570 name ? GetContext().scope.FindSymbol(name->source) : nullptr}) { 1571 name->symbol = ompSymbol; 1572 return ompSymbol; 1573 } 1574 return nullptr; 1575 } 1576 1577 void OmpAttributeVisitor::ResolveOmpObjectList( 1578 const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) { 1579 for (const auto &ompObject : ompObjectList.v) { 1580 ResolveOmpObject(ompObject, ompFlag); 1581 } 1582 } 1583 1584 void OmpAttributeVisitor::ResolveOmpObject( 1585 const parser::OmpObject &ompObject, Symbol::Flag ompFlag) { 1586 std::visit( 1587 common::visitors{ 1588 [&](const parser::Designator &designator) { 1589 if (const auto *name{GetDesignatorNameIfDataRef(designator)}) { 1590 if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) { 1591 if (dataCopyingAttributeFlags.test(ompFlag)) { 1592 CheckDataCopyingClause(*name, *symbol, ompFlag); 1593 } else { 1594 AddToContextObjectWithDSA(*symbol, ompFlag); 1595 if (dataSharingAttributeFlags.test(ompFlag)) { 1596 CheckMultipleAppearances(*name, *symbol, ompFlag); 1597 } 1598 if (privateDataSharingAttributeFlags.test(ompFlag)) { 1599 CheckPrivateDSAObject(*name, *symbol, ompFlag); 1600 } 1601 1602 if (ompFlag == Symbol::Flag::OmpAllocate) { 1603 AddAllocateName(name); 1604 } 1605 } 1606 if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective && 1607 IsAllocatable(*symbol)) { 1608 context_.Say(designator.source, 1609 "List items specified in the ALLOCATE directive must not " 1610 "have the ALLOCATABLE attribute unless the directive is " 1611 "associated with an ALLOCATE statement"_err_en_US); 1612 } 1613 if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective || 1614 ompFlag == 1615 Symbol::Flag::OmpExecutableAllocateDirective) && 1616 ResolveOmpObjectScope(name) == nullptr) { 1617 context_.Say(designator.source, // 2.15.3 1618 "List items must be declared in the same scoping unit " 1619 "in which the ALLOCATE directive appears"_err_en_US); 1620 } 1621 } 1622 } else { 1623 // Array sections to be changed to substrings as needed 1624 if (AnalyzeExpr(context_, designator)) { 1625 if (std::holds_alternative<parser::Substring>(designator.u)) { 1626 context_.Say(designator.source, 1627 "Substrings are not allowed on OpenMP " 1628 "directives or clauses"_err_en_US); 1629 } 1630 } 1631 // other checks, more TBD 1632 } 1633 }, 1634 [&](const parser::Name &name) { // common block 1635 if (auto *symbol{ResolveOmpCommonBlockName(&name)}) { 1636 if (!dataCopyingAttributeFlags.test(ompFlag)) { 1637 CheckMultipleAppearances( 1638 name, *symbol, Symbol::Flag::OmpCommonBlock); 1639 } 1640 // 2.15.3 When a named common block appears in a list, it has the 1641 // same meaning as if every explicit member of the common block 1642 // appeared in the list 1643 for (auto &object : symbol->get<CommonBlockDetails>().objects()) { 1644 if (auto *resolvedObject{ 1645 ResolveOmp(*object, ompFlag, currScope())}) { 1646 if (dataCopyingAttributeFlags.test(ompFlag)) { 1647 CheckDataCopyingClause(name, *resolvedObject, ompFlag); 1648 } else { 1649 AddToContextObjectWithDSA(*resolvedObject, ompFlag); 1650 } 1651 } 1652 } 1653 } else { 1654 context_.Say(name.source, // 2.15.3 1655 "COMMON block must be declared in the same scoping unit " 1656 "in which the OpenMP directive or clause appears"_err_en_US); 1657 } 1658 }, 1659 }, 1660 ompObject.u); 1661 } 1662 1663 Symbol *OmpAttributeVisitor::ResolveOmp( 1664 const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) { 1665 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1666 return DeclarePrivateAccessEntity(name, ompFlag, scope); 1667 } else { 1668 return DeclareOrMarkOtherAccessEntity(name, ompFlag); 1669 } 1670 } 1671 1672 Symbol *OmpAttributeVisitor::ResolveOmp( 1673 Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) { 1674 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1675 return DeclarePrivateAccessEntity(symbol, ompFlag, scope); 1676 } else { 1677 return DeclareOrMarkOtherAccessEntity(symbol, ompFlag); 1678 } 1679 } 1680 1681 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1682 const parser::Name &name, Symbol::Flag ompFlag) { 1683 Symbol *prev{currScope().FindSymbol(name.source)}; 1684 if (!name.symbol || !prev) { 1685 return nullptr; 1686 } else if (prev != name.symbol) { 1687 name.symbol = prev; 1688 } 1689 return DeclareOrMarkOtherAccessEntity(*prev, ompFlag); 1690 } 1691 1692 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1693 Symbol &object, Symbol::Flag ompFlag) { 1694 if (ompFlagsRequireMark.test(ompFlag)) { 1695 object.set(ompFlag); 1696 } 1697 return &object; 1698 } 1699 1700 static bool WithMultipleAppearancesOmpException( 1701 const Symbol &symbol, Symbol::Flag flag) { 1702 return (flag == Symbol::Flag::OmpFirstPrivate && 1703 symbol.test(Symbol::Flag::OmpLastPrivate)) || 1704 (flag == Symbol::Flag::OmpLastPrivate && 1705 symbol.test(Symbol::Flag::OmpFirstPrivate)); 1706 } 1707 1708 void OmpAttributeVisitor::CheckMultipleAppearances( 1709 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 1710 const auto *target{&symbol}; 1711 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 1712 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 1713 target = &details->symbol(); 1714 } 1715 } 1716 if (HasDataSharingAttributeObject(*target) && 1717 !WithMultipleAppearancesOmpException(symbol, ompFlag)) { 1718 context_.Say(name.source, 1719 "'%s' appears in more than one data-sharing clause " 1720 "on the same OpenMP directive"_err_en_US, 1721 name.ToString()); 1722 } else { 1723 AddDataSharingAttributeObject(*target); 1724 if (privateDataSharingAttributeFlags.test(ompFlag)) { 1725 AddPrivateDataSharingAttributeObjects(*target); 1726 } 1727 } 1728 } 1729 1730 void ResolveAccParts( 1731 SemanticsContext &context, const parser::ProgramUnit &node) { 1732 if (context.IsEnabled(common::LanguageFeature::OpenACC)) { 1733 AccAttributeVisitor{context}.Walk(node); 1734 } 1735 } 1736 1737 void ResolveOmpParts( 1738 SemanticsContext &context, const parser::ProgramUnit &node) { 1739 if (context.IsEnabled(common::LanguageFeature::OpenMP)) { 1740 OmpAttributeVisitor{context}.Walk(node); 1741 if (!context.AnyFatalError()) { 1742 // The data-sharing attribute of the loop iteration variable for a 1743 // sequential loop (2.15.1.1) can only be determined when visiting 1744 // the corresponding DoConstruct, a second walk is to adjust the 1745 // symbols for all the data-refs of that loop iteration variable 1746 // prior to the DoConstruct. 1747 OmpAttributeVisitor{context}.Walk(node); 1748 } 1749 } 1750 } 1751 1752 void OmpAttributeVisitor::CheckDataCopyingClause( 1753 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 1754 const auto *checkSymbol{&symbol}; 1755 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 1756 checkSymbol = &details->symbol(); 1757 } 1758 1759 if (ompFlag == Symbol::Flag::OmpCopyIn) { 1760 // List of items/objects that can appear in a 'copyin' clause must be 1761 // 'threadprivate' 1762 if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate)) { 1763 context_.Say(name.source, 1764 "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US, 1765 checkSymbol->name()); 1766 } 1767 } else if (ompFlag == Symbol::Flag::OmpCopyPrivate && 1768 GetContext().directive == llvm::omp::Directive::OMPD_single) { 1769 // A list item that appears in a 'copyprivate' clause may not appear on a 1770 // 'private' or 'firstprivate' clause on a single construct 1771 if (IsObjectWithDSA(symbol) && 1772 (symbol.test(Symbol::Flag::OmpPrivate) || 1773 symbol.test(Symbol::Flag::OmpFirstPrivate))) { 1774 context_.Say(name.source, 1775 "COPYPRIVATE variable '%s' may not appear on a PRIVATE or " 1776 "FIRSTPRIVATE clause on a SINGLE construct"_err_en_US, 1777 symbol.name()); 1778 } else { 1779 // List of items/objects that can appear in a 'copyprivate' clause must be 1780 // either 'private' or 'threadprivate' in enclosing context. 1781 if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate) && 1782 !(HasSymbolInEnclosingScope(symbol, currScope()) && 1783 symbol.test(Symbol::Flag::OmpPrivate))) { 1784 context_.Say(name.source, 1785 "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in " 1786 "outer context"_err_en_US, 1787 symbol.name()); 1788 } 1789 } 1790 } 1791 } 1792 1793 void OmpAttributeVisitor::CheckPrivateDSAObject( 1794 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 1795 const auto &ultimateSymbol{symbol.GetUltimate()}; 1796 llvm::StringRef clauseName{"PRIVATE"}; 1797 if (ompFlag == Symbol::Flag::OmpFirstPrivate) { 1798 clauseName = "FIRSTPRIVATE"; 1799 } else if (ompFlag == Symbol::Flag::OmpLastPrivate) { 1800 clauseName = "LASTPRIVATE"; 1801 } 1802 1803 if (ultimateSymbol.test(Symbol::Flag::InNamelist)) { 1804 context_.Say(name.source, 1805 "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US, 1806 name.ToString(), clauseName.str()); 1807 } 1808 1809 if (stmtFunctionExprSymbols_.find(ultimateSymbol) != 1810 stmtFunctionExprSymbols_.end()) { 1811 context_.Say(name.source, 1812 "Variable '%s' in STATEMENT FUNCTION expression cannot be in a " 1813 "%s clause"_err_en_US, 1814 name.ToString(), clauseName.str()); 1815 } 1816 } 1817 1818 void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) { 1819 // Get the context to check if the statement causing a jump to the 'label' is 1820 // in an enclosing OpenMP construct 1821 std::optional<DirContext> thisContext{GetContextIf()}; 1822 sourceLabels_.emplace( 1823 label, std::make_pair(currentStatementSource_, thisContext)); 1824 // Check if the statement with 'label' to which a jump is being introduced 1825 // has already been encountered 1826 auto it{targetLabels_.find(label)}; 1827 if (it != targetLabels_.end()) { 1828 // Check if both the statement with 'label' and the statement that causes a 1829 // jump to the 'label' are in the same scope 1830 CheckLabelContext(currentStatementSource_, it->second.first, thisContext, 1831 it->second.second); 1832 } 1833 } 1834 1835 // Check for invalid branch into or out of OpenMP structured blocks 1836 void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source, 1837 const parser::CharBlock target, std::optional<DirContext> sourceContext, 1838 std::optional<DirContext> targetContext) { 1839 if (targetContext && 1840 (!sourceContext || 1841 (sourceContext->scope != targetContext->scope && 1842 !DoesScopeContain( 1843 &targetContext->scope, sourceContext->scope)))) { 1844 context_ 1845 .Say(source, "invalid branch into an OpenMP structured block"_err_en_US) 1846 .Attach(target, "In the enclosing %s directive branched into"_en_US, 1847 parser::ToUpperCaseLetters( 1848 llvm::omp::getOpenMPDirectiveName(targetContext->directive) 1849 .str())); 1850 } 1851 if (sourceContext && 1852 (!targetContext || 1853 (sourceContext->scope != targetContext->scope && 1854 !DoesScopeContain( 1855 &sourceContext->scope, targetContext->scope)))) { 1856 context_ 1857 .Say(source, 1858 "invalid branch leaving an OpenMP structured block"_err_en_US) 1859 .Attach(target, "Outside the enclosing %s directive"_en_US, 1860 parser::ToUpperCaseLetters( 1861 llvm::omp::getOpenMPDirectiveName(sourceContext->directive) 1862 .str())); 1863 } 1864 } 1865 1866 bool OmpAttributeVisitor::HasSymbolInEnclosingScope( 1867 const Symbol &symbol, Scope &scope) { 1868 const auto symbols{scope.parent().GetSymbols()}; 1869 auto it{std::find(symbols.begin(), symbols.end(), symbol)}; 1870 return it != symbols.end(); 1871 } 1872 1873 } // namespace Fortran::semantics 1874