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