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/tools.h" 17 #include "flang/Evaluate/type.h" 18 #include "flang/Parser/parse-tree-visitor.h" 19 #include "flang/Parser/parse-tree.h" 20 #include "flang/Parser/tools.h" 21 #include "flang/Semantics/expression.h" 22 #include "flang/Semantics/openmp-modifiers.h" 23 #include "flang/Semantics/symbol.h" 24 #include "flang/Semantics/tools.h" 25 #include <list> 26 #include <map> 27 #include <sstream> 28 29 template <typename T> 30 static Fortran::semantics::Scope *GetScope( 31 Fortran::semantics::SemanticsContext &context, const T &x) { 32 std::optional<Fortran::parser::CharBlock> source{GetLastSource(x)}; 33 return source ? &context.FindScope(*source) : nullptr; 34 } 35 36 namespace Fortran::semantics { 37 38 template <typename T> class DirectiveAttributeVisitor { 39 public: 40 explicit DirectiveAttributeVisitor(SemanticsContext &context) 41 : context_{context} {} 42 43 template <typename A> bool Pre(const A &) { return true; } 44 template <typename A> void Post(const A &) {} 45 46 protected: 47 struct DirContext { 48 DirContext(const parser::CharBlock &source, T d, Scope &s) 49 : directiveSource{source}, directive{d}, scope{s} {} 50 parser::CharBlock directiveSource; 51 T directive; 52 Scope &scope; 53 Symbol::Flag defaultDSA{Symbol::Flag::AccShared}; // TODOACC 54 std::map<const Symbol *, Symbol::Flag> objectWithDSA; 55 bool withinConstruct{false}; 56 std::int64_t associatedLoopLevel{0}; 57 }; 58 59 DirContext &GetContext() { 60 CHECK(!dirContext_.empty()); 61 return dirContext_.back(); 62 } 63 std::optional<DirContext> GetContextIf() { 64 return dirContext_.empty() 65 ? std::nullopt 66 : std::make_optional<DirContext>(dirContext_.back()); 67 } 68 void PushContext(const parser::CharBlock &source, T dir, Scope &scope) { 69 dirContext_.emplace_back(source, dir, scope); 70 } 71 void PushContext(const parser::CharBlock &source, T dir) { 72 dirContext_.emplace_back(source, dir, context_.FindScope(source)); 73 } 74 void PopContext() { dirContext_.pop_back(); } 75 void SetContextDirectiveSource(parser::CharBlock &dir) { 76 GetContext().directiveSource = dir; 77 } 78 Scope &currScope() { return GetContext().scope; } 79 void SetContextDefaultDSA(Symbol::Flag flag) { 80 GetContext().defaultDSA = flag; 81 } 82 void AddToContextObjectWithDSA( 83 const Symbol &symbol, Symbol::Flag flag, DirContext &context) { 84 context.objectWithDSA.emplace(&symbol, flag); 85 } 86 void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) { 87 AddToContextObjectWithDSA(symbol, flag, GetContext()); 88 } 89 bool IsObjectWithDSA(const Symbol &symbol) { 90 auto it{GetContext().objectWithDSA.find(&symbol)}; 91 return it != GetContext().objectWithDSA.end(); 92 } 93 void SetContextAssociatedLoopLevel(std::int64_t level) { 94 GetContext().associatedLoopLevel = level; 95 } 96 Symbol &MakeAssocSymbol( 97 const SourceName &name, const Symbol &prev, Scope &scope) { 98 const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})}; 99 return *pair.first->second; 100 } 101 Symbol &MakeAssocSymbol(const SourceName &name, const Symbol &prev) { 102 return MakeAssocSymbol(name, prev, currScope()); 103 } 104 void AddDataSharingAttributeObject(SymbolRef object) { 105 dataSharingAttributeObjects_.insert(object); 106 } 107 void ClearDataSharingAttributeObjects() { 108 dataSharingAttributeObjects_.clear(); 109 } 110 bool HasDataSharingAttributeObject(const Symbol &); 111 const parser::Name *GetLoopIndex(const parser::DoConstruct &); 112 const parser::DoConstruct *GetDoConstructIf( 113 const parser::ExecutionPartConstruct &); 114 Symbol *DeclareNewPrivateAccessEntity(const Symbol &, Symbol::Flag, Scope &); 115 Symbol *DeclarePrivateAccessEntity( 116 const parser::Name &, Symbol::Flag, Scope &); 117 Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &); 118 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 119 120 UnorderedSymbolSet dataSharingAttributeObjects_; // on one directive 121 SemanticsContext &context_; 122 std::vector<DirContext> dirContext_; // used as a stack 123 }; 124 125 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> { 126 public: 127 explicit AccAttributeVisitor(SemanticsContext &context, Scope *topScope) 128 : DirectiveAttributeVisitor(context), topScope_(topScope) {} 129 130 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } 131 template <typename A> bool Pre(const A &) { return true; } 132 template <typename A> void Post(const A &) {} 133 134 bool Pre(const parser::OpenACCBlockConstruct &); 135 void Post(const parser::OpenACCBlockConstruct &) { PopContext(); } 136 bool Pre(const parser::OpenACCCombinedConstruct &); 137 void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); } 138 139 bool Pre(const parser::OpenACCDeclarativeConstruct &); 140 void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); } 141 142 void Post(const parser::AccDeclarativeDirective &) { 143 GetContext().withinConstruct = true; 144 } 145 146 bool Pre(const parser::OpenACCRoutineConstruct &); 147 bool Pre(const parser::AccBindClause &); 148 void Post(const parser::OpenACCStandaloneDeclarativeConstruct &); 149 150 void Post(const parser::AccBeginBlockDirective &) { 151 GetContext().withinConstruct = true; 152 } 153 154 bool Pre(const parser::OpenACCLoopConstruct &); 155 void Post(const parser::OpenACCLoopConstruct &) { PopContext(); } 156 void Post(const parser::AccLoopDirective &) { 157 GetContext().withinConstruct = true; 158 } 159 160 bool Pre(const parser::OpenACCStandaloneConstruct &); 161 void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); } 162 void Post(const parser::AccStandaloneDirective &) { 163 GetContext().withinConstruct = true; 164 } 165 166 bool Pre(const parser::OpenACCCacheConstruct &); 167 void Post(const parser::OpenACCCacheConstruct &) { PopContext(); } 168 169 void Post(const parser::AccDefaultClause &); 170 171 bool Pre(const parser::AccClause::Attach &); 172 bool Pre(const parser::AccClause::Detach &); 173 174 bool Pre(const parser::AccClause::Copy &x) { 175 ResolveAccObjectList(x.v, Symbol::Flag::AccCopy); 176 return false; 177 } 178 179 bool Pre(const parser::AccClause::Create &x) { 180 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 181 ResolveAccObjectList(objectList, Symbol::Flag::AccCreate); 182 return false; 183 } 184 185 bool Pre(const parser::AccClause::Copyin &x) { 186 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 187 const auto &modifier{ 188 std::get<std::optional<parser::AccDataModifier>>(x.v.t)}; 189 if (modifier && 190 (*modifier).v == parser::AccDataModifier::Modifier::ReadOnly) { 191 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyInReadOnly); 192 } else { 193 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn); 194 } 195 return false; 196 } 197 198 bool Pre(const parser::AccClause::Copyout &x) { 199 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)}; 200 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut); 201 return false; 202 } 203 204 bool Pre(const parser::AccClause::Present &x) { 205 ResolveAccObjectList(x.v, Symbol::Flag::AccPresent); 206 return false; 207 } 208 bool Pre(const parser::AccClause::Private &x) { 209 ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate); 210 return false; 211 } 212 bool Pre(const parser::AccClause::Firstprivate &x) { 213 ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate); 214 return false; 215 } 216 217 bool Pre(const parser::AccClause::Device &x) { 218 ResolveAccObjectList(x.v, Symbol::Flag::AccDevice); 219 return false; 220 } 221 222 bool Pre(const parser::AccClause::DeviceResident &x) { 223 ResolveAccObjectList(x.v, Symbol::Flag::AccDeviceResident); 224 return false; 225 } 226 227 bool Pre(const parser::AccClause::Deviceptr &x) { 228 ResolveAccObjectList(x.v, Symbol::Flag::AccDevicePtr); 229 return false; 230 } 231 232 bool Pre(const parser::AccClause::Link &x) { 233 ResolveAccObjectList(x.v, Symbol::Flag::AccLink); 234 return false; 235 } 236 237 bool Pre(const parser::AccClause::Host &x) { 238 ResolveAccObjectList(x.v, Symbol::Flag::AccHost); 239 return false; 240 } 241 242 bool Pre(const parser::AccClause::Self &x) { 243 const std::optional<parser::AccSelfClause> &accSelfClause = x.v; 244 if (accSelfClause && 245 std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) { 246 const auto &accObjectList = 247 std::get<parser::AccObjectList>((*accSelfClause).u); 248 ResolveAccObjectList(accObjectList, Symbol::Flag::AccSelf); 249 } 250 return false; 251 } 252 253 void Post(const parser::Name &); 254 255 private: 256 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &); 257 258 Symbol::Flags dataSharingAttributeFlags{Symbol::Flag::AccShared, 259 Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate, 260 Symbol::Flag::AccReduction}; 261 262 Symbol::Flags dataMappingAttributeFlags{Symbol::Flag::AccCreate, 263 Symbol::Flag::AccCopyIn, Symbol::Flag::AccCopyOut, 264 Symbol::Flag::AccDelete, Symbol::Flag::AccPresent}; 265 266 Symbol::Flags accDataMvtFlags{ 267 Symbol::Flag::AccDevice, Symbol::Flag::AccHost, Symbol::Flag::AccSelf}; 268 269 Symbol::Flags accFlagsRequireMark{Symbol::Flag::AccCreate, 270 Symbol::Flag::AccCopyIn, Symbol::Flag::AccCopyInReadOnly, 271 Symbol::Flag::AccCopy, Symbol::Flag::AccCopyOut, 272 Symbol::Flag::AccDevicePtr, Symbol::Flag::AccDeviceResident, 273 Symbol::Flag::AccLink, Symbol::Flag::AccPresent}; 274 275 void CheckAssociatedLoop(const parser::DoConstruct &); 276 void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag); 277 void ResolveAccObject(const parser::AccObject &, Symbol::Flag); 278 Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &); 279 Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &); 280 Symbol *ResolveName(const parser::Name &, bool parentScope = false); 281 Symbol *ResolveFctName(const parser::Name &); 282 Symbol *ResolveAccCommonBlockName(const parser::Name *); 283 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 284 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); 285 void CheckMultipleAppearances( 286 const parser::Name &, const Symbol &, Symbol::Flag); 287 void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList); 288 void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList); 289 void AllowOnlyVariable(const parser::AccObject &object); 290 void EnsureAllocatableOrPointer( 291 const llvm::acc::Clause clause, const parser::AccObjectList &objectList); 292 void AddRoutineInfoToSymbol( 293 Symbol &, const parser::OpenACCRoutineConstruct &); 294 Scope *topScope_; 295 }; 296 297 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct 298 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> { 299 public: 300 explicit OmpAttributeVisitor(SemanticsContext &context) 301 : DirectiveAttributeVisitor(context) {} 302 303 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); } 304 template <typename A> bool Pre(const A &) { return true; } 305 template <typename A> void Post(const A &) {} 306 307 template <typename A> bool Pre(const parser::Statement<A> &statement) { 308 currentStatementSource_ = statement.source; 309 // Keep track of the labels in all the labelled statements 310 if (statement.label) { 311 auto label{statement.label.value()}; 312 // Get the context to check if the labelled statement is in an 313 // enclosing OpenMP construct 314 std::optional<DirContext> thisContext{GetContextIf()}; 315 targetLabels_.emplace( 316 label, std::make_pair(currentStatementSource_, thisContext)); 317 // Check if a statement that causes a jump to the 'label' 318 // has already been encountered 319 auto range{sourceLabels_.equal_range(label)}; 320 for (auto it{range.first}; it != range.second; ++it) { 321 // Check if both the statement with 'label' and the statement that 322 // causes a jump to the 'label' are in the same scope 323 CheckLabelContext(it->second.first, currentStatementSource_, 324 it->second.second, thisContext); 325 } 326 } 327 return true; 328 } 329 330 bool Pre(const parser::InternalSubprogram &) { 331 // Clear the labels being tracked in the previous scope 332 ClearLabels(); 333 return true; 334 } 335 336 bool Pre(const parser::ModuleSubprogram &) { 337 // Clear the labels being tracked in the previous scope 338 ClearLabels(); 339 return true; 340 } 341 342 bool Pre(const parser::StmtFunctionStmt &x) { 343 const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)}; 344 if (const auto *expr{GetExpr(context_, parsedExpr)}) { 345 for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) { 346 if (!IsStmtFunctionDummy(symbol)) { 347 stmtFunctionExprSymbols_.insert(symbol.GetUltimate()); 348 } 349 } 350 } 351 return true; 352 } 353 354 bool Pre(const parser::OmpDirectiveSpecification &x) { 355 PushContext(x.source, std::get<llvm::omp::Directive>(x.t)); 356 return true; 357 } 358 void Post(const parser::OmpDirectiveSpecification &) { PopContext(); } 359 bool Pre(const parser::OmpMetadirectiveDirective &x) { 360 PushContext(x.source, llvm::omp::Directive::OMPD_metadirective); 361 return true; 362 } 363 void Post(const parser::OmpMetadirectiveDirective &) { PopContext(); } 364 365 bool Pre(const parser::OpenMPBlockConstruct &); 366 void Post(const parser::OpenMPBlockConstruct &); 367 368 void Post(const parser::OmpBeginBlockDirective &) { 369 GetContext().withinConstruct = true; 370 } 371 372 bool Pre(const parser::OpenMPSimpleStandaloneConstruct &); 373 void Post(const parser::OpenMPSimpleStandaloneConstruct &) { PopContext(); } 374 375 bool Pre(const parser::OpenMPLoopConstruct &); 376 void Post(const parser::OpenMPLoopConstruct &) { PopContext(); } 377 void Post(const parser::OmpBeginLoopDirective &) { 378 GetContext().withinConstruct = true; 379 } 380 bool Pre(const parser::DoConstruct &); 381 382 bool Pre(const parser::OpenMPSectionsConstruct &); 383 void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); } 384 385 bool Pre(const parser::OpenMPCriticalConstruct &critical); 386 void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); } 387 388 bool Pre(const parser::OpenMPDeclareSimdConstruct &x) { 389 PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd); 390 const auto &name{std::get<std::optional<parser::Name>>(x.t)}; 391 if (name) { 392 ResolveOmpName(*name, Symbol::Flag::OmpDeclareSimd); 393 } 394 return true; 395 } 396 void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); } 397 398 bool Pre(const parser::OpenMPDepobjConstruct &x) { 399 PushContext(x.source, llvm::omp::Directive::OMPD_depobj); 400 auto &object{std::get<parser::OmpObject>(x.t)}; 401 ResolveOmpObject(object, Symbol::Flag::OmpDependObject); 402 return true; 403 } 404 void Post(const parser::OpenMPDepobjConstruct &) { PopContext(); } 405 406 bool Pre(const parser::OpenMPRequiresConstruct &x) { 407 using Flags = WithOmpDeclarative::RequiresFlags; 408 using Requires = WithOmpDeclarative::RequiresFlag; 409 PushContext(x.source, llvm::omp::Directive::OMPD_requires); 410 411 // Gather information from the clauses. 412 Flags flags; 413 std::optional<common::OmpAtomicDefaultMemOrderType> memOrder; 414 for (const auto &clause : std::get<parser::OmpClauseList>(x.t).v) { 415 flags |= common::visit( 416 common::visitors{ 417 [&memOrder]( 418 const parser::OmpClause::AtomicDefaultMemOrder &atomic) { 419 memOrder = atomic.v.v; 420 return Flags{}; 421 }, 422 [](const parser::OmpClause::ReverseOffload &) { 423 return Flags{Requires::ReverseOffload}; 424 }, 425 [](const parser::OmpClause::UnifiedAddress &) { 426 return Flags{Requires::UnifiedAddress}; 427 }, 428 [](const parser::OmpClause::UnifiedSharedMemory &) { 429 return Flags{Requires::UnifiedSharedMemory}; 430 }, 431 [](const parser::OmpClause::DynamicAllocators &) { 432 return Flags{Requires::DynamicAllocators}; 433 }, 434 [](const auto &) { return Flags{}; }}, 435 clause.u); 436 } 437 // Merge clauses into parents' symbols details. 438 AddOmpRequiresToScope(currScope(), flags, memOrder); 439 return true; 440 } 441 void Post(const parser::OpenMPRequiresConstruct &) { PopContext(); } 442 443 bool Pre(const parser::OpenMPDeclareTargetConstruct &); 444 void Post(const parser::OpenMPDeclareTargetConstruct &) { PopContext(); } 445 446 bool Pre(const parser::OpenMPDeclareMapperConstruct &); 447 void Post(const parser::OpenMPDeclareMapperConstruct &) { PopContext(); } 448 449 bool Pre(const parser::OpenMPThreadprivate &); 450 void Post(const parser::OpenMPThreadprivate &) { PopContext(); } 451 452 bool Pre(const parser::OpenMPDeclarativeAllocate &); 453 void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); } 454 455 bool Pre(const parser::OpenMPDispatchConstruct &); 456 void Post(const parser::OpenMPDispatchConstruct &) { PopContext(); } 457 458 bool Pre(const parser::OpenMPExecutableAllocate &); 459 void Post(const parser::OpenMPExecutableAllocate &); 460 461 bool Pre(const parser::OpenMPAllocatorsConstruct &); 462 void Post(const parser::OpenMPAllocatorsConstruct &); 463 464 void Post(const parser::OmpObjectList &x) { 465 // The objects from OMP clauses should have already been resolved, 466 // except common blocks (the ResolveNamesVisitor does not visit 467 // parser::Name, those are dealt with as members of other structures). 468 // Iterate over elements of x, and resolve any common blocks that 469 // are still unresolved. 470 for (const parser::OmpObject &obj : x.v) { 471 auto *name{std::get_if<parser::Name>(&obj.u)}; 472 if (name && !name->symbol) { 473 Resolve(*name, currScope().MakeCommonBlock(name->source)); 474 } 475 } 476 } 477 478 // 2.15.3 Data-Sharing Attribute Clauses 479 bool Pre(const parser::OmpClause::Inclusive &x) { 480 ResolveOmpObjectList(x.v, Symbol::Flag::OmpInclusiveScan); 481 return false; 482 } 483 bool Pre(const parser::OmpClause::Exclusive &x) { 484 ResolveOmpObjectList(x.v, Symbol::Flag::OmpExclusiveScan); 485 return false; 486 } 487 void Post(const parser::OmpDefaultClause &); 488 bool Pre(const parser::OmpClause::Shared &x) { 489 ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared); 490 return false; 491 } 492 bool Pre(const parser::OmpClause::Private &x) { 493 ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate); 494 return false; 495 } 496 bool Pre(const parser::OmpAllocateClause &x) { 497 const auto &objectList{std::get<parser::OmpObjectList>(x.t)}; 498 ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate); 499 return false; 500 } 501 bool Pre(const parser::OmpClause::Firstprivate &x) { 502 ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate); 503 return false; 504 } 505 bool Pre(const parser::OmpClause::Lastprivate &x) { 506 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; 507 ResolveOmpObjectList(objList, Symbol::Flag::OmpLastPrivate); 508 return false; 509 } 510 bool Pre(const parser::OmpClause::Copyin &x) { 511 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn); 512 return false; 513 } 514 bool Pre(const parser::OmpClause::Copyprivate &x) { 515 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyPrivate); 516 return false; 517 } 518 bool Pre(const parser::OmpLinearClause &x) { 519 auto &objects{std::get<parser::OmpObjectList>(x.t)}; 520 ResolveOmpObjectList(objects, Symbol::Flag::OmpLinear); 521 return false; 522 } 523 524 bool Pre(const parser::OmpClause::Reduction &x) { 525 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)}; 526 ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction); 527 528 if (auto &modifiers{OmpGetModifiers(x.v)}) { 529 auto createDummyProcSymbol = [&](const parser::Name *name) { 530 // If name resolution failed, create a dummy symbol 531 const auto namePair{currScope().try_emplace( 532 name->source, Attrs{}, ProcEntityDetails{})}; 533 auto &newSymbol{*namePair.first->second}; 534 if (context_.intrinsics().IsIntrinsic(name->ToString())) { 535 newSymbol.attrs().set(Attr::INTRINSIC); 536 } 537 name->symbol = &newSymbol; 538 }; 539 540 for (auto &mod : *modifiers) { 541 if (!std::holds_alternative<parser::OmpReductionIdentifier>(mod.u)) { 542 continue; 543 } 544 auto &opr{std::get<parser::OmpReductionIdentifier>(mod.u)}; 545 if (auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) { 546 if (auto *name{parser::Unwrap<parser::Name>(procD->u)}) { 547 if (!name->symbol) { 548 if (!ResolveName(name)) { 549 createDummyProcSymbol(name); 550 } 551 } 552 } 553 if (auto *procRef{ 554 parser::Unwrap<parser::ProcComponentRef>(procD->u)}) { 555 if (!procRef->v.thing.component.symbol) { 556 if (!ResolveName(&procRef->v.thing.component)) { 557 createDummyProcSymbol(&procRef->v.thing.component); 558 } 559 } 560 } 561 } 562 } 563 using ReductionModifier = parser::OmpReductionModifier; 564 if (auto *maybeModifier{ 565 OmpGetUniqueModifier<ReductionModifier>(modifiers)}) { 566 if (maybeModifier->v == ReductionModifier::Value::Inscan) { 567 ResolveOmpObjectList(objList, Symbol::Flag::OmpInScanReduction); 568 } 569 } 570 } 571 return false; 572 } 573 574 bool Pre(const parser::OmpAlignedClause &x) { 575 const auto &alignedNameList{std::get<parser::OmpObjectList>(x.t)}; 576 ResolveOmpObjectList(alignedNameList, Symbol::Flag::OmpAligned); 577 return false; 578 } 579 580 bool Pre(const parser::OmpClause::Nontemporal &x) { 581 const auto &nontemporalNameList{x.v}; 582 ResolveOmpNameList(nontemporalNameList, Symbol::Flag::OmpNontemporal); 583 return false; 584 } 585 586 void Post(const parser::OmpIteration &x) { 587 if (const auto &name{std::get<parser::Name>(x.t)}; !name.symbol) { 588 auto *symbol{currScope().FindSymbol(name.source)}; 589 if (!symbol) { 590 // OmpIteration must use an existing object. If there isn't one, 591 // create a fake one and flag an error later. 592 symbol = &currScope().MakeSymbol( 593 name.source, Attrs{}, EntityDetails(/*isDummy=*/true)); 594 } 595 Resolve(name, symbol); 596 } 597 } 598 599 bool Pre(const parser::OmpClause::UseDevicePtr &x) { 600 ResolveOmpObjectList(x.v, Symbol::Flag::OmpUseDevicePtr); 601 return false; 602 } 603 604 bool Pre(const parser::OmpClause::UseDeviceAddr &x) { 605 ResolveOmpObjectList(x.v, Symbol::Flag::OmpUseDeviceAddr); 606 return false; 607 } 608 609 bool Pre(const parser::OmpClause::IsDevicePtr &x) { 610 ResolveOmpObjectList(x.v, Symbol::Flag::OmpIsDevicePtr); 611 return false; 612 } 613 614 bool Pre(const parser::OmpClause::HasDeviceAddr &x) { 615 ResolveOmpObjectList(x.v, Symbol::Flag::OmpHasDeviceAddr); 616 return false; 617 } 618 619 void Post(const parser::Name &); 620 621 // Keep track of labels in the statements that causes jumps to target labels 622 void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); } 623 void Post(const parser::ComputedGotoStmt &computedGotoStmt) { 624 for (auto &label : std::get<std::list<parser::Label>>(computedGotoStmt.t)) { 625 CheckSourceLabel(label); 626 } 627 } 628 void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) { 629 CheckSourceLabel(std::get<1>(arithmeticIfStmt.t)); 630 CheckSourceLabel(std::get<2>(arithmeticIfStmt.t)); 631 CheckSourceLabel(std::get<3>(arithmeticIfStmt.t)); 632 } 633 void Post(const parser::AssignedGotoStmt &assignedGotoStmt) { 634 for (auto &label : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) { 635 CheckSourceLabel(label); 636 } 637 } 638 void Post(const parser::AltReturnSpec &altReturnSpec) { 639 CheckSourceLabel(altReturnSpec.v); 640 } 641 void Post(const parser::ErrLabel &errLabel) { CheckSourceLabel(errLabel.v); } 642 void Post(const parser::EndLabel &endLabel) { CheckSourceLabel(endLabel.v); } 643 void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); } 644 645 void Post(const parser::OmpMapClause &x) { 646 Symbol::Flag ompFlag = Symbol::Flag::OmpMapToFrom; 647 auto &mods{OmpGetModifiers(x)}; 648 if (auto *mapType{OmpGetUniqueModifier<parser::OmpMapType>(mods)}) { 649 switch (mapType->v) { 650 case parser::OmpMapType::Value::To: 651 ompFlag = Symbol::Flag::OmpMapTo; 652 break; 653 case parser::OmpMapType::Value::From: 654 ompFlag = Symbol::Flag::OmpMapFrom; 655 break; 656 case parser::OmpMapType::Value::Tofrom: 657 ompFlag = Symbol::Flag::OmpMapToFrom; 658 break; 659 case parser::OmpMapType::Value::Alloc: 660 ompFlag = Symbol::Flag::OmpMapAlloc; 661 break; 662 case parser::OmpMapType::Value::Release: 663 ompFlag = Symbol::Flag::OmpMapRelease; 664 break; 665 case parser::OmpMapType::Value::Delete: 666 ompFlag = Symbol::Flag::OmpMapDelete; 667 break; 668 } 669 } 670 const auto &ompObjList{std::get<parser::OmpObjectList>(x.t)}; 671 for (const auto &ompObj : ompObjList.v) { 672 common::visit( 673 common::visitors{ 674 [&](const parser::Designator &designator) { 675 if (const auto *name{ 676 semantics::getDesignatorNameIfDataRef(designator)}) { 677 if (name->symbol) { 678 name->symbol->set(ompFlag); 679 AddToContextObjectWithDSA(*name->symbol, ompFlag); 680 } 681 if (name->symbol && 682 semantics::IsAssumedSizeArray(*name->symbol)) { 683 context_.Say(designator.source, 684 "Assumed-size whole arrays may not appear on the %s " 685 "clause"_err_en_US, 686 "MAP"); 687 } 688 } 689 }, 690 [&](const auto &name) {}, 691 }, 692 ompObj.u); 693 694 ResolveOmpObject(ompObj, ompFlag); 695 } 696 } 697 698 const parser::OmpClause *associatedClause{nullptr}; 699 void SetAssociatedClause(const parser::OmpClause &c) { 700 associatedClause = &c; 701 } 702 const parser::OmpClause *GetAssociatedClause() { return associatedClause; } 703 704 private: 705 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &); 706 707 Symbol::Flags dataSharingAttributeFlags{Symbol::Flag::OmpShared, 708 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate, 709 Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpReduction, 710 Symbol::Flag::OmpLinear}; 711 712 Symbol::Flags privateDataSharingAttributeFlags{Symbol::Flag::OmpPrivate, 713 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate}; 714 715 Symbol::Flags ompFlagsRequireNewSymbol{Symbol::Flag::OmpPrivate, 716 Symbol::Flag::OmpLinear, Symbol::Flag::OmpFirstPrivate, 717 Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpReduction, 718 Symbol::Flag::OmpCriticalLock, Symbol::Flag::OmpCopyIn, 719 Symbol::Flag::OmpUseDevicePtr, Symbol::Flag::OmpUseDeviceAddr, 720 Symbol::Flag::OmpIsDevicePtr, Symbol::Flag::OmpHasDeviceAddr}; 721 722 Symbol::Flags ompFlagsRequireMark{Symbol::Flag::OmpThreadprivate, 723 Symbol::Flag::OmpDeclareTarget, Symbol::Flag::OmpExclusiveScan, 724 Symbol::Flag::OmpInclusiveScan, Symbol::Flag::OmpInScanReduction}; 725 726 Symbol::Flags dataCopyingAttributeFlags{ 727 Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpCopyPrivate}; 728 729 std::vector<const parser::Name *> allocateNames_; // on one directive 730 UnorderedSymbolSet privateDataSharingAttributeObjects_; // on one directive 731 UnorderedSymbolSet stmtFunctionExprSymbols_; 732 std::multimap<const parser::Label, 733 std::pair<parser::CharBlock, std::optional<DirContext>>> 734 sourceLabels_; 735 std::map<const parser::Label, 736 std::pair<parser::CharBlock, std::optional<DirContext>>> 737 targetLabels_; 738 parser::CharBlock currentStatementSource_; 739 740 void AddAllocateName(const parser::Name *&object) { 741 allocateNames_.push_back(object); 742 } 743 void ClearAllocateNames() { allocateNames_.clear(); } 744 745 void AddPrivateDataSharingAttributeObjects(SymbolRef object) { 746 privateDataSharingAttributeObjects_.insert(object); 747 } 748 void ClearPrivateDataSharingAttributeObjects() { 749 privateDataSharingAttributeObjects_.clear(); 750 } 751 752 // Predetermined DSA rules 753 void PrivatizeAssociatedLoopIndexAndCheckLoopLevel( 754 const parser::OpenMPLoopConstruct &); 755 void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &); 756 757 bool IsNestedInDirective(llvm::omp::Directive directive); 758 void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag); 759 void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag); 760 Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &); 761 Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &); 762 Symbol *ResolveOmpCommonBlockName(const parser::Name *); 763 void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag); 764 void ResolveOmpName(const parser::Name &, Symbol::Flag); 765 Symbol *ResolveName(const parser::Name *); 766 Symbol *ResolveOmpObjectScope(const parser::Name *); 767 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); 768 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); 769 void CheckMultipleAppearances( 770 const parser::Name &, const Symbol &, Symbol::Flag); 771 772 void CheckDataCopyingClause( 773 const parser::Name &, const Symbol &, Symbol::Flag); 774 void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause); 775 void CheckObjectIsPrivatizable( 776 const parser::Name &, const Symbol &, Symbol::Flag); 777 void CheckSourceLabel(const parser::Label &); 778 void CheckLabelContext(const parser::CharBlock, const parser::CharBlock, 779 std::optional<DirContext>, std::optional<DirContext>); 780 void ClearLabels() { 781 sourceLabels_.clear(); 782 targetLabels_.clear(); 783 }; 784 void CheckAllNamesInAllocateStmt(const parser::CharBlock &source, 785 const parser::OmpObjectList &ompObjectList, 786 const parser::AllocateStmt &allocate); 787 void CheckNameInAllocateStmt(const parser::CharBlock &source, 788 const parser::Name &ompObject, const parser::AllocateStmt &allocate); 789 790 std::int64_t ordCollapseLevel{0}; 791 792 void AddOmpRequiresToScope(Scope &, WithOmpDeclarative::RequiresFlags, 793 std::optional<common::OmpAtomicDefaultMemOrderType>); 794 void IssueNonConformanceWarning( 795 llvm::omp::Directive D, parser::CharBlock source); 796 797 void CreateImplicitSymbols( 798 const Symbol *symbol, std::optional<Symbol::Flag> setFlag = std::nullopt); 799 }; 800 801 template <typename T> 802 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject( 803 const Symbol &object) { 804 auto it{dataSharingAttributeObjects_.find(object)}; 805 return it != dataSharingAttributeObjects_.end(); 806 } 807 808 template <typename T> 809 const parser::Name *DirectiveAttributeVisitor<T>::GetLoopIndex( 810 const parser::DoConstruct &x) { 811 using Bounds = parser::LoopControl::Bounds; 812 if (x.GetLoopControl()) { 813 if (const Bounds * b{std::get_if<Bounds>(&x.GetLoopControl()->u)}) { 814 return &b->name.thing; 815 } else { 816 return nullptr; 817 } 818 } else { 819 context_ 820 .Say(std::get<parser::Statement<parser::NonLabelDoStmt>>(x.t).source, 821 "Loop control is not present in the DO LOOP"_err_en_US) 822 .Attach(GetContext().directiveSource, 823 "associated with the enclosing LOOP construct"_en_US); 824 return nullptr; 825 } 826 } 827 828 template <typename T> 829 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf( 830 const parser::ExecutionPartConstruct &x) { 831 return parser::Unwrap<parser::DoConstruct>(x); 832 } 833 834 template <typename T> 835 Symbol *DirectiveAttributeVisitor<T>::DeclareNewPrivateAccessEntity( 836 const Symbol &object, Symbol::Flag flag, Scope &scope) { 837 assert(object.owner() != currScope()); 838 auto &symbol{MakeAssocSymbol(object.name(), object, scope)}; 839 symbol.set(flag); 840 if (flag == Symbol::Flag::OmpCopyIn) { 841 // The symbol in copyin clause must be threadprivate entity. 842 symbol.set(Symbol::Flag::OmpThreadprivate); 843 } 844 return &symbol; 845 } 846 847 template <typename T> 848 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity( 849 const parser::Name &name, Symbol::Flag flag, Scope &scope) { 850 if (!name.symbol) { 851 return nullptr; // not resolved by Name Resolution step, do nothing 852 } 853 name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope); 854 return name.symbol; 855 } 856 857 template <typename T> 858 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity( 859 Symbol &object, Symbol::Flag flag, Scope &scope) { 860 if (object.owner() != currScope()) { 861 return DeclareNewPrivateAccessEntity(object, flag, scope); 862 } else { 863 object.set(flag); 864 return &object; 865 } 866 } 867 868 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) { 869 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)}; 870 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)}; 871 switch (blockDir.v) { 872 case llvm::acc::Directive::ACCD_data: 873 case llvm::acc::Directive::ACCD_host_data: 874 case llvm::acc::Directive::ACCD_kernels: 875 case llvm::acc::Directive::ACCD_parallel: 876 case llvm::acc::Directive::ACCD_serial: 877 PushContext(blockDir.source, blockDir.v); 878 break; 879 default: 880 break; 881 } 882 ClearDataSharingAttributeObjects(); 883 return true; 884 } 885 886 bool AccAttributeVisitor::Pre(const parser::OpenACCDeclarativeConstruct &x) { 887 if (const auto *declConstruct{ 888 std::get_if<parser::OpenACCStandaloneDeclarativeConstruct>(&x.u)}) { 889 const auto &declDir{ 890 std::get<parser::AccDeclarativeDirective>(declConstruct->t)}; 891 PushContext(declDir.source, llvm::acc::Directive::ACCD_declare); 892 } 893 ClearDataSharingAttributeObjects(); 894 return true; 895 } 896 897 static const parser::AccObjectList &GetAccObjectList( 898 const parser::AccClause &clause) { 899 if (const auto *copyClause = 900 std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) { 901 return copyClause->v; 902 } else if (const auto *createClause = 903 std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) { 904 const Fortran::parser::AccObjectListWithModifier &listWithModifier = 905 createClause->v; 906 const Fortran::parser::AccObjectList &accObjectList = 907 std::get<Fortran::parser::AccObjectList>(listWithModifier.t); 908 return accObjectList; 909 } else if (const auto *copyinClause = 910 std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) { 911 const Fortran::parser::AccObjectListWithModifier &listWithModifier = 912 copyinClause->v; 913 const Fortran::parser::AccObjectList &accObjectList = 914 std::get<Fortran::parser::AccObjectList>(listWithModifier.t); 915 return accObjectList; 916 } else if (const auto *copyoutClause = 917 std::get_if<Fortran::parser::AccClause::Copyout>(&clause.u)) { 918 const Fortran::parser::AccObjectListWithModifier &listWithModifier = 919 copyoutClause->v; 920 const Fortran::parser::AccObjectList &accObjectList = 921 std::get<Fortran::parser::AccObjectList>(listWithModifier.t); 922 return accObjectList; 923 } else if (const auto *presentClause = 924 std::get_if<Fortran::parser::AccClause::Present>(&clause.u)) { 925 return presentClause->v; 926 } else if (const auto *deviceptrClause = 927 std::get_if<Fortran::parser::AccClause::Deviceptr>( 928 &clause.u)) { 929 return deviceptrClause->v; 930 } else if (const auto *deviceResidentClause = 931 std::get_if<Fortran::parser::AccClause::DeviceResident>( 932 &clause.u)) { 933 return deviceResidentClause->v; 934 } else if (const auto *linkClause = 935 std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) { 936 return linkClause->v; 937 } else { 938 llvm_unreachable("Clause without object list!"); 939 } 940 } 941 942 void AccAttributeVisitor::Post( 943 const parser::OpenACCStandaloneDeclarativeConstruct &x) { 944 const auto &clauseList = std::get<parser::AccClauseList>(x.t); 945 for (const auto &clause : clauseList.v) { 946 // Restriction - line 2414 947 DoNotAllowAssumedSizedArray(GetAccObjectList(clause)); 948 } 949 } 950 951 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) { 952 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)}; 953 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)}; 954 const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)}; 955 if (loopDir.v == llvm::acc::Directive::ACCD_loop) { 956 PushContext(loopDir.source, loopDir.v); 957 } 958 ClearDataSharingAttributeObjects(); 959 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 960 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 961 CheckAssociatedLoop(*outer); 962 return true; 963 } 964 965 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) { 966 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)}; 967 switch (standaloneDir.v) { 968 case llvm::acc::Directive::ACCD_enter_data: 969 case llvm::acc::Directive::ACCD_exit_data: 970 case llvm::acc::Directive::ACCD_init: 971 case llvm::acc::Directive::ACCD_set: 972 case llvm::acc::Directive::ACCD_shutdown: 973 case llvm::acc::Directive::ACCD_update: 974 PushContext(standaloneDir.source, standaloneDir.v); 975 break; 976 default: 977 break; 978 } 979 ClearDataSharingAttributeObjects(); 980 return true; 981 } 982 983 Symbol *AccAttributeVisitor::ResolveName( 984 const parser::Name &name, bool parentScope) { 985 Symbol *prev{currScope().FindSymbol(name.source)}; 986 // Check in parent scope if asked for. 987 if (!prev && parentScope) { 988 prev = currScope().parent().FindSymbol(name.source); 989 } 990 if (prev != name.symbol) { 991 name.symbol = prev; 992 } 993 return prev; 994 } 995 996 Symbol *AccAttributeVisitor::ResolveFctName(const parser::Name &name) { 997 Symbol *prev{currScope().FindSymbol(name.source)}; 998 if (!prev || (prev && prev->IsFuncResult())) { 999 prev = currScope().parent().FindSymbol(name.source); 1000 if (!prev) { 1001 prev = &context_.globalScope().MakeSymbol( 1002 name.source, Attrs{}, ProcEntityDetails{}); 1003 } 1004 } 1005 if (prev != name.symbol) { 1006 name.symbol = prev; 1007 } 1008 return prev; 1009 } 1010 1011 template <typename T> 1012 common::IfNoLvalue<T, T> FoldExpr( 1013 evaluate::FoldingContext &foldingContext, T &&expr) { 1014 return evaluate::Fold(foldingContext, std::move(expr)); 1015 } 1016 1017 template <typename T> 1018 MaybeExpr EvaluateExpr( 1019 Fortran::semantics::SemanticsContext &semanticsContext, const T &expr) { 1020 return FoldExpr( 1021 semanticsContext.foldingContext(), AnalyzeExpr(semanticsContext, expr)); 1022 } 1023 1024 void AccAttributeVisitor::AddRoutineInfoToSymbol( 1025 Symbol &symbol, const parser::OpenACCRoutineConstruct &x) { 1026 if (symbol.has<SubprogramDetails>()) { 1027 Fortran::semantics::OpenACCRoutineInfo info; 1028 const auto &clauses = std::get<Fortran::parser::AccClauseList>(x.t); 1029 for (const Fortran::parser::AccClause &clause : clauses.v) { 1030 if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) { 1031 if (info.deviceTypeInfos().empty()) { 1032 info.set_isSeq(); 1033 } else { 1034 info.deviceTypeInfos().back().set_isSeq(); 1035 } 1036 } else if (const auto *gangClause = 1037 std::get_if<Fortran::parser::AccClause::Gang>(&clause.u)) { 1038 if (info.deviceTypeInfos().empty()) { 1039 info.set_isGang(); 1040 } else { 1041 info.deviceTypeInfos().back().set_isGang(); 1042 } 1043 if (gangClause->v) { 1044 const Fortran::parser::AccGangArgList &x = *gangClause->v; 1045 for (const Fortran::parser::AccGangArg &gangArg : x.v) { 1046 if (const auto *dim = 1047 std::get_if<Fortran::parser::AccGangArg::Dim>(&gangArg.u)) { 1048 if (const auto v{EvaluateInt64(context_, dim->v)}) { 1049 if (info.deviceTypeInfos().empty()) { 1050 info.set_gangDim(*v); 1051 } else { 1052 info.deviceTypeInfos().back().set_gangDim(*v); 1053 } 1054 } 1055 } 1056 } 1057 } 1058 } else if (std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) { 1059 if (info.deviceTypeInfos().empty()) { 1060 info.set_isVector(); 1061 } else { 1062 info.deviceTypeInfos().back().set_isVector(); 1063 } 1064 } else if (std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) { 1065 if (info.deviceTypeInfos().empty()) { 1066 info.set_isWorker(); 1067 } else { 1068 info.deviceTypeInfos().back().set_isWorker(); 1069 } 1070 } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) { 1071 info.set_isNohost(); 1072 } else if (const auto *bindClause = 1073 std::get_if<Fortran::parser::AccClause::Bind>(&clause.u)) { 1074 if (const auto *name = 1075 std::get_if<Fortran::parser::Name>(&bindClause->v.u)) { 1076 if (Symbol *sym = ResolveFctName(*name)) { 1077 if (info.deviceTypeInfos().empty()) { 1078 info.set_bindName(sym->name().ToString()); 1079 } else { 1080 info.deviceTypeInfos().back().set_bindName( 1081 sym->name().ToString()); 1082 } 1083 } else { 1084 context_.Say((*name).source, 1085 "No function or subroutine declared for '%s'"_err_en_US, 1086 (*name).source); 1087 } 1088 } else if (const auto charExpr = 1089 std::get_if<Fortran::parser::ScalarDefaultCharExpr>( 1090 &bindClause->v.u)) { 1091 auto *charConst = 1092 Fortran::parser::Unwrap<Fortran::parser::CharLiteralConstant>( 1093 *charExpr); 1094 std::string str{std::get<std::string>(charConst->t)}; 1095 std::stringstream bindName; 1096 bindName << "\"" << str << "\""; 1097 if (info.deviceTypeInfos().empty()) { 1098 info.set_bindName(bindName.str()); 1099 } else { 1100 info.deviceTypeInfos().back().set_bindName(bindName.str()); 1101 } 1102 } 1103 } else if (const auto *dType = 1104 std::get_if<Fortran::parser::AccClause::DeviceType>( 1105 &clause.u)) { 1106 const parser::AccDeviceTypeExprList &deviceTypeExprList = dType->v; 1107 OpenACCRoutineDeviceTypeInfo dtypeInfo; 1108 dtypeInfo.set_dType(deviceTypeExprList.v.front().v); 1109 info.add_deviceTypeInfo(dtypeInfo); 1110 } 1111 } 1112 symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info); 1113 } 1114 } 1115 1116 bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) { 1117 const auto &verbatim{std::get<parser::Verbatim>(x.t)}; 1118 if (topScope_) { 1119 PushContext( 1120 verbatim.source, llvm::acc::Directive::ACCD_routine, *topScope_); 1121 } else { 1122 PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine); 1123 } 1124 const auto &optName{std::get<std::optional<parser::Name>>(x.t)}; 1125 if (optName) { 1126 if (Symbol *sym = ResolveFctName(*optName)) { 1127 Symbol &ultimate{sym->GetUltimate()}; 1128 AddRoutineInfoToSymbol(ultimate, x); 1129 } else { 1130 context_.Say((*optName).source, 1131 "No function or subroutine declared for '%s'"_err_en_US, 1132 (*optName).source); 1133 } 1134 } else { 1135 if (currScope().symbol()) { 1136 AddRoutineInfoToSymbol(*currScope().symbol(), x); 1137 } 1138 } 1139 return true; 1140 } 1141 1142 bool AccAttributeVisitor::Pre(const parser::AccBindClause &x) { 1143 if (const auto *name{std::get_if<parser::Name>(&x.u)}) { 1144 if (!ResolveFctName(*name)) { 1145 context_.Say(name->source, 1146 "No function or subroutine declared for '%s'"_err_en_US, 1147 name->source); 1148 } 1149 } 1150 return true; 1151 } 1152 1153 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) { 1154 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)}; 1155 const auto &combinedDir{ 1156 std::get<parser::AccCombinedDirective>(beginBlockDir.t)}; 1157 switch (combinedDir.v) { 1158 case llvm::acc::Directive::ACCD_kernels_loop: 1159 case llvm::acc::Directive::ACCD_parallel_loop: 1160 case llvm::acc::Directive::ACCD_serial_loop: 1161 PushContext(combinedDir.source, combinedDir.v); 1162 break; 1163 default: 1164 break; 1165 } 1166 const auto &clauseList{std::get<parser::AccClauseList>(beginBlockDir.t)}; 1167 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 1168 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 1169 CheckAssociatedLoop(*outer); 1170 ClearDataSharingAttributeObjects(); 1171 return true; 1172 } 1173 1174 static bool IsLastNameArray(const parser::Designator &designator) { 1175 const auto &name{GetLastName(designator)}; 1176 const evaluate::DataRef dataRef{*(name.symbol)}; 1177 return common::visit( 1178 common::visitors{ 1179 [](const evaluate::SymbolRef &ref) { 1180 return ref->Rank() > 0 || 1181 ref->GetType()->category() == DeclTypeSpec::Numeric; 1182 }, 1183 [](const evaluate::ArrayRef &aref) { 1184 return aref.base().IsSymbol() || 1185 aref.base().GetComponent().base().Rank() == 0; 1186 }, 1187 [](const auto &) { return false; }, 1188 }, 1189 dataRef.u); 1190 } 1191 1192 void AccAttributeVisitor::AllowOnlyArrayAndSubArray( 1193 const parser::AccObjectList &objectList) { 1194 for (const auto &accObject : objectList.v) { 1195 common::visit( 1196 common::visitors{ 1197 [&](const parser::Designator &designator) { 1198 if (!IsLastNameArray(designator)) { 1199 context_.Say(designator.source, 1200 "Only array element or subarray are allowed in %s directive"_err_en_US, 1201 parser::ToUpperCaseLetters( 1202 llvm::acc::getOpenACCDirectiveName( 1203 GetContext().directive) 1204 .str())); 1205 } 1206 }, 1207 [&](const auto &name) { 1208 context_.Say(name.source, 1209 "Only array element or subarray are allowed in %s directive"_err_en_US, 1210 parser::ToUpperCaseLetters( 1211 llvm::acc::getOpenACCDirectiveName(GetContext().directive) 1212 .str())); 1213 }, 1214 }, 1215 accObject.u); 1216 } 1217 } 1218 1219 void AccAttributeVisitor::DoNotAllowAssumedSizedArray( 1220 const parser::AccObjectList &objectList) { 1221 for (const auto &accObject : objectList.v) { 1222 common::visit( 1223 common::visitors{ 1224 [&](const parser::Designator &designator) { 1225 const auto &name{GetLastName(designator)}; 1226 if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol)) { 1227 context_.Say(designator.source, 1228 "Assumed-size dummy arrays may not appear on the %s " 1229 "directive"_err_en_US, 1230 parser::ToUpperCaseLetters( 1231 llvm::acc::getOpenACCDirectiveName( 1232 GetContext().directive) 1233 .str())); 1234 } 1235 }, 1236 [&](const auto &name) { 1237 1238 }, 1239 }, 1240 accObject.u); 1241 } 1242 } 1243 1244 void AccAttributeVisitor::AllowOnlyVariable(const parser::AccObject &object) { 1245 common::visit( 1246 common::visitors{ 1247 [&](const parser::Designator &designator) { 1248 const auto &name{GetLastName(designator)}; 1249 if (name.symbol && !semantics::IsVariableName(*name.symbol) && 1250 !semantics::IsNamedConstant(*name.symbol)) { 1251 context_.Say(designator.source, 1252 "Only variables are allowed in data clauses on the %s " 1253 "directive"_err_en_US, 1254 parser::ToUpperCaseLetters( 1255 llvm::acc::getOpenACCDirectiveName(GetContext().directive) 1256 .str())); 1257 } 1258 }, 1259 [&](const auto &name) {}, 1260 }, 1261 object.u); 1262 } 1263 1264 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) { 1265 const auto &verbatim{std::get<parser::Verbatim>(x.t)}; 1266 PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache); 1267 ClearDataSharingAttributeObjects(); 1268 1269 const auto &objectListWithModifier = 1270 std::get<parser::AccObjectListWithModifier>(x.t); 1271 const auto &objectList = 1272 std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t); 1273 1274 // 2.10 Cache directive restriction: A var in a cache directive must be a 1275 // single array element or a simple subarray. 1276 AllowOnlyArrayAndSubArray(objectList); 1277 1278 return true; 1279 } 1280 1281 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses( 1282 const parser::AccClauseList &x) { 1283 std::int64_t collapseLevel{0}; 1284 for (const auto &clause : x.v) { 1285 if (const auto *collapseClause{ 1286 std::get_if<parser::AccClause::Collapse>(&clause.u)}) { 1287 const parser::AccCollapseArg &arg = collapseClause->v; 1288 const auto &collapseValue{std::get<parser::ScalarIntConstantExpr>(arg.t)}; 1289 if (const auto v{EvaluateInt64(context_, collapseValue)}) { 1290 collapseLevel = *v; 1291 } 1292 } 1293 } 1294 1295 if (collapseLevel) { 1296 return collapseLevel; 1297 } 1298 return 1; // default is outermost loop 1299 } 1300 1301 void AccAttributeVisitor::CheckAssociatedLoop( 1302 const parser::DoConstruct &outerDoConstruct) { 1303 std::int64_t level{GetContext().associatedLoopLevel}; 1304 if (level <= 0) { // collapse value was negative or 0 1305 return; 1306 } 1307 1308 const auto getNextDoConstruct = 1309 [this](const parser::Block &block, 1310 std::int64_t &level) -> const parser::DoConstruct * { 1311 for (const auto &entry : block) { 1312 if (const auto *doConstruct = GetDoConstructIf(entry)) { 1313 return doConstruct; 1314 } else if (parser::Unwrap<parser::CompilerDirective>(entry)) { 1315 // It is allowed to have a compiler directive associated with the loop. 1316 continue; 1317 } else if (const auto &accLoop{ 1318 parser::Unwrap<parser::OpenACCLoopConstruct>(entry)}) { 1319 if (level == 0) 1320 break; 1321 const auto &beginDir{ 1322 std::get<parser::AccBeginLoopDirective>(accLoop->t)}; 1323 context_.Say(beginDir.source, 1324 "LOOP directive not expected in COLLAPSE loop nest"_err_en_US); 1325 level = 0; 1326 } else { 1327 break; 1328 } 1329 } 1330 return nullptr; 1331 }; 1332 1333 auto checkExprHasSymbols = [&](llvm::SmallVector<Symbol *> &ivs, 1334 semantics::UnorderedSymbolSet &symbols) { 1335 for (auto iv : ivs) { 1336 if (symbols.count(*iv) != 0) { 1337 context_.Say(GetContext().directiveSource, 1338 "Trip count must be computable and invariant"_err_en_US); 1339 } 1340 } 1341 }; 1342 1343 Symbol::Flag flag = Symbol::Flag::AccPrivate; 1344 llvm::SmallVector<Symbol *> ivs; 1345 using Bounds = parser::LoopControl::Bounds; 1346 for (const parser::DoConstruct *loop{&outerDoConstruct}; loop && level > 0;) { 1347 // Go through all nested loops to ensure index variable exists. 1348 if (const parser::Name * ivName{GetLoopIndex(*loop)}) { 1349 if (auto *symbol{ResolveAcc(*ivName, flag, currScope())}) { 1350 if (auto &control{loop->GetLoopControl()}) { 1351 if (const Bounds * b{std::get_if<Bounds>(&control->u)}) { 1352 if (auto lowerExpr{semantics::AnalyzeExpr(context_, b->lower)}) { 1353 semantics::UnorderedSymbolSet lowerSyms = 1354 evaluate::CollectSymbols(*lowerExpr); 1355 checkExprHasSymbols(ivs, lowerSyms); 1356 } 1357 if (auto upperExpr{semantics::AnalyzeExpr(context_, b->upper)}) { 1358 semantics::UnorderedSymbolSet upperSyms = 1359 evaluate::CollectSymbols(*upperExpr); 1360 checkExprHasSymbols(ivs, upperSyms); 1361 } 1362 } 1363 } 1364 ivs.push_back(symbol); 1365 } 1366 } 1367 1368 const auto &block{std::get<parser::Block>(loop->t)}; 1369 --level; 1370 loop = getNextDoConstruct(block, level); 1371 } 1372 CHECK(level == 0); 1373 } 1374 1375 void AccAttributeVisitor::EnsureAllocatableOrPointer( 1376 const llvm::acc::Clause clause, const parser::AccObjectList &objectList) { 1377 for (const auto &accObject : objectList.v) { 1378 common::visit( 1379 common::visitors{ 1380 [&](const parser::Designator &designator) { 1381 const auto &lastName{GetLastName(designator)}; 1382 if (!IsAllocatableOrObjectPointer(lastName.symbol)) { 1383 context_.Say(designator.source, 1384 "Argument `%s` on the %s clause must be a variable or " 1385 "array with the POINTER or ALLOCATABLE attribute"_err_en_US, 1386 lastName.symbol->name(), 1387 parser::ToUpperCaseLetters( 1388 llvm::acc::getOpenACCClauseName(clause).str())); 1389 } 1390 }, 1391 [&](const auto &name) { 1392 context_.Say(name.source, 1393 "Argument on the %s clause must be a variable or " 1394 "array with the POINTER or ALLOCATABLE attribute"_err_en_US, 1395 parser::ToUpperCaseLetters( 1396 llvm::acc::getOpenACCClauseName(clause).str())); 1397 }, 1398 }, 1399 accObject.u); 1400 } 1401 } 1402 1403 bool AccAttributeVisitor::Pre(const parser::AccClause::Attach &x) { 1404 // Restriction - line 1708-1709 1405 EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_attach, x.v); 1406 return true; 1407 } 1408 1409 bool AccAttributeVisitor::Pre(const parser::AccClause::Detach &x) { 1410 // Restriction - line 1715-1717 1411 EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_detach, x.v); 1412 return true; 1413 } 1414 1415 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) { 1416 if (!dirContext_.empty()) { 1417 switch (x.v) { 1418 case llvm::acc::DefaultValue::ACC_Default_present: 1419 SetContextDefaultDSA(Symbol::Flag::AccPresent); 1420 break; 1421 case llvm::acc::DefaultValue::ACC_Default_none: 1422 SetContextDefaultDSA(Symbol::Flag::AccNone); 1423 break; 1424 } 1425 } 1426 } 1427 1428 // For OpenACC constructs, check all the data-refs within the constructs 1429 // and adjust the symbol for each Name if necessary 1430 void AccAttributeVisitor::Post(const parser::Name &name) { 1431 auto *symbol{name.symbol}; 1432 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) { 1433 if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() && 1434 !symbol->has<SubprogramDetails>() && !IsObjectWithDSA(*symbol)) { 1435 if (Symbol * found{currScope().FindSymbol(name.source)}) { 1436 if (symbol != found) { 1437 name.symbol = found; // adjust the symbol within region 1438 } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) { 1439 // 2.5.14. 1440 context_.Say(name.source, 1441 "The DEFAULT(NONE) clause requires that '%s' must be listed in " 1442 "a data-mapping clause"_err_en_US, 1443 symbol->name()); 1444 } 1445 } 1446 } 1447 } // within OpenACC construct 1448 } 1449 1450 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName( 1451 const parser::Name *name) { 1452 if (auto *prev{name 1453 ? GetContext().scope.parent().FindCommonBlock(name->source) 1454 : nullptr}) { 1455 name->symbol = prev; 1456 return prev; 1457 } 1458 // Check if the Common Block is declared in the current scope 1459 if (auto *commonBlockSymbol{ 1460 name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) { 1461 name->symbol = commonBlockSymbol; 1462 return commonBlockSymbol; 1463 } 1464 return nullptr; 1465 } 1466 1467 void AccAttributeVisitor::ResolveAccObjectList( 1468 const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) { 1469 for (const auto &accObject : accObjectList.v) { 1470 AllowOnlyVariable(accObject); 1471 ResolveAccObject(accObject, accFlag); 1472 } 1473 } 1474 1475 void AccAttributeVisitor::ResolveAccObject( 1476 const parser::AccObject &accObject, Symbol::Flag accFlag) { 1477 common::visit( 1478 common::visitors{ 1479 [&](const parser::Designator &designator) { 1480 if (const auto *name{ 1481 semantics::getDesignatorNameIfDataRef(designator)}) { 1482 if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) { 1483 AddToContextObjectWithDSA(*symbol, accFlag); 1484 if (dataSharingAttributeFlags.test(accFlag)) { 1485 CheckMultipleAppearances(*name, *symbol, accFlag); 1486 } 1487 } 1488 } else { 1489 // Array sections to be changed to substrings as needed 1490 if (AnalyzeExpr(context_, designator)) { 1491 if (std::holds_alternative<parser::Substring>(designator.u)) { 1492 context_.Say(designator.source, 1493 "Substrings are not allowed on OpenACC " 1494 "directives or clauses"_err_en_US); 1495 } 1496 } 1497 // other checks, more TBD 1498 } 1499 }, 1500 [&](const parser::Name &name) { // common block 1501 if (auto *symbol{ResolveAccCommonBlockName(&name)}) { 1502 CheckMultipleAppearances( 1503 name, *symbol, Symbol::Flag::AccCommonBlock); 1504 for (auto &object : symbol->get<CommonBlockDetails>().objects()) { 1505 if (auto *resolvedObject{ 1506 ResolveAcc(*object, accFlag, currScope())}) { 1507 AddToContextObjectWithDSA(*resolvedObject, accFlag); 1508 } 1509 } 1510 } else { 1511 context_.Say(name.source, 1512 "COMMON block must be declared in the same scoping unit " 1513 "in which the OpenACC directive or clause appears"_err_en_US); 1514 } 1515 }, 1516 }, 1517 accObject.u); 1518 } 1519 1520 Symbol *AccAttributeVisitor::ResolveAcc( 1521 const parser::Name &name, Symbol::Flag accFlag, Scope &scope) { 1522 return DeclareOrMarkOtherAccessEntity(name, accFlag); 1523 } 1524 1525 Symbol *AccAttributeVisitor::ResolveAcc( 1526 Symbol &symbol, Symbol::Flag accFlag, Scope &scope) { 1527 return DeclareOrMarkOtherAccessEntity(symbol, accFlag); 1528 } 1529 1530 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1531 const parser::Name &name, Symbol::Flag accFlag) { 1532 Symbol *prev{currScope().FindSymbol(name.source)}; 1533 if (!name.symbol || !prev) { 1534 return nullptr; 1535 } else if (prev != name.symbol) { 1536 name.symbol = prev; 1537 } 1538 return DeclareOrMarkOtherAccessEntity(*prev, accFlag); 1539 } 1540 1541 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity( 1542 Symbol &object, Symbol::Flag accFlag) { 1543 if (accFlagsRequireMark.test(accFlag)) { 1544 if (GetContext().directive == llvm::acc::ACCD_declare) { 1545 object.set(Symbol::Flag::AccDeclare); 1546 object.set(accFlag); 1547 } 1548 } 1549 return &object; 1550 } 1551 1552 static bool WithMultipleAppearancesAccException( 1553 const Symbol &symbol, Symbol::Flag flag) { 1554 return false; // Place holder 1555 } 1556 1557 void AccAttributeVisitor::CheckMultipleAppearances( 1558 const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) { 1559 const auto *target{&symbol}; 1560 if (HasDataSharingAttributeObject(*target) && 1561 !WithMultipleAppearancesAccException(symbol, accFlag)) { 1562 context_.Say(name.source, 1563 "'%s' appears in more than one data-sharing clause " 1564 "on the same OpenACC directive"_err_en_US, 1565 name.ToString()); 1566 } else { 1567 AddDataSharingAttributeObject(*target); 1568 } 1569 } 1570 1571 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) { 1572 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 1573 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1574 switch (beginDir.v) { 1575 case llvm::omp::Directive::OMPD_masked: 1576 case llvm::omp::Directive::OMPD_parallel_masked: 1577 case llvm::omp::Directive::OMPD_master: 1578 case llvm::omp::Directive::OMPD_parallel_master: 1579 case llvm::omp::Directive::OMPD_ordered: 1580 case llvm::omp::Directive::OMPD_parallel: 1581 case llvm::omp::Directive::OMPD_scope: 1582 case llvm::omp::Directive::OMPD_single: 1583 case llvm::omp::Directive::OMPD_target: 1584 case llvm::omp::Directive::OMPD_target_data: 1585 case llvm::omp::Directive::OMPD_task: 1586 case llvm::omp::Directive::OMPD_taskgroup: 1587 case llvm::omp::Directive::OMPD_teams: 1588 case llvm::omp::Directive::OMPD_workshare: 1589 case llvm::omp::Directive::OMPD_parallel_workshare: 1590 case llvm::omp::Directive::OMPD_target_teams: 1591 case llvm::omp::Directive::OMPD_target_parallel: 1592 PushContext(beginDir.source, beginDir.v); 1593 break; 1594 default: 1595 // TODO others 1596 break; 1597 } 1598 if (beginDir.v == llvm::omp::Directive::OMPD_master || 1599 beginDir.v == llvm::omp::Directive::OMPD_parallel_master) 1600 IssueNonConformanceWarning(beginDir.v, beginDir.source); 1601 ClearDataSharingAttributeObjects(); 1602 ClearPrivateDataSharingAttributeObjects(); 1603 ClearAllocateNames(); 1604 return true; 1605 } 1606 1607 void OmpAttributeVisitor::Post(const parser::OpenMPBlockConstruct &x) { 1608 const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)}; 1609 const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)}; 1610 switch (beginDir.v) { 1611 case llvm::omp::Directive::OMPD_masked: 1612 case llvm::omp::Directive::OMPD_master: 1613 case llvm::omp::Directive::OMPD_parallel_masked: 1614 case llvm::omp::Directive::OMPD_parallel_master: 1615 case llvm::omp::Directive::OMPD_parallel: 1616 case llvm::omp::Directive::OMPD_scope: 1617 case llvm::omp::Directive::OMPD_single: 1618 case llvm::omp::Directive::OMPD_target: 1619 case llvm::omp::Directive::OMPD_task: 1620 case llvm::omp::Directive::OMPD_teams: 1621 case llvm::omp::Directive::OMPD_parallel_workshare: 1622 case llvm::omp::Directive::OMPD_target_teams: 1623 case llvm::omp::Directive::OMPD_target_parallel: { 1624 bool hasPrivate; 1625 for (const auto *allocName : allocateNames_) { 1626 hasPrivate = false; 1627 for (auto privateObj : privateDataSharingAttributeObjects_) { 1628 const Symbol &symbolPrivate{*privateObj}; 1629 if (allocName->source == symbolPrivate.name()) { 1630 hasPrivate = true; 1631 break; 1632 } 1633 } 1634 if (!hasPrivate) { 1635 context_.Say(allocName->source, 1636 "The ALLOCATE clause requires that '%s' must be listed in a " 1637 "private " 1638 "data-sharing attribute clause on the same directive"_err_en_US, 1639 allocName->ToString()); 1640 } 1641 } 1642 break; 1643 } 1644 default: 1645 break; 1646 } 1647 PopContext(); 1648 } 1649 1650 bool OmpAttributeVisitor::Pre( 1651 const parser::OpenMPSimpleStandaloneConstruct &x) { 1652 const auto &standaloneDir{ 1653 std::get<parser::OmpSimpleStandaloneDirective>(x.t)}; 1654 switch (standaloneDir.v) { 1655 case llvm::omp::Directive::OMPD_barrier: 1656 case llvm::omp::Directive::OMPD_ordered: 1657 case llvm::omp::Directive::OMPD_scan: 1658 case llvm::omp::Directive::OMPD_target_enter_data: 1659 case llvm::omp::Directive::OMPD_target_exit_data: 1660 case llvm::omp::Directive::OMPD_target_update: 1661 case llvm::omp::Directive::OMPD_taskwait: 1662 case llvm::omp::Directive::OMPD_taskyield: 1663 PushContext(standaloneDir.source, standaloneDir.v); 1664 break; 1665 default: 1666 break; 1667 } 1668 ClearDataSharingAttributeObjects(); 1669 return true; 1670 } 1671 1672 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) { 1673 const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)}; 1674 const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)}; 1675 const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)}; 1676 switch (beginDir.v) { 1677 case llvm::omp::Directive::OMPD_distribute: 1678 case llvm::omp::Directive::OMPD_distribute_parallel_do: 1679 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd: 1680 case llvm::omp::Directive::OMPD_distribute_simd: 1681 case llvm::omp::Directive::OMPD_do: 1682 case llvm::omp::Directive::OMPD_do_simd: 1683 case llvm::omp::Directive::OMPD_loop: 1684 case llvm::omp::Directive::OMPD_masked_taskloop_simd: 1685 case llvm::omp::Directive::OMPD_masked_taskloop: 1686 case llvm::omp::Directive::OMPD_master_taskloop_simd: 1687 case llvm::omp::Directive::OMPD_master_taskloop: 1688 case llvm::omp::Directive::OMPD_parallel_do: 1689 case llvm::omp::Directive::OMPD_parallel_do_simd: 1690 case llvm::omp::Directive::OMPD_parallel_masked_taskloop_simd: 1691 case llvm::omp::Directive::OMPD_parallel_masked_taskloop: 1692 case llvm::omp::Directive::OMPD_parallel_master_taskloop_simd: 1693 case llvm::omp::Directive::OMPD_parallel_master_taskloop: 1694 case llvm::omp::Directive::OMPD_simd: 1695 case llvm::omp::Directive::OMPD_target_loop: 1696 case llvm::omp::Directive::OMPD_target_parallel_do: 1697 case llvm::omp::Directive::OMPD_target_parallel_do_simd: 1698 case llvm::omp::Directive::OMPD_target_parallel_loop: 1699 case llvm::omp::Directive::OMPD_target_teams_distribute: 1700 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do: 1701 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd: 1702 case llvm::omp::Directive::OMPD_target_teams_distribute_simd: 1703 case llvm::omp::Directive::OMPD_target_teams_loop: 1704 case llvm::omp::Directive::OMPD_target_simd: 1705 case llvm::omp::Directive::OMPD_taskloop: 1706 case llvm::omp::Directive::OMPD_taskloop_simd: 1707 case llvm::omp::Directive::OMPD_teams_distribute: 1708 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do: 1709 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd: 1710 case llvm::omp::Directive::OMPD_teams_distribute_simd: 1711 case llvm::omp::Directive::OMPD_teams_loop: 1712 case llvm::omp::Directive::OMPD_tile: 1713 case llvm::omp::Directive::OMPD_unroll: 1714 PushContext(beginDir.source, beginDir.v); 1715 break; 1716 default: 1717 break; 1718 } 1719 if (beginDir.v == llvm::omp::OMPD_master_taskloop || 1720 beginDir.v == llvm::omp::OMPD_master_taskloop_simd || 1721 beginDir.v == llvm::omp::OMPD_parallel_master_taskloop || 1722 beginDir.v == llvm::omp::OMPD_parallel_master_taskloop_simd || 1723 beginDir.v == llvm::omp::Directive::OMPD_target_loop) 1724 IssueNonConformanceWarning(beginDir.v, beginDir.source); 1725 ClearDataSharingAttributeObjects(); 1726 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList)); 1727 1728 if (beginDir.v == llvm::omp::Directive::OMPD_do) { 1729 if (const auto &doConstruct{ 1730 std::get<std::optional<parser::DoConstruct>>(x.t)}) { 1731 if (doConstruct.value().IsDoWhile()) { 1732 return true; 1733 } 1734 } 1735 } 1736 PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x); 1737 ordCollapseLevel = GetAssociatedLoopLevelFromClauses(clauseList) + 1; 1738 return true; 1739 } 1740 1741 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct( 1742 const parser::Name &iv) { 1743 // Find the parallel or task generating construct enclosing the 1744 // sequential loop. 1745 auto targetIt{dirContext_.rbegin()}; 1746 for (;; ++targetIt) { 1747 if (targetIt == dirContext_.rend()) { 1748 return; 1749 } 1750 if (llvm::omp::allParallelSet.test(targetIt->directive) || 1751 llvm::omp::taskGeneratingSet.test(targetIt->directive)) { 1752 break; 1753 } 1754 } 1755 // If this symbol already has a data-sharing attribute then there is nothing 1756 // to do here. 1757 if (const Symbol * symbol{iv.symbol}) { 1758 for (auto symMap : targetIt->objectWithDSA) { 1759 if (symMap.first->name() == symbol->name()) { 1760 return; 1761 } 1762 } 1763 } 1764 // If this symbol is already Private or Firstprivate in the enclosing 1765 // OpenMP parallel or task then there is nothing to do here. 1766 if (auto *symbol{targetIt->scope.FindSymbol(iv.source)}) { 1767 if (symbol->owner() == targetIt->scope) { 1768 if (symbol->test(Symbol::Flag::OmpPrivate) || 1769 symbol->test(Symbol::Flag::OmpFirstPrivate)) { 1770 return; 1771 } 1772 } 1773 } 1774 // Otherwise find the symbol and make it Private for the entire enclosing 1775 // parallel or task 1776 if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) { 1777 targetIt++; 1778 symbol->set(Symbol::Flag::OmpPreDetermined); 1779 iv.symbol = symbol; // adjust the symbol within region 1780 for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) { 1781 AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it); 1782 } 1783 } 1784 } 1785 1786 // [OMP-4.5]2.15.1.1 Data-sharing Attribute Rules - Predetermined 1787 // - A loop iteration variable for a sequential loop in a parallel 1788 // or task generating construct is private in the innermost such 1789 // construct that encloses the loop 1790 // Loop iteration variables are not well defined for DO WHILE loop. 1791 // Use of DO CONCURRENT inside OpenMP construct is unspecified behavior 1792 // till OpenMP-5.0 standard. 1793 // In above both cases we skip the privatization of iteration variables. 1794 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) { 1795 if (!dirContext_.empty() && GetContext().withinConstruct) { 1796 llvm::SmallVector<const parser::Name *> ivs; 1797 if (x.IsDoNormal()) { 1798 const parser::Name *iv{GetLoopIndex(x)}; 1799 if (iv && iv->symbol) 1800 ivs.push_back(iv); 1801 } 1802 ordCollapseLevel--; 1803 for (auto iv : ivs) { 1804 if (!iv->symbol->test(Symbol::Flag::OmpPreDetermined)) { 1805 ResolveSeqLoopIndexInParallelOrTaskConstruct(*iv); 1806 } else { 1807 // TODO: conflict checks with explicitly determined DSA 1808 } 1809 if (ordCollapseLevel) { 1810 if (const auto *details{iv->symbol->detailsIf<HostAssocDetails>()}) { 1811 const Symbol *tpSymbol = &details->symbol(); 1812 if (tpSymbol->test(Symbol::Flag::OmpThreadprivate)) { 1813 context_.Say(iv->source, 1814 "Loop iteration variable %s is not allowed in THREADPRIVATE."_err_en_US, 1815 iv->ToString()); 1816 } 1817 } 1818 } 1819 } 1820 } 1821 return true; 1822 } 1823 1824 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses( 1825 const parser::OmpClauseList &x) { 1826 std::int64_t orderedLevel{0}; 1827 std::int64_t collapseLevel{0}; 1828 1829 const parser::OmpClause *ordClause{nullptr}; 1830 const parser::OmpClause *collClause{nullptr}; 1831 1832 for (const auto &clause : x.v) { 1833 if (const auto *orderedClause{ 1834 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) { 1835 if (const auto v{EvaluateInt64(context_, orderedClause->v)}) { 1836 orderedLevel = *v; 1837 } 1838 ordClause = &clause; 1839 } 1840 if (const auto *collapseClause{ 1841 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) { 1842 if (const auto v{EvaluateInt64(context_, collapseClause->v)}) { 1843 collapseLevel = *v; 1844 } 1845 collClause = &clause; 1846 } 1847 } 1848 1849 if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) { 1850 SetAssociatedClause(*ordClause); 1851 return orderedLevel; 1852 } else if (!orderedLevel && collapseLevel) { 1853 SetAssociatedClause(*collClause); 1854 return collapseLevel; 1855 } // orderedLevel < collapseLevel is an error handled in structural checks 1856 return 1; // default is outermost loop 1857 } 1858 1859 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined 1860 // - The loop iteration variable(s) in the associated do-loop(s) of a do, 1861 // parallel do, taskloop, or distribute construct is (are) private. 1862 // - The loop iteration variable in the associated do-loop of a simd construct 1863 // with just one associated do-loop is linear with a linear-step that is the 1864 // increment of the associated do-loop. 1865 // - The loop iteration variables in the associated do-loops of a simd 1866 // construct with multiple associated do-loops are lastprivate. 1867 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel( 1868 const parser::OpenMPLoopConstruct &x) { 1869 std::int64_t level{GetContext().associatedLoopLevel}; 1870 if (level <= 0) { 1871 return; 1872 } 1873 Symbol::Flag ivDSA; 1874 if (!llvm::omp::allSimdSet.test(GetContext().directive)) { 1875 ivDSA = Symbol::Flag::OmpPrivate; 1876 } else if (level == 1) { 1877 ivDSA = Symbol::Flag::OmpLinear; 1878 } else { 1879 ivDSA = Symbol::Flag::OmpLastPrivate; 1880 } 1881 1882 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)}; 1883 if (outer.has_value()) { 1884 for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) { 1885 // go through all the nested do-loops and resolve index variables 1886 const parser::Name *iv{GetLoopIndex(*loop)}; 1887 if (iv) { 1888 if (auto *symbol{ResolveOmp(*iv, ivDSA, currScope())}) { 1889 symbol->set(Symbol::Flag::OmpPreDetermined); 1890 iv->symbol = symbol; // adjust the symbol within region 1891 AddToContextObjectWithDSA(*symbol, ivDSA); 1892 } 1893 1894 const auto &block{std::get<parser::Block>(loop->t)}; 1895 const auto it{block.begin()}; 1896 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr; 1897 } 1898 } 1899 CheckAssocLoopLevel(level, GetAssociatedClause()); 1900 } else { 1901 context_.Say(GetContext().directiveSource, 1902 "A DO loop must follow the %s directive"_err_en_US, 1903 parser::ToUpperCaseLetters( 1904 llvm::omp::getOpenMPDirectiveName(GetContext().directive).str())); 1905 } 1906 } 1907 void OmpAttributeVisitor::CheckAssocLoopLevel( 1908 std::int64_t level, const parser::OmpClause *clause) { 1909 if (clause && level != 0) { 1910 context_.Say(clause->source, 1911 "The value of the parameter in the COLLAPSE or ORDERED clause must" 1912 " not be larger than the number of nested loops" 1913 " following the construct."_err_en_US); 1914 } 1915 } 1916 1917 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) { 1918 const auto &beginSectionsDir{ 1919 std::get<parser::OmpBeginSectionsDirective>(x.t)}; 1920 const auto &beginDir{ 1921 std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)}; 1922 switch (beginDir.v) { 1923 case llvm::omp::Directive::OMPD_parallel_sections: 1924 case llvm::omp::Directive::OMPD_sections: 1925 PushContext(beginDir.source, beginDir.v); 1926 GetContext().withinConstruct = true; 1927 break; 1928 default: 1929 break; 1930 } 1931 ClearDataSharingAttributeObjects(); 1932 return true; 1933 } 1934 1935 bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { 1936 const auto &beginCriticalDir{std::get<parser::OmpCriticalDirective>(x.t)}; 1937 const auto &endCriticalDir{std::get<parser::OmpEndCriticalDirective>(x.t)}; 1938 PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical); 1939 GetContext().withinConstruct = true; 1940 if (const auto &criticalName{ 1941 std::get<std::optional<parser::Name>>(beginCriticalDir.t)}) { 1942 ResolveOmpName(*criticalName, Symbol::Flag::OmpCriticalLock); 1943 } 1944 if (const auto &endCriticalName{ 1945 std::get<std::optional<parser::Name>>(endCriticalDir.t)}) { 1946 ResolveOmpName(*endCriticalName, Symbol::Flag::OmpCriticalLock); 1947 } 1948 return true; 1949 } 1950 1951 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareTargetConstruct &x) { 1952 PushContext(x.source, llvm::omp::Directive::OMPD_declare_target); 1953 const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)}; 1954 if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) { 1955 ResolveOmpObjectList(*objectList, Symbol::Flag::OmpDeclareTarget); 1956 } else if (const auto *clauseList{ 1957 parser::Unwrap<parser::OmpClauseList>(spec.u)}) { 1958 for (const auto &clause : clauseList->v) { 1959 if (const auto *toClause{std::get_if<parser::OmpClause::To>(&clause.u)}) { 1960 auto &objList{std::get<parser::OmpObjectList>(toClause->v.t)}; 1961 ResolveOmpObjectList(objList, Symbol::Flag::OmpDeclareTarget); 1962 } else if (const auto *linkClause{ 1963 std::get_if<parser::OmpClause::Link>(&clause.u)}) { 1964 ResolveOmpObjectList(linkClause->v, Symbol::Flag::OmpDeclareTarget); 1965 } else if (const auto *enterClause{ 1966 std::get_if<parser::OmpClause::Enter>(&clause.u)}) { 1967 ResolveOmpObjectList(enterClause->v, Symbol::Flag::OmpDeclareTarget); 1968 } 1969 } 1970 } 1971 return true; 1972 } 1973 1974 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) { 1975 PushContext(x.source, llvm::omp::Directive::OMPD_declare_mapper); 1976 return true; 1977 } 1978 1979 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { 1980 PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate); 1981 const auto &list{std::get<parser::OmpObjectList>(x.t)}; 1982 ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate); 1983 return true; 1984 } 1985 1986 bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) { 1987 PushContext(x.source, llvm::omp::Directive::OMPD_allocate); 1988 const auto &list{std::get<parser::OmpObjectList>(x.t)}; 1989 ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective); 1990 return false; 1991 } 1992 1993 bool OmpAttributeVisitor::Pre(const parser::OpenMPDispatchConstruct &x) { 1994 PushContext(x.source, llvm::omp::Directive::OMPD_dispatch); 1995 return true; 1996 } 1997 1998 bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) { 1999 PushContext(x.source, llvm::omp::Directive::OMPD_allocate); 2000 const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}; 2001 if (list) { 2002 ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective); 2003 } 2004 return true; 2005 } 2006 2007 bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) { 2008 PushContext(x.source, llvm::omp::Directive::OMPD_allocators); 2009 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)}; 2010 for (const auto &clause : clauseList.v) { 2011 if (const auto *allocClause{ 2012 std::get_if<parser::OmpClause::Allocate>(&clause.u)}) { 2013 ResolveOmpObjectList(std::get<parser::OmpObjectList>(allocClause->v.t), 2014 Symbol::Flag::OmpExecutableAllocateDirective); 2015 } 2016 } 2017 return true; 2018 } 2019 2020 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) { 2021 // The DEFAULT clause may also be used on METADIRECTIVE. In that case 2022 // there is nothing to do. 2023 using DataSharingAttribute = parser::OmpDefaultClause::DataSharingAttribute; 2024 if (auto *dsa{std::get_if<DataSharingAttribute>(&x.u)}) { 2025 if (!dirContext_.empty()) { 2026 switch (*dsa) { 2027 case DataSharingAttribute::Private: 2028 SetContextDefaultDSA(Symbol::Flag::OmpPrivate); 2029 break; 2030 case DataSharingAttribute::Firstprivate: 2031 SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate); 2032 break; 2033 case DataSharingAttribute::Shared: 2034 SetContextDefaultDSA(Symbol::Flag::OmpShared); 2035 break; 2036 case DataSharingAttribute::None: 2037 SetContextDefaultDSA(Symbol::Flag::OmpNone); 2038 break; 2039 } 2040 } 2041 } 2042 } 2043 2044 bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) { 2045 if (dirContext_.size() >= 1) { 2046 for (std::size_t i = dirContext_.size() - 1; i > 0; --i) { 2047 if (dirContext_[i - 1].directive == directive) { 2048 return true; 2049 } 2050 } 2051 } 2052 return false; 2053 } 2054 2055 void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) { 2056 bool hasAllocator = false; 2057 // TODO: Investigate whether searching the clause list can be done with 2058 // parser::Unwrap instead of the following loop 2059 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)}; 2060 for (const auto &clause : clauseList.v) { 2061 if (std::get_if<parser::OmpClause::Allocator>(&clause.u)) { 2062 hasAllocator = true; 2063 } 2064 } 2065 2066 if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) { 2067 // TODO: expand this check to exclude the case when a requires 2068 // directive with the dynamic_allocators clause is present 2069 // in the same compilation unit (OMP5.0 2.11.3). 2070 context_.Say(x.source, 2071 "ALLOCATE directives that appear in a TARGET region " 2072 "must specify an allocator clause"_err_en_US); 2073 } 2074 2075 const auto &allocateStmt = 2076 std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement; 2077 if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) { 2078 CheckAllNamesInAllocateStmt( 2079 std::get<parser::Verbatim>(x.t).source, *list, allocateStmt); 2080 } 2081 if (const auto &subDirs{ 2082 std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>( 2083 x.t)}) { 2084 for (const auto &dalloc : *subDirs) { 2085 CheckAllNamesInAllocateStmt(std::get<parser::Verbatim>(dalloc.t).source, 2086 std::get<parser::OmpObjectList>(dalloc.t), allocateStmt); 2087 } 2088 } 2089 PopContext(); 2090 } 2091 2092 void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) { 2093 const auto &dir{std::get<parser::Verbatim>(x.t)}; 2094 const auto &clauseList{std::get<parser::OmpClauseList>(x.t)}; 2095 for (const auto &clause : clauseList.v) { 2096 if (const auto *alloc{ 2097 std::get_if<parser::OmpClause::Allocate>(&clause.u)}) { 2098 CheckAllNamesInAllocateStmt(dir.source, 2099 std::get<parser::OmpObjectList>(alloc->v.t), 2100 std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement); 2101 2102 auto &modifiers{OmpGetModifiers(alloc->v)}; 2103 bool hasAllocator{ 2104 OmpGetUniqueModifier<parser::OmpAllocatorSimpleModifier>(modifiers) || 2105 OmpGetUniqueModifier<parser::OmpAllocatorComplexModifier>(modifiers)}; 2106 2107 // TODO: As with allocate directive, exclude the case when a requires 2108 // directive with the dynamic_allocators clause is present in 2109 // the same compilation unit (OMP5.0 2.11.3). 2110 if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && 2111 !hasAllocator) { 2112 context_.Say(x.source, 2113 "ALLOCATORS directives that appear in a TARGET region " 2114 "must specify an allocator"_err_en_US); 2115 } 2116 } 2117 } 2118 PopContext(); 2119 } 2120 2121 static bool IsPrivatizable(const Symbol *sym) { 2122 auto *misc{sym->detailsIf<MiscDetails>()}; 2123 return IsVariableName(*sym) && !IsProcedure(*sym) && !IsNamedConstant(*sym) && 2124 ( // OpenMP 5.2, 5.1.1: Assumed-size arrays are shared 2125 !semantics::IsAssumedSizeArray(*sym) || 2126 // If CrayPointer is among the DSA list then the 2127 // CrayPointee is Privatizable 2128 sym->test(Symbol::Flag::CrayPointee)) && 2129 !sym->owner().IsDerivedType() && 2130 sym->owner().kind() != Scope::Kind::ImpliedDos && 2131 sym->owner().kind() != Scope::Kind::Forall && 2132 !sym->detailsIf<semantics::AssocEntityDetails>() && 2133 !sym->detailsIf<semantics::NamelistDetails>() && 2134 (!misc || 2135 (misc->kind() != MiscDetails::Kind::ComplexPartRe && 2136 misc->kind() != MiscDetails::Kind::ComplexPartIm && 2137 misc->kind() != MiscDetails::Kind::KindParamInquiry && 2138 misc->kind() != MiscDetails::Kind::LenParamInquiry && 2139 misc->kind() != MiscDetails::Kind::ConstructName)); 2140 } 2141 2142 void OmpAttributeVisitor::CreateImplicitSymbols( 2143 const Symbol *symbol, std::optional<Symbol::Flag> setFlag) { 2144 if (!IsPrivatizable(symbol)) { 2145 return; 2146 } 2147 2148 // Implicitly determined DSAs 2149 // OMP 5.2 5.1.1 - Variables Referenced in a Construct 2150 Symbol *lastDeclSymbol = nullptr; 2151 std::optional<Symbol::Flag> prevDSA; 2152 for (int dirDepth{0}; dirDepth < (int)dirContext_.size(); ++dirDepth) { 2153 DirContext &dirContext = dirContext_[dirDepth]; 2154 std::optional<Symbol::Flag> dsa; 2155 2156 for (auto symMap : dirContext.objectWithDSA) { 2157 // if the `symbol` already has a data-sharing attribute 2158 if (symMap.first->name() == symbol->name()) { 2159 dsa = symMap.second; 2160 break; 2161 } 2162 } 2163 2164 // When handling each implicit rule for a given symbol, one of the 2165 // following 3 actions may be taken: 2166 // 1. Declare a new private symbol. 2167 // 2. Create a new association symbol with no flags, that will represent 2168 // a shared symbol in the current scope. Note that symbols without 2169 // any private flags are considered as shared. 2170 // 3. Use the last declared private symbol, by inserting a new symbol 2171 // in the scope being processed, associated with it. 2172 // If no private symbol was declared previously, then no association 2173 // is needed and the symbol from the enclosing scope will be 2174 // inherited by the current one. 2175 // 2176 // Because of how symbols are collected in lowering, not inserting a new 2177 // symbol in the last case could lead to the conclusion that a symbol 2178 // from an enclosing construct was declared in the current construct, 2179 // which would result in wrong privatization code being generated. 2180 // Consider the following example: 2181 // 2182 // !$omp parallel default(private) ! p1 2183 // !$omp parallel default(private) shared(x) ! p2 2184 // x = 10 2185 // !$omp end parallel 2186 // !$omp end parallel 2187 // 2188 // If a new x symbol was not inserted in the inner parallel construct 2189 // (p2), it would use the x symbol definition from the enclosing scope. 2190 // Then, when p2's default symbols were collected in lowering, the x 2191 // symbol from the outer parallel construct (p1) would be collected, as 2192 // it would have the private flag set. 2193 // This would make x appear to be defined in p2, causing it to be 2194 // privatized in p2 and its privatization in p1 to be skipped. 2195 auto makePrivateSymbol = [&](Symbol::Flag flag) { 2196 const Symbol *hostSymbol = 2197 lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate(); 2198 lastDeclSymbol = DeclareNewPrivateAccessEntity( 2199 *hostSymbol, flag, context_.FindScope(dirContext.directiveSource)); 2200 if (setFlag) { 2201 lastDeclSymbol->set(*setFlag); 2202 } 2203 return lastDeclSymbol; 2204 }; 2205 auto makeSharedSymbol = [&](std::optional<Symbol::Flag> flag = {}) { 2206 const Symbol *hostSymbol = 2207 lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate(); 2208 Symbol &assocSymbol = MakeAssocSymbol(symbol->name(), *hostSymbol, 2209 context_.FindScope(dirContext.directiveSource)); 2210 if (flag) { 2211 assocSymbol.set(*flag); 2212 } 2213 }; 2214 auto useLastDeclSymbol = [&]() { 2215 if (lastDeclSymbol) { 2216 makeSharedSymbol(); 2217 } 2218 }; 2219 2220 bool taskGenDir = llvm::omp::taskGeneratingSet.test(dirContext.directive); 2221 bool targetDir = llvm::omp::allTargetSet.test(dirContext.directive); 2222 bool parallelDir = llvm::omp::allParallelSet.test(dirContext.directive); 2223 bool teamsDir = llvm::omp::allTeamsSet.test(dirContext.directive); 2224 2225 if (dsa.has_value()) { 2226 if (dsa.value() == Symbol::Flag::OmpShared && 2227 (parallelDir || taskGenDir || teamsDir)) { 2228 makeSharedSymbol(Symbol::Flag::OmpShared); 2229 } 2230 // Private symbols will have been declared already. 2231 prevDSA = dsa; 2232 continue; 2233 } 2234 2235 if (dirContext.defaultDSA == Symbol::Flag::OmpPrivate || 2236 dirContext.defaultDSA == Symbol::Flag::OmpFirstPrivate || 2237 dirContext.defaultDSA == Symbol::Flag::OmpShared) { 2238 // 1) default 2239 // Allowed only with parallel, teams and task generating constructs. 2240 if (!parallelDir && !taskGenDir && !teamsDir) { 2241 return; 2242 } 2243 if (dirContext.defaultDSA != Symbol::Flag::OmpShared) { 2244 makePrivateSymbol(dirContext.defaultDSA); 2245 } else { 2246 makeSharedSymbol(); 2247 } 2248 dsa = dirContext.defaultDSA; 2249 } else if (parallelDir) { 2250 // 2) parallel -> shared 2251 makeSharedSymbol(); 2252 dsa = Symbol::Flag::OmpShared; 2253 } else if (!taskGenDir && !targetDir) { 2254 // 3) enclosing context 2255 useLastDeclSymbol(); 2256 dsa = prevDSA; 2257 } else if (targetDir) { 2258 // TODO 4) not mapped target variable -> firstprivate 2259 dsa = prevDSA; 2260 } else if (taskGenDir) { 2261 // TODO 5) dummy arg in orphaned taskgen construct -> firstprivate 2262 if (prevDSA == Symbol::Flag::OmpShared) { 2263 // 6) shared in enclosing context -> shared 2264 makeSharedSymbol(); 2265 dsa = Symbol::Flag::OmpShared; 2266 } else { 2267 // 7) firstprivate 2268 dsa = Symbol::Flag::OmpFirstPrivate; 2269 makePrivateSymbol(*dsa)->set(Symbol::Flag::OmpImplicit); 2270 } 2271 } 2272 prevDSA = dsa; 2273 } 2274 } 2275 2276 // For OpenMP constructs, check all the data-refs within the constructs 2277 // and adjust the symbol for each Name if necessary 2278 void OmpAttributeVisitor::Post(const parser::Name &name) { 2279 auto *symbol{name.symbol}; 2280 2281 if (symbol && !dirContext_.empty() && GetContext().withinConstruct) { 2282 if (IsPrivatizable(symbol) && !IsObjectWithDSA(*symbol)) { 2283 // TODO: create a separate function to go through the rules for 2284 // predetermined, explicitly determined, and implicitly 2285 // determined data-sharing attributes (2.15.1.1). 2286 if (Symbol * found{currScope().FindSymbol(name.source)}) { 2287 if (symbol != found) { 2288 name.symbol = found; // adjust the symbol within region 2289 } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone && 2290 !symbol->test(Symbol::Flag::OmpThreadprivate) && 2291 // Exclude indices of sequential loops that are privatised in 2292 // the scope of the parallel region, and not in this scope. 2293 // TODO: check whether this should be caught in IsObjectWithDSA 2294 !symbol->test(Symbol::Flag::OmpPrivate)) { 2295 if (symbol->test(Symbol::Flag::CrayPointee)) { 2296 std::string crayPtrName{ 2297 semantics::GetCrayPointer(*symbol).name().ToString()}; 2298 if (!IsObjectWithDSA(*currScope().FindSymbol(crayPtrName))) 2299 context_.Say(name.source, 2300 "The DEFAULT(NONE) clause requires that the Cray Pointer '%s' must be listed in a data-sharing attribute clause"_err_en_US, 2301 crayPtrName); 2302 } else { 2303 context_.Say(name.source, 2304 "The DEFAULT(NONE) clause requires that '%s' must be listed in a data-sharing attribute clause"_err_en_US, 2305 symbol->name()); 2306 } 2307 } 2308 } 2309 } 2310 2311 if (Symbol * found{currScope().FindSymbol(name.source)}) { 2312 if (found->test(semantics::Symbol::Flag::OmpThreadprivate)) 2313 return; 2314 } 2315 2316 CreateImplicitSymbols(symbol); 2317 } // within OpenMP construct 2318 } 2319 2320 Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) { 2321 if (auto *resolvedSymbol{ 2322 name ? GetContext().scope.FindSymbol(name->source) : nullptr}) { 2323 name->symbol = resolvedSymbol; 2324 return resolvedSymbol; 2325 } else { 2326 return nullptr; 2327 } 2328 } 2329 2330 void OmpAttributeVisitor::ResolveOmpName( 2331 const parser::Name &name, Symbol::Flag ompFlag) { 2332 if (ResolveName(&name)) { 2333 if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) { 2334 if (dataSharingAttributeFlags.test(ompFlag)) { 2335 AddToContextObjectWithDSA(*resolvedSymbol, ompFlag); 2336 } 2337 } 2338 } else if (ompFlag == Symbol::Flag::OmpCriticalLock) { 2339 const auto pair{ 2340 GetContext().scope.try_emplace(name.source, Attrs{}, UnknownDetails{})}; 2341 CHECK(pair.second); 2342 name.symbol = &pair.first->second.get(); 2343 } 2344 } 2345 2346 void OmpAttributeVisitor::ResolveOmpNameList( 2347 const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) { 2348 for (const auto &name : nameList) { 2349 ResolveOmpName(name, ompFlag); 2350 } 2351 } 2352 2353 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName( 2354 const parser::Name *name) { 2355 if (!name) { 2356 return nullptr; 2357 } 2358 if (auto *cb{GetProgramUnitOrBlockConstructContaining(GetContext().scope) 2359 .FindCommonBlock(name->source)}) { 2360 name->symbol = cb; 2361 return cb; 2362 } 2363 return nullptr; 2364 } 2365 2366 // Use this function over ResolveOmpName when an omp object's scope needs 2367 // resolving, it's symbol flag isn't important and a simple check for resolution 2368 // failure is desired. Using ResolveOmpName means needing to work with the 2369 // context to check for failure, whereas here a pointer comparison is all that's 2370 // needed. 2371 Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) { 2372 2373 // TODO: Investigate whether the following block can be replaced by, or 2374 // included in, the ResolveOmpName function 2375 if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source) 2376 : nullptr}) { 2377 name->symbol = prev; 2378 return nullptr; 2379 } 2380 2381 // TODO: Investigate whether the following block can be replaced by, or 2382 // included in, the ResolveOmpName function 2383 if (auto *ompSymbol{ 2384 name ? GetContext().scope.FindSymbol(name->source) : nullptr}) { 2385 name->symbol = ompSymbol; 2386 return ompSymbol; 2387 } 2388 return nullptr; 2389 } 2390 2391 void OmpAttributeVisitor::ResolveOmpObjectList( 2392 const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) { 2393 for (const auto &ompObject : ompObjectList.v) { 2394 ResolveOmpObject(ompObject, ompFlag); 2395 } 2396 } 2397 2398 void OmpAttributeVisitor::ResolveOmpObject( 2399 const parser::OmpObject &ompObject, Symbol::Flag ompFlag) { 2400 common::visit( 2401 common::visitors{ 2402 [&](const parser::Designator &designator) { 2403 if (const auto *name{ 2404 semantics::getDesignatorNameIfDataRef(designator)}) { 2405 if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) { 2406 auto checkExclusivelists = 2407 [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag, 2408 const Symbol *symbol2, Symbol::Flag secondOmpFlag) { 2409 if ((symbol1->test(firstOmpFlag) && 2410 symbol2->test(secondOmpFlag)) || 2411 (symbol1->test(secondOmpFlag) && 2412 symbol2->test(firstOmpFlag))) { 2413 context_.Say(designator.source, 2414 "Variable '%s' may not " 2415 "appear on both %s and %s " 2416 "clauses on a %s construct"_err_en_US, 2417 symbol2->name(), 2418 Symbol::OmpFlagToClauseName(firstOmpFlag), 2419 Symbol::OmpFlagToClauseName(secondOmpFlag), 2420 parser::ToUpperCaseLetters( 2421 llvm::omp::getOpenMPDirectiveName( 2422 GetContext().directive) 2423 .str())); 2424 } 2425 }; 2426 if (dataCopyingAttributeFlags.test(ompFlag)) { 2427 CheckDataCopyingClause(*name, *symbol, ompFlag); 2428 } else { 2429 AddToContextObjectWithDSA(*symbol, ompFlag); 2430 if (dataSharingAttributeFlags.test(ompFlag)) { 2431 CheckMultipleAppearances(*name, *symbol, ompFlag); 2432 } 2433 if (privateDataSharingAttributeFlags.test(ompFlag)) { 2434 CheckObjectIsPrivatizable(*name, *symbol, ompFlag); 2435 } 2436 2437 if (ompFlag == Symbol::Flag::OmpAllocate) { 2438 AddAllocateName(name); 2439 } 2440 } 2441 if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective && 2442 IsAllocatable(*symbol) && 2443 !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) { 2444 context_.Say(designator.source, 2445 "List items specified in the ALLOCATE directive must not " 2446 "have the ALLOCATABLE attribute unless the directive is " 2447 "associated with an ALLOCATE statement"_err_en_US); 2448 } 2449 if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective || 2450 ompFlag == 2451 Symbol::Flag::OmpExecutableAllocateDirective) && 2452 ResolveOmpObjectScope(name) == nullptr) { 2453 context_.Say(designator.source, // 2.15.3 2454 "List items must be declared in the same scoping unit " 2455 "in which the %s directive appears"_err_en_US, 2456 parser::ToUpperCaseLetters( 2457 llvm::omp::getOpenMPDirectiveName( 2458 GetContext().directive) 2459 .str())); 2460 } 2461 if (ompFlag == Symbol::Flag::OmpReduction) { 2462 const Symbol &ultimateSymbol{symbol->GetUltimate()}; 2463 // Using variables inside of a namelist in OpenMP reductions 2464 // is allowed by the standard, but is not allowed for 2465 // privatisation. This looks like an oversight. If the 2466 // namelist is hoisted to a global, we cannot apply the 2467 // mapping for the reduction variable: resulting in incorrect 2468 // results. Disabling this hoisting could make some real 2469 // production code go slower. See discussion in #109303 2470 if (ultimateSymbol.test(Symbol::Flag::InNamelist)) { 2471 context_.Say(name->source, 2472 "Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US, 2473 name->ToString()); 2474 } 2475 } 2476 if (ompFlag == Symbol::Flag::OmpInclusiveScan || 2477 ompFlag == Symbol::Flag::OmpExclusiveScan) { 2478 if (!symbol->test(Symbol::Flag::OmpInScanReduction)) { 2479 context_.Say(name->source, 2480 "List item %s must appear in REDUCTION clause " 2481 "with the INSCAN modifier of the parent " 2482 "directive"_err_en_US, 2483 name->ToString()); 2484 } 2485 } 2486 if (GetContext().directive == 2487 llvm::omp::Directive::OMPD_target_data) { 2488 checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr, 2489 symbol, Symbol::Flag::OmpUseDeviceAddr); 2490 } 2491 if (llvm::omp::allDistributeSet.test(GetContext().directive)) { 2492 checkExclusivelists(symbol, Symbol::Flag::OmpFirstPrivate, 2493 symbol, Symbol::Flag::OmpLastPrivate); 2494 } 2495 if (llvm::omp::allTargetSet.test(GetContext().directive)) { 2496 checkExclusivelists(symbol, Symbol::Flag::OmpIsDevicePtr, 2497 symbol, Symbol::Flag::OmpHasDeviceAddr); 2498 const auto *hostAssocSym{symbol}; 2499 if (!(symbol->test(Symbol::Flag::OmpIsDevicePtr) || 2500 symbol->test(Symbol::Flag::OmpHasDeviceAddr))) { 2501 if (const auto *details{ 2502 symbol->detailsIf<HostAssocDetails>()}) { 2503 hostAssocSym = &details->symbol(); 2504 } 2505 } 2506 Symbol::Flag dataMappingAttributeFlags[] = { 2507 Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom, 2508 Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapAlloc, 2509 Symbol::Flag::OmpMapRelease, Symbol::Flag::OmpMapDelete, 2510 Symbol::Flag::OmpIsDevicePtr, 2511 Symbol::Flag::OmpHasDeviceAddr}; 2512 2513 Symbol::Flag dataSharingAttributeFlags[] = { 2514 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate, 2515 Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared, 2516 Symbol::Flag::OmpLinear}; 2517 2518 // For OMP TARGET TEAMS directive some sharing attribute 2519 // flags and mapping attribute flags can co-exist. 2520 if (!(llvm::omp::allTeamsSet.test(GetContext().directive) || 2521 llvm::omp::allParallelSet.test( 2522 GetContext().directive))) { 2523 for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) { 2524 for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) { 2525 checkExclusivelists( 2526 hostAssocSym, ompFlag1, symbol, ompFlag2); 2527 } 2528 } 2529 } 2530 } 2531 } 2532 } else { 2533 // Array sections to be changed to substrings as needed 2534 if (AnalyzeExpr(context_, designator)) { 2535 if (std::holds_alternative<parser::Substring>(designator.u)) { 2536 context_.Say(designator.source, 2537 "Substrings are not allowed on OpenMP " 2538 "directives or clauses"_err_en_US); 2539 } 2540 } 2541 // other checks, more TBD 2542 } 2543 }, 2544 [&](const parser::Name &name) { // common block 2545 if (auto *symbol{ResolveOmpCommonBlockName(&name)}) { 2546 if (!dataCopyingAttributeFlags.test(ompFlag)) { 2547 CheckMultipleAppearances( 2548 name, *symbol, Symbol::Flag::OmpCommonBlock); 2549 } 2550 // 2.15.3 When a named common block appears in a list, it has the 2551 // same meaning as if every explicit member of the common block 2552 // appeared in the list 2553 auto &details{symbol->get<CommonBlockDetails>()}; 2554 unsigned index{0}; 2555 for (auto &object : details.objects()) { 2556 if (auto *resolvedObject{ 2557 ResolveOmp(*object, ompFlag, currScope())}) { 2558 if (dataCopyingAttributeFlags.test(ompFlag)) { 2559 CheckDataCopyingClause(name, *resolvedObject, ompFlag); 2560 } else { 2561 AddToContextObjectWithDSA(*resolvedObject, ompFlag); 2562 } 2563 details.replace_object(*resolvedObject, index); 2564 } 2565 index++; 2566 } 2567 } else { 2568 context_.Say(name.source, // 2.15.3 2569 "COMMON block must be declared in the same scoping unit " 2570 "in which the OpenMP directive or clause appears"_err_en_US); 2571 } 2572 }, 2573 }, 2574 ompObject.u); 2575 } 2576 2577 Symbol *OmpAttributeVisitor::ResolveOmp( 2578 const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) { 2579 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 2580 return DeclarePrivateAccessEntity(name, ompFlag, scope); 2581 } else { 2582 return DeclareOrMarkOtherAccessEntity(name, ompFlag); 2583 } 2584 } 2585 2586 Symbol *OmpAttributeVisitor::ResolveOmp( 2587 Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) { 2588 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 2589 return DeclarePrivateAccessEntity(symbol, ompFlag, scope); 2590 } else { 2591 return DeclareOrMarkOtherAccessEntity(symbol, ompFlag); 2592 } 2593 } 2594 2595 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity( 2596 const parser::Name &name, Symbol::Flag ompFlag) { 2597 Symbol *prev{currScope().FindSymbol(name.source)}; 2598 if (!name.symbol || !prev) { 2599 return nullptr; 2600 } else if (prev != name.symbol) { 2601 name.symbol = prev; 2602 } 2603 return DeclareOrMarkOtherAccessEntity(*prev, ompFlag); 2604 } 2605 2606 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity( 2607 Symbol &object, Symbol::Flag ompFlag) { 2608 if (ompFlagsRequireMark.test(ompFlag)) { 2609 object.set(ompFlag); 2610 } 2611 return &object; 2612 } 2613 2614 static bool WithMultipleAppearancesOmpException( 2615 const Symbol &symbol, Symbol::Flag flag) { 2616 return (flag == Symbol::Flag::OmpFirstPrivate && 2617 symbol.test(Symbol::Flag::OmpLastPrivate)) || 2618 (flag == Symbol::Flag::OmpLastPrivate && 2619 symbol.test(Symbol::Flag::OmpFirstPrivate)); 2620 } 2621 2622 void OmpAttributeVisitor::CheckMultipleAppearances( 2623 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 2624 const auto *target{&symbol}; 2625 if (ompFlagsRequireNewSymbol.test(ompFlag)) { 2626 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 2627 target = &details->symbol(); 2628 } 2629 } 2630 if (HasDataSharingAttributeObject(target->GetUltimate()) && 2631 !WithMultipleAppearancesOmpException(symbol, ompFlag)) { 2632 context_.Say(name.source, 2633 "'%s' appears in more than one data-sharing clause " 2634 "on the same OpenMP directive"_err_en_US, 2635 name.ToString()); 2636 } else { 2637 AddDataSharingAttributeObject(target->GetUltimate()); 2638 if (privateDataSharingAttributeFlags.test(ompFlag)) { 2639 AddPrivateDataSharingAttributeObjects(*target); 2640 } 2641 } 2642 } 2643 2644 void ResolveAccParts(SemanticsContext &context, const parser::ProgramUnit &node, 2645 Scope *topScope) { 2646 if (context.IsEnabled(common::LanguageFeature::OpenACC)) { 2647 AccAttributeVisitor{context, topScope}.Walk(node); 2648 } 2649 } 2650 2651 void ResolveOmpParts( 2652 SemanticsContext &context, const parser::ProgramUnit &node) { 2653 if (context.IsEnabled(common::LanguageFeature::OpenMP)) { 2654 OmpAttributeVisitor{context}.Walk(node); 2655 if (!context.AnyFatalError()) { 2656 // The data-sharing attribute of the loop iteration variable for a 2657 // sequential loop (2.15.1.1) can only be determined when visiting 2658 // the corresponding DoConstruct, a second walk is to adjust the 2659 // symbols for all the data-refs of that loop iteration variable 2660 // prior to the DoConstruct. 2661 OmpAttributeVisitor{context}.Walk(node); 2662 } 2663 } 2664 } 2665 2666 void ResolveOmpTopLevelParts( 2667 SemanticsContext &context, const parser::Program &program) { 2668 if (!context.IsEnabled(common::LanguageFeature::OpenMP)) { 2669 return; 2670 } 2671 2672 // Gather REQUIRES clauses from all non-module top-level program unit symbols, 2673 // combine them together ensuring compatibility and apply them to all these 2674 // program units. Modules are skipped because their REQUIRES clauses should be 2675 // propagated via USE statements instead. 2676 WithOmpDeclarative::RequiresFlags combinedFlags; 2677 std::optional<common::OmpAtomicDefaultMemOrderType> combinedMemOrder; 2678 2679 // Function to go through non-module top level program units and extract 2680 // REQUIRES information to be processed by a function-like argument. 2681 auto processProgramUnits{[&](auto processFn) { 2682 for (const parser::ProgramUnit &unit : program.v) { 2683 if (!std::holds_alternative<common::Indirection<parser::Module>>( 2684 unit.u) && 2685 !std::holds_alternative<common::Indirection<parser::Submodule>>( 2686 unit.u) && 2687 !std::holds_alternative< 2688 common::Indirection<parser::CompilerDirective>>(unit.u)) { 2689 Symbol *symbol{common::visit( 2690 [&context](auto &x) { 2691 Scope *scope = GetScope(context, x.value()); 2692 return scope ? scope->symbol() : nullptr; 2693 }, 2694 unit.u)}; 2695 // FIXME There is no symbol defined for MainProgram units in certain 2696 // circumstances, so REQUIRES information has no place to be stored in 2697 // these cases. 2698 if (!symbol) { 2699 continue; 2700 } 2701 common::visit( 2702 [&](auto &details) { 2703 if constexpr (std::is_convertible_v<decltype(&details), 2704 WithOmpDeclarative *>) { 2705 processFn(*symbol, details); 2706 } 2707 }, 2708 symbol->details()); 2709 } 2710 } 2711 }}; 2712 2713 // Combine global REQUIRES information from all program units except modules 2714 // and submodules. 2715 processProgramUnits([&](Symbol &symbol, WithOmpDeclarative &details) { 2716 if (const WithOmpDeclarative::RequiresFlags * 2717 flags{details.ompRequires()}) { 2718 combinedFlags |= *flags; 2719 } 2720 if (const common::OmpAtomicDefaultMemOrderType * 2721 memOrder{details.ompAtomicDefaultMemOrder()}) { 2722 if (combinedMemOrder && *combinedMemOrder != *memOrder) { 2723 context.Say(symbol.scope()->sourceRange(), 2724 "Conflicting '%s' REQUIRES clauses found in compilation " 2725 "unit"_err_en_US, 2726 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName( 2727 llvm::omp::Clause::OMPC_atomic_default_mem_order) 2728 .str())); 2729 } 2730 combinedMemOrder = *memOrder; 2731 } 2732 }); 2733 2734 // Update all program units except modules and submodules with the combined 2735 // global REQUIRES information. 2736 processProgramUnits([&](Symbol &, WithOmpDeclarative &details) { 2737 if (combinedFlags.any()) { 2738 details.set_ompRequires(combinedFlags); 2739 } 2740 if (combinedMemOrder) { 2741 details.set_ompAtomicDefaultMemOrder(*combinedMemOrder); 2742 } 2743 }); 2744 } 2745 2746 static bool IsSymbolInCommonBlock(const Symbol &symbol) { 2747 // TODO Improve the performance of this predicate function. 2748 // Going through all symbols sequentially, in all common blocks, can be 2749 // slow when there are many symbols. A possible optimization is to add 2750 // an OmpInCommonBlock flag to Symbol, to make it possible to quickly 2751 // test if a given symbol is in a common block. 2752 for (const auto &cb : symbol.owner().commonBlocks()) { 2753 if (IsCommonBlockContaining(cb.second.get(), symbol)) { 2754 return true; 2755 } 2756 } 2757 return false; 2758 } 2759 2760 static bool IsSymbolThreadprivate(const Symbol &symbol) { 2761 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) { 2762 return details->symbol().test(Symbol::Flag::OmpThreadprivate); 2763 } 2764 return symbol.test(Symbol::Flag::OmpThreadprivate); 2765 } 2766 2767 static bool IsSymbolPrivate(const Symbol &symbol) { 2768 if (symbol.test(Symbol::Flag::OmpPrivate) || 2769 symbol.test(Symbol::Flag::OmpFirstPrivate)) { 2770 return true; 2771 } 2772 // A symbol that has not gone through constructs that may privatize the 2773 // original symbol may be predetermined as private. 2774 // (OMP 5.2 5.1.1 - Variables Referenced in a Construct) 2775 if (symbol == symbol.GetUltimate()) { 2776 switch (symbol.owner().kind()) { 2777 case Scope::Kind::MainProgram: 2778 case Scope::Kind::Subprogram: 2779 case Scope::Kind::BlockConstruct: 2780 return !symbol.attrs().test(Attr::SAVE) && 2781 !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) && 2782 !IsSymbolInCommonBlock(symbol); 2783 default: 2784 return false; 2785 } 2786 } 2787 return false; 2788 } 2789 2790 void OmpAttributeVisitor::CheckDataCopyingClause( 2791 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 2792 if (ompFlag == Symbol::Flag::OmpCopyIn) { 2793 // List of items/objects that can appear in a 'copyin' clause must be 2794 // 'threadprivate' 2795 if (!IsSymbolThreadprivate(symbol)) { 2796 context_.Say(name.source, 2797 "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US, 2798 symbol.name()); 2799 } 2800 } else if (ompFlag == Symbol::Flag::OmpCopyPrivate && 2801 GetContext().directive == llvm::omp::Directive::OMPD_single) { 2802 // A list item that appears in a 'copyprivate' clause may not appear on a 2803 // 'private' or 'firstprivate' clause on a single construct 2804 if (IsObjectWithDSA(symbol) && 2805 (symbol.test(Symbol::Flag::OmpPrivate) || 2806 symbol.test(Symbol::Flag::OmpFirstPrivate))) { 2807 context_.Say(name.source, 2808 "COPYPRIVATE variable '%s' may not appear on a PRIVATE or " 2809 "FIRSTPRIVATE clause on a SINGLE construct"_err_en_US, 2810 symbol.name()); 2811 } else if (!IsSymbolThreadprivate(symbol) && !IsSymbolPrivate(symbol)) { 2812 // List of items/objects that can appear in a 'copyprivate' clause must be 2813 // either 'private' or 'threadprivate' in enclosing context. 2814 context_.Say(name.source, 2815 "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in " 2816 "outer context"_err_en_US, 2817 symbol.name()); 2818 } 2819 } 2820 } 2821 2822 void OmpAttributeVisitor::CheckObjectIsPrivatizable( 2823 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { 2824 const auto &ultimateSymbol{symbol.GetUltimate()}; 2825 llvm::StringRef clauseName{"PRIVATE"}; 2826 if (ompFlag == Symbol::Flag::OmpFirstPrivate) { 2827 clauseName = "FIRSTPRIVATE"; 2828 } else if (ompFlag == Symbol::Flag::OmpLastPrivate) { 2829 clauseName = "LASTPRIVATE"; 2830 } 2831 2832 if (ultimateSymbol.test(Symbol::Flag::InNamelist)) { 2833 context_.Say(name.source, 2834 "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US, 2835 name.ToString(), clauseName.str()); 2836 } 2837 2838 if (ultimateSymbol.has<AssocEntityDetails>()) { 2839 context_.Say(name.source, 2840 "Variable '%s' in ASSOCIATE cannot be in a %s clause"_err_en_US, 2841 name.ToString(), clauseName.str()); 2842 } 2843 2844 if (stmtFunctionExprSymbols_.find(ultimateSymbol) != 2845 stmtFunctionExprSymbols_.end()) { 2846 context_.Say(name.source, 2847 "Variable '%s' in statement function expression cannot be in a " 2848 "%s clause"_err_en_US, 2849 name.ToString(), clauseName.str()); 2850 } 2851 } 2852 2853 void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) { 2854 // Get the context to check if the statement causing a jump to the 'label' is 2855 // in an enclosing OpenMP construct 2856 std::optional<DirContext> thisContext{GetContextIf()}; 2857 sourceLabels_.emplace( 2858 label, std::make_pair(currentStatementSource_, thisContext)); 2859 // Check if the statement with 'label' to which a jump is being introduced 2860 // has already been encountered 2861 auto it{targetLabels_.find(label)}; 2862 if (it != targetLabels_.end()) { 2863 // Check if both the statement with 'label' and the statement that causes a 2864 // jump to the 'label' are in the same scope 2865 CheckLabelContext(currentStatementSource_, it->second.first, thisContext, 2866 it->second.second); 2867 } 2868 } 2869 2870 // Check for invalid branch into or out of OpenMP structured blocks 2871 void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source, 2872 const parser::CharBlock target, std::optional<DirContext> sourceContext, 2873 std::optional<DirContext> targetContext) { 2874 if (targetContext && 2875 (!sourceContext || 2876 (sourceContext->scope != targetContext->scope && 2877 !DoesScopeContain( 2878 &targetContext->scope, sourceContext->scope)))) { 2879 context_ 2880 .Say(source, "invalid branch into an OpenMP structured block"_err_en_US) 2881 .Attach(target, "In the enclosing %s directive branched into"_en_US, 2882 parser::ToUpperCaseLetters( 2883 llvm::omp::getOpenMPDirectiveName(targetContext->directive) 2884 .str())); 2885 } 2886 if (sourceContext && 2887 (!targetContext || 2888 (sourceContext->scope != targetContext->scope && 2889 !DoesScopeContain( 2890 &sourceContext->scope, targetContext->scope)))) { 2891 context_ 2892 .Say(source, 2893 "invalid branch leaving an OpenMP structured block"_err_en_US) 2894 .Attach(target, "Outside the enclosing %s directive"_en_US, 2895 parser::ToUpperCaseLetters( 2896 llvm::omp::getOpenMPDirectiveName(sourceContext->directive) 2897 .str())); 2898 } 2899 } 2900 2901 // Goes through the names in an OmpObjectList and checks if each name appears 2902 // in the given allocate statement 2903 void OmpAttributeVisitor::CheckAllNamesInAllocateStmt( 2904 const parser::CharBlock &source, const parser::OmpObjectList &ompObjectList, 2905 const parser::AllocateStmt &allocate) { 2906 for (const auto &obj : ompObjectList.v) { 2907 if (const auto *d{std::get_if<parser::Designator>(&obj.u)}) { 2908 if (const auto *ref{std::get_if<parser::DataRef>(&d->u)}) { 2909 if (const auto *n{std::get_if<parser::Name>(&ref->u)}) { 2910 CheckNameInAllocateStmt(source, *n, allocate); 2911 } 2912 } 2913 } 2914 } 2915 } 2916 2917 void OmpAttributeVisitor::CheckNameInAllocateStmt( 2918 const parser::CharBlock &source, const parser::Name &name, 2919 const parser::AllocateStmt &allocate) { 2920 for (const auto &allocation : 2921 std::get<std::list<parser::Allocation>>(allocate.t)) { 2922 const auto &allocObj = std::get<parser::AllocateObject>(allocation.t); 2923 if (const auto *n{std::get_if<parser::Name>(&allocObj.u)}) { 2924 if (n->source == name.source) { 2925 return; 2926 } 2927 } 2928 } 2929 context_.Say(source, 2930 "Object '%s' in %s directive not " 2931 "found in corresponding ALLOCATE statement"_err_en_US, 2932 name.ToString(), 2933 parser::ToUpperCaseLetters( 2934 llvm::omp::getOpenMPDirectiveName(GetContext().directive).str())); 2935 } 2936 2937 void OmpAttributeVisitor::AddOmpRequiresToScope(Scope &scope, 2938 WithOmpDeclarative::RequiresFlags flags, 2939 std::optional<common::OmpAtomicDefaultMemOrderType> memOrder) { 2940 Scope *scopeIter = &scope; 2941 do { 2942 if (Symbol * symbol{scopeIter->symbol()}) { 2943 common::visit( 2944 [&](auto &details) { 2945 // Store clauses information into the symbol for the parent and 2946 // enclosing modules, programs, functions and subroutines. 2947 if constexpr (std::is_convertible_v<decltype(&details), 2948 WithOmpDeclarative *>) { 2949 if (flags.any()) { 2950 if (const WithOmpDeclarative::RequiresFlags * 2951 otherFlags{details.ompRequires()}) { 2952 flags |= *otherFlags; 2953 } 2954 details.set_ompRequires(flags); 2955 } 2956 if (memOrder) { 2957 if (details.has_ompAtomicDefaultMemOrder() && 2958 *details.ompAtomicDefaultMemOrder() != *memOrder) { 2959 context_.Say(scopeIter->sourceRange(), 2960 "Conflicting '%s' REQUIRES clauses found in compilation " 2961 "unit"_err_en_US, 2962 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName( 2963 llvm::omp::Clause::OMPC_atomic_default_mem_order) 2964 .str())); 2965 } 2966 details.set_ompAtomicDefaultMemOrder(*memOrder); 2967 } 2968 } 2969 }, 2970 symbol->details()); 2971 } 2972 scopeIter = &scopeIter->parent(); 2973 } while (!scopeIter->IsGlobal()); 2974 } 2975 2976 void OmpAttributeVisitor::IssueNonConformanceWarning( 2977 llvm::omp::Directive D, parser::CharBlock source) { 2978 std::string warnStr; 2979 llvm::raw_string_ostream warnStrOS(warnStr); 2980 warnStrOS << "OpenMP directive " 2981 << parser::ToUpperCaseLetters( 2982 llvm::omp::getOpenMPDirectiveName(D).str()) 2983 << " has been deprecated"; 2984 2985 auto setAlternativeStr = [&warnStrOS](llvm::StringRef alt) { 2986 warnStrOS << ", please use " << alt << " instead."; 2987 }; 2988 switch (D) { 2989 case llvm::omp::OMPD_master: 2990 setAlternativeStr("MASKED"); 2991 break; 2992 case llvm::omp::OMPD_master_taskloop: 2993 setAlternativeStr("MASKED TASKLOOP"); 2994 break; 2995 case llvm::omp::OMPD_master_taskloop_simd: 2996 setAlternativeStr("MASKED TASKLOOP SIMD"); 2997 break; 2998 case llvm::omp::OMPD_parallel_master: 2999 setAlternativeStr("PARALLEL MASKED"); 3000 break; 3001 case llvm::omp::OMPD_parallel_master_taskloop: 3002 setAlternativeStr("PARALLEL MASKED TASKLOOP"); 3003 break; 3004 case llvm::omp::OMPD_parallel_master_taskloop_simd: 3005 setAlternativeStr("PARALLEL_MASKED TASKLOOP SIMD"); 3006 break; 3007 case llvm::omp::OMPD_target_loop: 3008 default:; 3009 } 3010 context_.Warn(common::UsageWarning::OpenMPUsage, source, "%s"_warn_en_US, 3011 warnStrOS.str()); 3012 } 3013 } // namespace Fortran::semantics 3014