3691 lines · cpp
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-exception6//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/openmp-utils.h"19#include "flang/Parser/parse-tree-visitor.h"20#include "flang/Parser/parse-tree.h"21#include "flang/Parser/tools.h"22#include "flang/Semantics/expression.h"23#include "flang/Semantics/openmp-dsa.h"24#include "flang/Semantics/openmp-modifiers.h"25#include "flang/Semantics/openmp-utils.h"26#include "flang/Semantics/symbol.h"27#include "flang/Semantics/tools.h"28#include "flang/Support/Flags.h"29#include "llvm/ADT/StringMap.h"30#include "llvm/ADT/StringRef.h"31#include "llvm/Frontend/OpenMP/OMP.h.inc"32#include "llvm/Support/Debug.h"33#include <list>34#include <map>35 36namespace Fortran::semantics {37 38template <typename T>39static Scope *GetScope(SemanticsContext &context, const T &x) {40 if (auto source{GetLastSource(x)}) {41 return &context.FindScope(*source);42 } else {43 return nullptr;44 }45}46 47template <typename T> class DirectiveAttributeVisitor {48public:49 explicit DirectiveAttributeVisitor(SemanticsContext &context)50 : context_{context} {}51 52 template <typename A> bool Pre(const A &) { return true; }53 template <typename A> void Post(const A &) {}54 55protected:56 struct DirContext {57 DirContext(const parser::CharBlock &source, T d, Scope &s)58 : directiveSource{source}, directive{d}, scope{s} {}59 parser::CharBlock directiveSource;60 T directive;61 Scope &scope;62 Symbol::Flag defaultDSA{Symbol::Flag::AccShared}; // TODOACC63 std::map<const Symbol *, Symbol::Flag> objectWithDSA;64 std::map<parser::OmpVariableCategory::Value,65 parser::OmpDefaultmapClause::ImplicitBehavior>66 defaultMap;67 68 std::optional<Symbol::Flag> FindSymbolWithDSA(const Symbol &symbol) {69 if (auto it{objectWithDSA.find(&symbol)}; it != objectWithDSA.end()) {70 return it->second;71 }72 return std::nullopt;73 }74 75 bool withinConstruct{false};76 std::int64_t associatedLoopLevel{0};77 };78 79 DirContext &GetContext() {80 CHECK(!dirContext_.empty());81 return dirContext_.back();82 }83 std::optional<DirContext> GetContextIf() {84 return dirContext_.empty()85 ? std::nullopt86 : std::make_optional<DirContext>(dirContext_.back());87 }88 void PushContext(const parser::CharBlock &source, T dir, Scope &scope) {89 if constexpr (std::is_same_v<T, llvm::acc::Directive>) {90 dirContext_.emplace_back(source, dir, scope);91 if (std::size_t size{dirContext_.size()}; size > 1) {92 std::size_t lastIndex{size - 1};93 dirContext_[lastIndex].defaultDSA =94 dirContext_[lastIndex - 1].defaultDSA;95 }96 } else {97 dirContext_.emplace_back(source, dir, scope);98 }99 }100 void PushContext(const parser::CharBlock &source, T dir) {101 PushContext(source, dir, context_.FindScope(source));102 }103 void PopContext() { dirContext_.pop_back(); }104 void SetContextDirectiveSource(parser::CharBlock &dir) {105 GetContext().directiveSource = dir;106 }107 Scope &currScope() { return GetContext().scope; }108 void AddContextDefaultmapBehaviour(parser::OmpVariableCategory::Value VarCat,109 parser::OmpDefaultmapClause::ImplicitBehavior ImpBehav) {110 GetContext().defaultMap[VarCat] = ImpBehav;111 }112 void SetContextDefaultDSA(Symbol::Flag flag) {113 GetContext().defaultDSA = flag;114 }115 void AddToContextObjectWithDSA(116 const Symbol &symbol, Symbol::Flag flag, DirContext &context) {117 context.objectWithDSA.emplace(&symbol, flag);118 }119 void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {120 AddToContextObjectWithDSA(symbol, flag, GetContext());121 }122 bool IsObjectWithDSA(const Symbol &symbol) {123 return GetContext().FindSymbolWithDSA(symbol).has_value();124 }125 bool IsObjectWithVisibleDSA(const Symbol &symbol) {126 for (std::size_t i{dirContext_.size()}; i != 0; i--) {127 if (dirContext_[i - 1].FindSymbolWithDSA(symbol).has_value()) {128 return true;129 }130 }131 return false;132 }133 134 bool WithinConstruct() {135 return !dirContext_.empty() && GetContext().withinConstruct;136 }137 138 void SetContextAssociatedLoopLevel(std::int64_t level) {139 GetContext().associatedLoopLevel = level;140 }141 Symbol &MakeAssocSymbol(142 const SourceName &name, const Symbol &prev, Scope &scope) {143 const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};144 return *pair.first->second;145 }146 Symbol &MakeAssocSymbol(const SourceName &name, const Symbol &prev) {147 return MakeAssocSymbol(name, prev, currScope());148 }149 void AddDataSharingAttributeObject(SymbolRef object) {150 dataSharingAttributeObjects_.insert(object);151 }152 void ClearDataSharingAttributeObjects() {153 dataSharingAttributeObjects_.clear();154 }155 bool HasDataSharingAttributeObject(const Symbol &);156 157 /// Extract the iv and bounds of a DO loop:158 /// 1. The loop index/induction variable159 /// 2. The lower bound160 /// 3. The upper bound161 /// 4. The step/increment (or nullptr if not present)162 ///163 /// Each returned tuple value can be nullptr if not present. Diagnoses an164 /// error if the the DO loop is a DO WHILE or DO CONCURRENT loop.165 std::tuple<const parser::Name *, const parser::ScalarExpr *,166 const parser::ScalarExpr *, const parser::ScalarExpr *>167 GetLoopBounds(const parser::DoConstruct &);168 169 /// Extract the loop index/induction variable from a DO loop. Diagnoses an170 /// error if the the DO loop is a DO WHILE or DO CONCURRENT loop and returns171 /// nullptr.172 const parser::Name *GetLoopIndex(const parser::DoConstruct &);173 174 const parser::DoConstruct *GetDoConstructIf(175 const parser::ExecutionPartConstruct &);176 Symbol *DeclareNewAccessEntity(const Symbol &, Symbol::Flag, Scope &);177 Symbol *DeclareAccessEntity(const parser::Name &, Symbol::Flag, Scope &);178 Symbol *DeclareAccessEntity(Symbol &, Symbol::Flag, Scope &);179 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);180 181 UnorderedSymbolSet dataSharingAttributeObjects_; // on one directive182 SemanticsContext &context_;183 std::vector<DirContext> dirContext_; // used as a stack184};185 186class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {187public:188 explicit AccAttributeVisitor(SemanticsContext &context, Scope *topScope)189 : DirectiveAttributeVisitor(context), topScope_(topScope) {}190 191 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }192 template <typename A> bool Pre(const A &) { return true; }193 template <typename A> void Post(const A &) {}194 195 bool Pre(const parser::OpenACCBlockConstruct &);196 void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }197 bool Pre(const parser::OpenACCCombinedConstruct &);198 void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }199 void Post(const parser::AccBeginCombinedDirective &) {200 GetContext().withinConstruct = true;201 }202 203 bool Pre(const parser::OpenACCDeclarativeConstruct &);204 void Post(const parser::OpenACCDeclarativeConstruct &) { PopContext(); }205 206 void Post(const parser::AccDeclarativeDirective &) {207 GetContext().withinConstruct = true;208 }209 210 bool Pre(const parser::OpenACCRoutineConstruct &);211 bool Pre(const parser::AccBindClause &);212 void Post(const parser::OpenACCStandaloneDeclarativeConstruct &);213 214 void Post(const parser::AccBeginBlockDirective &) {215 GetContext().withinConstruct = true;216 }217 218 bool Pre(const parser::OpenACCLoopConstruct &);219 void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }220 void Post(const parser::AccLoopDirective &) {221 GetContext().withinConstruct = true;222 }223 224 // TODO: We should probably also privatize ConcurrentBounds.225 template <typename A>226 bool Pre(const parser::LoopBounds<parser::ScalarName, A> &x) {227 if (!dirContext_.empty() && GetContext().withinConstruct) {228 if (auto *symbol{ResolveAcc(229 x.name.thing, Symbol::Flag::AccPrivate, currScope())}) {230 AddToContextObjectWithDSA(*symbol, Symbol::Flag::AccPrivate);231 }232 }233 return true;234 }235 236 bool Pre(const parser::OpenACCStandaloneConstruct &);237 void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }238 void Post(const parser::AccStandaloneDirective &) {239 GetContext().withinConstruct = true;240 }241 242 bool Pre(const parser::OpenACCCacheConstruct &);243 void Post(const parser::OpenACCCacheConstruct &) { PopContext(); }244 245 void Post(const parser::AccDefaultClause &);246 247 bool Pre(const parser::AccClause::Attach &);248 bool Pre(const parser::AccClause::Detach &);249 250 bool Pre(const parser::AccClause::Copy &x) {251 ResolveAccObjectList(x.v, Symbol::Flag::AccCopy);252 return false;253 }254 255 bool Pre(const parser::AccClause::Create &x) {256 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};257 ResolveAccObjectList(objectList, Symbol::Flag::AccCreate);258 return false;259 }260 261 bool Pre(const parser::AccClause::Copyin &x) {262 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};263 const auto &modifier{264 std::get<std::optional<parser::AccDataModifier>>(x.v.t)};265 if (modifier &&266 (*modifier).v == parser::AccDataModifier::Modifier::ReadOnly) {267 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyInReadOnly);268 } else {269 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn);270 }271 return false;272 }273 274 bool Pre(const parser::AccClause::Copyout &x) {275 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};276 ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut);277 return false;278 }279 280 bool Pre(const parser::AccClause::Present &x) {281 ResolveAccObjectList(x.v, Symbol::Flag::AccPresent);282 return false;283 }284 bool Pre(const parser::AccClause::Private &x) {285 ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate);286 return false;287 }288 bool Pre(const parser::AccClause::Firstprivate &x) {289 ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate);290 return false;291 }292 293 bool Pre(const parser::AccClause::Device &x) {294 ResolveAccObjectList(x.v, Symbol::Flag::AccDevice);295 return false;296 }297 298 bool Pre(const parser::AccClause::DeviceResident &x) {299 ResolveAccObjectList(x.v, Symbol::Flag::AccDeviceResident);300 return false;301 }302 303 bool Pre(const parser::AccClause::Deviceptr &x) {304 ResolveAccObjectList(x.v, Symbol::Flag::AccDevicePtr);305 return false;306 }307 308 bool Pre(const parser::AccClause::Link &x) {309 ResolveAccObjectList(x.v, Symbol::Flag::AccLink);310 return false;311 }312 313 bool Pre(const parser::AccClause::Host &x) {314 ResolveAccObjectList(x.v, Symbol::Flag::AccHost);315 return false;316 }317 318 bool Pre(const parser::AccClause::Self &x) {319 const std::optional<parser::AccSelfClause> &accSelfClause = x.v;320 if (accSelfClause &&321 std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) {322 const auto &accObjectList =323 std::get<parser::AccObjectList>((*accSelfClause).u);324 ResolveAccObjectList(accObjectList, Symbol::Flag::AccSelf);325 }326 return false;327 }328 329 bool Pre(const parser::AccClause::Reduction &x) {330 const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};331 ResolveAccObjectList(objectList, Symbol::Flag::AccReduction);332 return false;333 }334 335 bool Pre(const parser::AccClause::UseDevice &x) {336 ResolveAccObjectList(x.v, Symbol::Flag::AccUseDevice);337 return false;338 }339 340 void Post(const parser::Name &);341 342private:343 std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);344 bool HasForceCollapseModifier(const parser::AccClauseList &);345 346 Symbol::Flags dataSharingAttributeFlags{Symbol::Flag::AccShared,347 Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate,348 Symbol::Flag::AccReduction};349 350 Symbol::Flags dataMappingAttributeFlags{Symbol::Flag::AccCreate,351 Symbol::Flag::AccCopyIn, Symbol::Flag::AccCopyOut,352 Symbol::Flag::AccDelete, Symbol::Flag::AccPresent};353 354 Symbol::Flags accDataMvtFlags{355 Symbol::Flag::AccDevice, Symbol::Flag::AccHost, Symbol::Flag::AccSelf};356 357 Symbol::Flags accFlagsRequireMark{Symbol::Flag::AccCreate,358 Symbol::Flag::AccCopyIn, Symbol::Flag::AccCopyInReadOnly,359 Symbol::Flag::AccCopy, Symbol::Flag::AccCopyOut,360 Symbol::Flag::AccDevicePtr, Symbol::Flag::AccDeviceResident,361 Symbol::Flag::AccLink, Symbol::Flag::AccPresent};362 363 void CheckAssociatedLoop(const parser::DoConstruct &, bool forceCollapsed);364 void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);365 void ResolveAccObject(const parser::AccObject &, Symbol::Flag);366 Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);367 Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);368 Symbol *ResolveName(const parser::Name &);369 Symbol *ResolveFctName(const parser::Name &);370 Symbol *ResolveAccCommonBlockName(const parser::Name *);371 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);372 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);373 void CheckMultipleAppearances(374 const parser::Name &, const Symbol &, Symbol::Flag);375 void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);376 void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);377 void AllowOnlyVariable(const parser::AccObject &object);378 void EnsureAllocatableOrPointer(379 const llvm::acc::Clause clause, const parser::AccObjectList &objectList);380 void AddRoutineInfoToSymbol(381 Symbol &, const parser::OpenACCRoutineConstruct &);382 Scope *topScope_;383};384 385// Data-sharing and Data-mapping attributes for data-refs in OpenMP construct386class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {387public:388 explicit OmpAttributeVisitor(SemanticsContext &context)389 : DirectiveAttributeVisitor(context) {}390 391 template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }392 template <typename A> bool Pre(const A &) { return true; }393 template <typename A> void Post(const A &) {}394 395 template <typename A> bool Pre(const parser::Statement<A> &statement) {396 currentStatementSource_ = statement.source;397 // Keep track of the labels in all the labelled statements398 if (statement.label) {399 auto label{statement.label.value()};400 // Get the context to check if the labelled statement is in an401 // enclosing OpenMP construct402 std::optional<DirContext> thisContext{GetContextIf()};403 targetLabels_.emplace(404 label, std::make_pair(currentStatementSource_, thisContext));405 // Check if a statement that causes a jump to the 'label'406 // has already been encountered407 auto range{sourceLabels_.equal_range(label)};408 for (auto it{range.first}; it != range.second; ++it) {409 // Check if both the statement with 'label' and the statement that410 // causes a jump to the 'label' are in the same scope411 CheckLabelContext(it->second.first, currentStatementSource_,412 it->second.second, thisContext);413 }414 }415 return true;416 }417 418 bool Pre(const parser::SpecificationPart &) {419 partStack_.push_back(PartKind::SpecificationPart);420 return true;421 }422 void Post(const parser::SpecificationPart &) { partStack_.pop_back(); }423 424 bool Pre(const parser::ExecutionPart &) {425 partStack_.push_back(PartKind::ExecutionPart);426 return true;427 }428 void Post(const parser::ExecutionPart &) { partStack_.pop_back(); }429 430 bool Pre(const parser::InternalSubprogram &) {431 // Clear the labels being tracked in the previous scope432 ClearLabels();433 return true;434 }435 436 bool Pre(const parser::ModuleSubprogram &) {437 // Clear the labels being tracked in the previous scope438 ClearLabels();439 return true;440 }441 442 bool Pre(const parser::StmtFunctionStmt &x) {443 const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};444 if (const auto *expr{GetExpr(context_, parsedExpr)}) {445 for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {446 if (!IsStmtFunctionDummy(symbol)) {447 stmtFunctionExprSymbols_.insert(symbol.GetUltimate());448 }449 }450 }451 return true;452 }453 454 bool Pre(const parser::UseStmt &x) {455 if (x.moduleName.symbol) {456 Scope &thisScope{context_.FindScope(x.moduleName.source)};457 common::visit(458 [&](auto &&details) {459 if constexpr (std::is_convertible_v<decltype(details),460 const WithOmpDeclarative &>) {461 AddOmpRequiresToScope(thisScope, details.ompRequires(),462 details.ompAtomicDefaultMemOrder());463 }464 },465 x.moduleName.symbol->details());466 }467 return true;468 }469 470 bool Pre(const parser::OmpStylizedDeclaration &x) {471 static llvm::StringMap<Symbol::Flag> map{472 {"omp_in", Symbol::Flag::OmpInVar},473 {"omp_orig", Symbol::Flag::OmpOrigVar},474 {"omp_out", Symbol::Flag::OmpOutVar},475 {"omp_priv", Symbol::Flag::OmpPrivVar},476 };477 if (auto &name{std::get<parser::ObjectName>(x.var.t)}; name.symbol) {478 if (auto found{map.find(name.ToString())}; found != map.end()) {479 ResolveOmp(name, found->second,480 const_cast<Scope &>(DEREF(name.symbol).owner()));481 }482 }483 return false;484 }485 bool Pre(const parser::OmpMetadirectiveDirective &x) {486 PushContext(x.v.source, llvm::omp::Directive::OMPD_metadirective);487 return true;488 }489 void Post(const parser::OmpMetadirectiveDirective &) { PopContext(); }490 491 bool Pre(const parser::OmpBlockConstruct &);492 void Post(const parser::OmpBlockConstruct &);493 494 void Post(const parser::OmpBeginDirective &x) {495 GetContext().withinConstruct = true;496 }497 498 bool Pre(const parser::OpenMPGroupprivate &);499 void Post(const parser::OpenMPGroupprivate &) { PopContext(); }500 501 bool Pre(const parser::OpenMPStandaloneConstruct &x) {502 common::visit(503 [&](auto &&s) {504 using TypeS = llvm::remove_cvref_t<decltype(s)>;505 // These two cases are handled individually.506 if constexpr ( //507 !std::is_same_v<TypeS, parser::OpenMPSimpleStandaloneConstruct> &&508 !std::is_same_v<TypeS, parser::OmpMetadirectiveDirective>) {509 PushContext(x.source, s.v.DirId());510 }511 },512 x.u);513 return true;514 }515 516 void Post(const parser::OpenMPStandaloneConstruct &x) {517 // These two cases are handled individually.518 if (!std::holds_alternative<parser::OpenMPSimpleStandaloneConstruct>(x.u) &&519 !std::holds_alternative<parser::OmpMetadirectiveDirective>(x.u)) {520 PopContext();521 }522 }523 524 bool Pre(const parser::OpenMPSimpleStandaloneConstruct &);525 void Post(const parser::OpenMPSimpleStandaloneConstruct &) { PopContext(); }526 527 bool Pre(const parser::OpenMPLoopConstruct &);528 void Post(const parser::OpenMPLoopConstruct &) {529 ordCollapseLevel++;530 PopContext();531 }532 void Post(const parser::OmpBeginLoopDirective &) {533 GetContext().withinConstruct = true;534 }535 bool Pre(const parser::OpenMPMisplacedEndDirective &x) { return false; }536 bool Pre(const parser::OpenMPInvalidDirective &x) { return false; }537 538 bool Pre(const parser::DoConstruct &);539 540 bool Pre(const parser::OpenMPSectionsConstruct &);541 void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }542 543 bool Pre(const parser::OpenMPSectionConstruct &);544 void Post(const parser::OpenMPSectionConstruct &) { PopContext(); }545 546 bool Pre(const parser::OpenMPCriticalConstruct &critical);547 void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); }548 549 bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {550 PushContext(x.source, llvm::omp::Directive::OMPD_declare_simd);551 for (const parser::OmpArgument &arg : x.v.Arguments().v) {552 if (auto *object{omp::GetArgumentObject(arg)}) {553 ResolveOmpObject(*object, Symbol::Flag::OmpDeclareSimd);554 }555 }556 return true;557 }558 void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); }559 560 bool Pre(const parser::OpenMPDepobjConstruct &x) {561 PushContext(x.source, llvm::omp::Directive::OMPD_depobj);562 for (auto &arg : x.v.Arguments().v) {563 if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {564 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {565 ResolveOmpObject(*object, Symbol::Flag::OmpDependObject);566 }567 }568 }569 return true;570 }571 void Post(const parser::OpenMPDepobjConstruct &) { PopContext(); }572 573 bool Pre(const parser::OpenMPFlushConstruct &x) {574 PushContext(x.source, llvm::omp::Directive::OMPD_flush);575 for (auto &arg : x.v.Arguments().v) {576 if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {577 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {578 if (auto *name{std::get_if<parser::Name>(&object->u)}) {579 // ResolveOmpCommonBlockName resolves the symbol as a side effect580 if (!ResolveOmpCommonBlockName(name)) {581 context_.Say(name->source, // 2.15.3582 "COMMON block must be declared in the same scoping unit "583 "in which the OpenMP directive or clause appears"_err_en_US);584 }585 }586 }587 }588 }589 return true;590 }591 void Post(const parser::OpenMPFlushConstruct &) { PopContext(); }592 593 bool Pre(const parser::OpenMPRequiresConstruct &x) {594 using RequiresClauses = WithOmpDeclarative::RequiresClauses;595 PushContext(x.source, llvm::omp::Directive::OMPD_requires);596 597 auto getArgument{[&](auto &&maybeClause) {598 if (maybeClause) {599 // Scalar<Logical<Constant<common::Indirection<Expr>>>>600 auto &parserExpr{parser::UnwrapRef<parser::Expr>(*maybeClause)};601 evaluate::ExpressionAnalyzer ea{context_};602 if (auto &&maybeExpr{ea.Analyze(parserExpr)}) {603 if (auto v{omp::GetLogicalValue(*maybeExpr)}) {604 return *v;605 }606 }607 }608 // If the argument is missing, it is assumed to be true.609 return true;610 }};611 612 // Gather information from the clauses.613 RequiresClauses reqs;614 const common::OmpMemoryOrderType *memOrder{nullptr};615 for (const parser::OmpClause &clause : x.v.Clauses().v) {616 using OmpClause = parser::OmpClause;617 reqs |= common::visit(618 common::visitors{619 [&](const OmpClause::AtomicDefaultMemOrder &atomic) {620 memOrder = &atomic.v.v;621 return RequiresClauses{};622 },623 [&](auto &&s) {624 using TypeS = llvm::remove_cvref_t<decltype(s)>;625 if constexpr ( //626 std::is_same_v<TypeS, OmpClause::DeviceSafesync> ||627 std::is_same_v<TypeS, OmpClause::DynamicAllocators> ||628 std::is_same_v<TypeS, OmpClause::ReverseOffload> ||629 std::is_same_v<TypeS, OmpClause::SelfMaps> ||630 std::is_same_v<TypeS, OmpClause::UnifiedAddress> ||631 std::is_same_v<TypeS, OmpClause::UnifiedSharedMemory>) {632 if (getArgument(s.v)) {633 return RequiresClauses{clause.Id()};634 }635 }636 return RequiresClauses{};637 },638 },639 clause.u);640 }641 642 // Merge clauses into parents' symbols details.643 AddOmpRequiresToScope(currScope(), &reqs, memOrder);644 return true;645 }646 void Post(const parser::OpenMPRequiresConstruct &) { PopContext(); }647 648 bool Pre(const parser::OpenMPDeclareTargetConstruct &);649 void Post(const parser::OpenMPDeclareTargetConstruct &) { PopContext(); }650 651 bool Pre(const parser::OpenMPDeclareMapperConstruct &);652 void Post(const parser::OpenMPDeclareMapperConstruct &) { PopContext(); }653 654 bool Pre(const parser::OpenMPDeclareReductionConstruct &);655 void Post(const parser::OpenMPDeclareReductionConstruct &) { PopContext(); }656 657 bool Pre(const parser::OpenMPThreadprivate &);658 void Post(const parser::OpenMPThreadprivate &) { PopContext(); }659 660 bool Pre(const parser::OmpAllocateDirective &);661 662 bool Pre(const parser::OpenMPAssumeConstruct &);663 void Post(const parser::OpenMPAssumeConstruct &) { PopContext(); }664 665 bool Pre(const parser::OpenMPAtomicConstruct &);666 void Post(const parser::OpenMPAtomicConstruct &) { PopContext(); }667 668 bool Pre(const parser::OpenMPDispatchConstruct &);669 void Post(const parser::OpenMPDispatchConstruct &) { PopContext(); }670 671 bool Pre(const parser::OpenMPAllocatorsConstruct &);672 void Post(const parser::OpenMPAllocatorsConstruct &);673 674 bool Pre(const parser::OpenMPUtilityConstruct &x) {675 PushContext(x.source, parser::omp::GetOmpDirectiveName(x).v);676 return true;677 }678 void Post(const parser::OpenMPUtilityConstruct &) { PopContext(); }679 680 bool Pre(const parser::OmpDeclareVariantDirective &x) {681 PushContext(x.source, llvm::omp::Directive::OMPD_declare_variant);682 return true;683 }684 void Post(const parser::OmpDeclareVariantDirective &) { PopContext(); };685 686 void Post(const parser::OmpObjectList &x) {687 // The objects from OMP clauses should have already been resolved,688 // except common blocks (the ResolveNamesVisitor does not visit689 // parser::Name, those are dealt with as members of other structures).690 // Iterate over elements of x, and resolve any common blocks that691 // are still unresolved.692 for (const parser::OmpObject &obj : x.v) {693 auto *name{std::get_if<parser::Name>(&obj.u)};694 if (name && !name->symbol) {695 Resolve(*name, currScope().MakeCommonBlock(name->source, name->source));696 }697 }698 }699 700 // 2.15.3 Data-Sharing Attribute Clauses701 bool Pre(const parser::OmpClause::Inclusive &x) {702 ResolveOmpObjectList(x.v, Symbol::Flag::OmpInclusiveScan);703 return false;704 }705 bool Pre(const parser::OmpClause::Exclusive &x) {706 ResolveOmpObjectList(x.v, Symbol::Flag::OmpExclusiveScan);707 return false;708 }709 void Post(const parser::OmpClause::Defaultmap &);710 void Post(const parser::OmpDefaultClause &);711 bool Pre(const parser::OmpClause::Shared &x) {712 ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);713 return false;714 }715 bool Pre(const parser::OmpClause::Private &x) {716 ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);717 return false;718 }719 bool Pre(const parser::OmpAllocateClause &x) {720 const auto &objectList{std::get<parser::OmpObjectList>(x.t)};721 ResolveOmpObjectList(objectList, Symbol::Flag::OmpAllocate);722 return false;723 }724 bool Pre(const parser::OmpClause::Firstprivate &x) {725 ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);726 return false;727 }728 bool Pre(const parser::OmpClause::Lastprivate &x) {729 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};730 ResolveOmpObjectList(objList, Symbol::Flag::OmpLastPrivate);731 return false;732 }733 bool Pre(const parser::OmpClause::Copyin &x) {734 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn);735 return false;736 }737 bool Pre(const parser::OmpClause::Copyprivate &x) {738 ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyPrivate);739 return false;740 }741 bool Pre(const parser::OmpLinearClause &x) {742 auto &objects{std::get<parser::OmpObjectList>(x.t)};743 ResolveOmpObjectList(objects, Symbol::Flag::OmpLinear);744 return false;745 }746 747 bool Pre(const parser::OmpClause::Uniform &x) {748 ResolveOmpNameList(x.v, Symbol::Flag::OmpUniform);749 return false;750 }751 752 bool Pre(const parser::OmpInReductionClause &x) {753 auto &objects{std::get<parser::OmpObjectList>(x.t)};754 ResolveOmpObjectList(objects, Symbol::Flag::OmpInReduction);755 return false;756 }757 758 bool Pre(const parser::OmpClause::Reduction &x) {759 const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};760 ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction);761 762 if (auto &modifiers{OmpGetModifiers(x.v)}) {763 auto createDummyProcSymbol = [&](const parser::Name *name) {764 // If name resolution failed, create a dummy symbol765 const auto namePair{currScope().try_emplace(766 name->source, Attrs{}, ProcEntityDetails{})};767 auto &newSymbol{*namePair.first->second};768 if (context_.intrinsics().IsIntrinsic(name->ToString())) {769 newSymbol.attrs().set(Attr::INTRINSIC);770 }771 name->symbol = &newSymbol;772 };773 774 for (auto &mod : *modifiers) {775 if (!std::holds_alternative<parser::OmpReductionIdentifier>(mod.u)) {776 continue;777 }778 auto &opr{std::get<parser::OmpReductionIdentifier>(mod.u)};779 if (auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) {780 if (auto *name{parser::Unwrap<parser::Name>(procD->u)}) {781 if (!name->symbol) {782 if (!ResolveName(name)) {783 createDummyProcSymbol(name);784 }785 }786 }787 if (auto *procRef{788 parser::Unwrap<parser::ProcComponentRef>(procD->u)}) {789 if (!procRef->v.thing.component.symbol) {790 if (!ResolveName(&procRef->v.thing.component)) {791 createDummyProcSymbol(&procRef->v.thing.component);792 }793 }794 }795 }796 }797 using ReductionModifier = parser::OmpReductionModifier;798 if (auto *maybeModifier{799 OmpGetUniqueModifier<ReductionModifier>(modifiers)}) {800 if (maybeModifier->v == ReductionModifier::Value::Inscan) {801 ResolveOmpObjectList(objList, Symbol::Flag::OmpInScanReduction);802 }803 }804 }805 return false;806 }807 808 bool Pre(const parser::OmpAlignedClause &x) {809 const auto &alignedNameList{std::get<parser::OmpObjectList>(x.t)};810 ResolveOmpObjectList(alignedNameList, Symbol::Flag::OmpAligned);811 return false;812 }813 814 bool Pre(const parser::OmpClause::Nontemporal &x) {815 const auto &nontemporalNameList{x.v};816 ResolveOmpNameList(nontemporalNameList, Symbol::Flag::OmpNontemporal);817 return false;818 }819 820 void Post(const parser::OmpIteration &x) {821 if (const auto &name{std::get<parser::Name>(x.t)}; !name.symbol) {822 auto *symbol{currScope().FindSymbol(name.source)};823 if (!symbol) {824 // OmpIteration must use an existing object. If there isn't one,825 // create a fake one and flag an error later.826 symbol = &currScope().MakeSymbol(827 name.source, Attrs{}, EntityDetails(/*isDummy=*/true));828 }829 Resolve(name, symbol);830 }831 }832 833 bool Pre(const parser::OmpClause::UseDevicePtr &x) {834 ResolveOmpObjectList(x.v, Symbol::Flag::OmpUseDevicePtr);835 return false;836 }837 838 bool Pre(const parser::OmpClause::UseDeviceAddr &x) {839 ResolveOmpObjectList(x.v, Symbol::Flag::OmpUseDeviceAddr);840 return false;841 }842 843 bool Pre(const parser::OmpClause::IsDevicePtr &x) {844 ResolveOmpObjectList(x.v, Symbol::Flag::OmpIsDevicePtr);845 return false;846 }847 848 bool Pre(const parser::OmpClause::HasDeviceAddr &x) {849 ResolveOmpObjectList(x.v, Symbol::Flag::OmpHasDeviceAddr);850 return false;851 }852 853 void Post(const parser::Name &);854 855 // Keep track of labels in the statements that causes jumps to target labels856 void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); }857 void Post(const parser::ComputedGotoStmt &computedGotoStmt) {858 for (auto &label : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {859 CheckSourceLabel(label);860 }861 }862 void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {863 CheckSourceLabel(std::get<1>(arithmeticIfStmt.t));864 CheckSourceLabel(std::get<2>(arithmeticIfStmt.t));865 CheckSourceLabel(std::get<3>(arithmeticIfStmt.t));866 }867 void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {868 for (auto &label : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {869 CheckSourceLabel(label);870 }871 }872 void Post(const parser::AltReturnSpec &altReturnSpec) {873 CheckSourceLabel(altReturnSpec.v);874 }875 void Post(const parser::ErrLabel &errLabel) { CheckSourceLabel(errLabel.v); }876 void Post(const parser::EndLabel &endLabel) { CheckSourceLabel(endLabel.v); }877 void Post(const parser::EorLabel &eorLabel) { CheckSourceLabel(eorLabel.v); }878 879 void Post(const parser::OmpMapClause &x) {880 unsigned version{context_.langOptions().OpenMPVersion};881 std::optional<Symbol::Flag> ompFlag;882 883 auto &mods{OmpGetModifiers(x)};884 if (auto *mapType{OmpGetUniqueModifier<parser::OmpMapType>(mods)}) {885 switch (mapType->v) {886 case parser::OmpMapType::Value::To:887 ompFlag = Symbol::Flag::OmpMapTo;888 break;889 case parser::OmpMapType::Value::From:890 ompFlag = Symbol::Flag::OmpMapFrom;891 break;892 case parser::OmpMapType::Value::Tofrom:893 ompFlag = Symbol::Flag::OmpMapToFrom;894 break;895 case parser::OmpMapType::Value::Alloc:896 case parser::OmpMapType::Value::Release:897 case parser::OmpMapType::Value::Storage:898 ompFlag = Symbol::Flag::OmpMapStorage;899 break;900 case parser::OmpMapType::Value::Delete:901 ompFlag = Symbol::Flag::OmpMapDelete;902 break;903 }904 }905 if (!ompFlag) {906 if (version >= 60) {907 // [6.0:275:12-15]908 // When a map-type is not specified for a clause on which it may be909 // specified, the map-type defaults to storage if the delete-modifier910 // is present on the clause or if the list item for which the map-type911 // is not specified is an assumed-size array.912 if (OmpGetUniqueModifier<parser::OmpDeleteModifier>(mods)) {913 ompFlag = Symbol::Flag::OmpMapStorage;914 }915 // Otherwise, if delete-modifier is absent, leave ompFlag unset.916 } else {917 // [5.2:151:10]918 // If a map-type is not specified, the map-type defaults to tofrom.919 ompFlag = Symbol::Flag::OmpMapToFrom;920 }921 }922 923 const auto &ompObjList{std::get<parser::OmpObjectList>(x.t)};924 for (const auto &ompObj : ompObjList.v) {925 common::visit(926 common::visitors{927 [&](const parser::Designator &designator) {928 if (const auto *name{929 parser::GetDesignatorNameIfDataRef(designator)}) {930 if (name->symbol) {931 name->symbol->set(932 ompFlag.value_or(Symbol::Flag::OmpMapStorage));933 AddToContextObjectWithDSA(*name->symbol,934 ompFlag.value_or(Symbol::Flag::OmpMapStorage));935 if (semantics::IsAssumedSizeArray(*name->symbol)) {936 context_.Say(designator.source,937 "Assumed-size whole arrays may not appear on the %s "938 "clause"_err_en_US,939 "MAP");940 }941 }942 }943 },944 [&](const auto &name) {},945 },946 ompObj.u);947 948 ResolveOmpObject(ompObj, ompFlag.value_or(Symbol::Flag::OmpMapStorage));949 }950 }951 952 const parser::OmpClause *associatedClause{nullptr};953 void SetAssociatedClause(const parser::OmpClause *c) { associatedClause = c; }954 const parser::OmpClause *GetAssociatedClause() { return associatedClause; }955 956private:957 /// Given a vector of loop levels and a vector of corresponding clauses find958 /// the largest loop level and set the associated loop level to the found959 /// maximum. This is used for error handling to ensure that the number of960 /// affected loops is not larger that the number of available loops.961 std::int64_t SetAssociatedMaxClause(llvm::SmallVector<std::int64_t> &,962 llvm::SmallVector<const parser::OmpClause *> &);963 std::int64_t GetNumAffectedLoopsFromLoopConstruct(964 const parser::OpenMPLoopConstruct &);965 void CollectNumAffectedLoopsFromLoopConstruct(966 const parser::OpenMPLoopConstruct &, llvm::SmallVector<std::int64_t> &,967 llvm::SmallVector<const parser::OmpClause *> &);968 void CollectNumAffectedLoopsFromInnerLoopContruct(969 const parser::OpenMPLoopConstruct &, llvm::SmallVector<std::int64_t> &,970 llvm::SmallVector<const parser::OmpClause *> &);971 void CollectNumAffectedLoopsFromClauses(const parser::OmpClauseList &,972 llvm::SmallVector<std::int64_t> &,973 llvm::SmallVector<const parser::OmpClause *> &);974 975 Symbol::Flags dataSharingAttributeFlags{Symbol::Flag::OmpShared,976 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,977 Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpReduction,978 Symbol::Flag::OmpLinear};979 980 Symbol::Flags dataMappingAttributeFlags{Symbol::Flag::OmpMapTo,981 Symbol::Flag::OmpMapFrom, Symbol::Flag::OmpMapToFrom,982 Symbol::Flag::OmpMapStorage, Symbol::Flag::OmpMapDelete,983 Symbol::Flag::OmpIsDevicePtr, Symbol::Flag::OmpHasDeviceAddr};984 985 Symbol::Flags privateDataSharingAttributeFlags{Symbol::Flag::OmpPrivate,986 Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate};987 988 Symbol::Flags ompFlagsRequireNewSymbol{Symbol::Flag::OmpPrivate,989 Symbol::Flag::OmpLinear, Symbol::Flag::OmpFirstPrivate,990 Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,991 Symbol::Flag::OmpReduction, Symbol::Flag::OmpCriticalLock,992 Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpUseDevicePtr,993 Symbol::Flag::OmpUseDeviceAddr, Symbol::Flag::OmpIsDevicePtr,994 Symbol::Flag::OmpHasDeviceAddr, Symbol::Flag::OmpUniform};995 996 Symbol::Flags ompFlagsRequireMark{Symbol::Flag::OmpThreadprivate,997 Symbol::Flag::OmpDeclareTarget, Symbol::Flag::OmpExclusiveScan,998 Symbol::Flag::OmpInclusiveScan, Symbol::Flag::OmpInScanReduction,999 Symbol::Flag::OmpGroupPrivate};1000 1001 Symbol::Flags dataCopyingAttributeFlags{1002 Symbol::Flag::OmpCopyIn, Symbol::Flag::OmpCopyPrivate};1003 1004 std::vector<const parser::Name *> allocateNames_; // on one directive1005 UnorderedSymbolSet privateDataSharingAttributeObjects_; // on one directive1006 UnorderedSymbolSet stmtFunctionExprSymbols_;1007 std::multimap<const parser::Label,1008 std::pair<parser::CharBlock, std::optional<DirContext>>>1009 sourceLabels_;1010 std::map<const parser::Label,1011 std::pair<parser::CharBlock, std::optional<DirContext>>>1012 targetLabels_;1013 parser::CharBlock currentStatementSource_;1014 1015 enum class PartKind : int {1016 // There are also other "parts", such as internal-subprogram-part, etc,1017 // but we're keeping track of these two for now.1018 SpecificationPart,1019 ExecutionPart,1020 };1021 std::vector<PartKind> partStack_;1022 1023 void AddAllocateName(const parser::Name *&object) {1024 allocateNames_.push_back(object);1025 }1026 void ClearAllocateNames() { allocateNames_.clear(); }1027 1028 void AddPrivateDataSharingAttributeObjects(SymbolRef object) {1029 privateDataSharingAttributeObjects_.insert(object);1030 }1031 void ClearPrivateDataSharingAttributeObjects() {1032 privateDataSharingAttributeObjects_.clear();1033 }1034 1035 /// Check that loops in the loop nest are perfectly nested, as well that lower1036 /// bound, upper bound, and step expressions do not use the iv1037 /// of a surrounding loop of the associated loops nest.1038 /// We do not support non-perfectly nested loops not non-rectangular loops yet1039 /// (both introduced in OpenMP 5.0)1040 void CheckPerfectNestAndRectangularLoop(const parser::OpenMPLoopConstruct &x);1041 1042 // Predetermined DSA rules1043 void PrivatizeAssociatedLoopIndexAndCheckLoopLevel(1044 const parser::OpenMPLoopConstruct &);1045 void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);1046 1047 bool IsNestedInDirective(llvm::omp::Directive directive);1048 void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);1049 void ResolveOmpDesignator(1050 const parser::Designator &designator, Symbol::Flag ompFlag);1051 void ResolveOmpCommonBlock(const parser::Name &name, Symbol::Flag ompFlag);1052 void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);1053 Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);1054 Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);1055 Symbol *ResolveOmpCommonBlockName(const parser::Name *);1056 void ResolveOmpNameList(const std::list<parser::Name> &, Symbol::Flag);1057 void ResolveOmpName(const parser::Name &, Symbol::Flag);1058 Symbol *ResolveName(const parser::Name *);1059 Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);1060 Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);1061 void CheckMultipleAppearances(1062 const parser::Name &, const Symbol &, Symbol::Flag);1063 1064 void CheckDataCopyingClause(1065 const parser::Name &, const Symbol &, Symbol::Flag);1066 void CheckAssocLoopLevel(std::int64_t level, const parser::OmpClause *clause);1067 void CheckObjectIsPrivatizable(1068 const parser::Name &, const Symbol &, Symbol::Flag);1069 void CheckSourceLabel(const parser::Label &);1070 void CheckLabelContext(const parser::CharBlock, const parser::CharBlock,1071 std::optional<DirContext>, std::optional<DirContext>);1072 void ClearLabels() {1073 sourceLabels_.clear();1074 targetLabels_.clear();1075 };1076 1077 std::int64_t ordCollapseLevel{0};1078 1079 void AddOmpRequiresToScope(Scope &,1080 const WithOmpDeclarative::RequiresClauses *,1081 const common::OmpMemoryOrderType *);1082 void IssueNonConformanceWarning(llvm::omp::Directive D,1083 parser::CharBlock source, unsigned EmitFromVersion);1084 1085 void CreateImplicitSymbols(const Symbol *symbol);1086 1087 void AddToContextObjectWithExplicitDSA(Symbol &symbol, Symbol::Flag flag) {1088 AddToContextObjectWithDSA(symbol, flag);1089 if (dataSharingAttributeFlags.test(flag)) {1090 symbol.set(Symbol::Flag::OmpExplicit);1091 }1092 }1093 1094 // Clear any previous data-sharing attribute flags and set the new ones.1095 // Needed when setting PreDetermined DSAs, that take precedence over1096 // Implicit ones.1097 void SetSymbolDSA(Symbol &symbol, Symbol::Flags flags) {1098 symbol.flags() &= ~(dataSharingAttributeFlags |1099 Symbol::Flags{Symbol::Flag::OmpExplicit, Symbol::Flag::OmpImplicit,1100 Symbol::Flag::OmpPreDetermined});1101 symbol.flags() |= flags;1102 }1103};1104 1105template <typename T>1106bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(1107 const Symbol &object) {1108 auto it{dataSharingAttributeObjects_.find(object)};1109 return it != dataSharingAttributeObjects_.end();1110}1111 1112template <typename T>1113std::tuple<const parser::Name *, const parser::ScalarExpr *,1114 const parser::ScalarExpr *, const parser::ScalarExpr *>1115DirectiveAttributeVisitor<T>::GetLoopBounds(const parser::DoConstruct &x) {1116 using Bounds = parser::LoopControl::Bounds;1117 if (x.GetLoopControl()) {1118 if (const Bounds * b{std::get_if<Bounds>(&x.GetLoopControl()->u)}) {1119 auto &step = b->step;1120 return {&b->name.thing, &b->lower, &b->upper,1121 step.has_value() ? &step.value() : nullptr};1122 }1123 } else {1124 context_1125 .Say(std::get<parser::Statement<parser::NonLabelDoStmt>>(x.t).source,1126 "Loop control is not present in the DO LOOP"_err_en_US)1127 .Attach(GetContext().directiveSource,1128 "associated with the enclosing LOOP construct"_en_US);1129 }1130 return {nullptr, nullptr, nullptr, nullptr};1131}1132 1133template <typename T>1134const parser::Name *DirectiveAttributeVisitor<T>::GetLoopIndex(1135 const parser::DoConstruct &x) {1136 return std::get<const parser::Name *>(GetLoopBounds(x));1137}1138 1139template <typename T>1140const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf(1141 const parser::ExecutionPartConstruct &x) {1142 return parser::Unwrap<parser::DoConstruct>(x);1143}1144 1145template <typename T>1146Symbol *DirectiveAttributeVisitor<T>::DeclareNewAccessEntity(1147 const Symbol &object, Symbol::Flag flag, Scope &scope) {1148 assert(object.owner() != currScope());1149 auto &symbol{MakeAssocSymbol(object.name(), object, scope)};1150 symbol.set(flag);1151 if (flag == Symbol::Flag::OmpCopyIn) {1152 // The symbol in copyin clause must be threadprivate entity.1153 symbol.set(Symbol::Flag::OmpThreadprivate);1154 }1155 return &symbol;1156}1157 1158template <typename T>1159Symbol *DirectiveAttributeVisitor<T>::DeclareAccessEntity(1160 const parser::Name &name, Symbol::Flag flag, Scope &scope) {1161 if (!name.symbol) {1162 return nullptr; // not resolved by Name Resolution step, do nothing1163 }1164 name.symbol = DeclareAccessEntity(*name.symbol, flag, scope);1165 return name.symbol;1166}1167 1168template <typename T>1169Symbol *DirectiveAttributeVisitor<T>::DeclareAccessEntity(1170 Symbol &object, Symbol::Flag flag, Scope &scope) {1171 if (object.owner() != currScope()) {1172 return DeclareNewAccessEntity(object, flag, scope);1173 } else {1174 object.set(flag);1175 return &object;1176 }1177}1178 1179bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {1180 const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};1181 const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};1182 switch (blockDir.v) {1183 case llvm::acc::Directive::ACCD_data:1184 case llvm::acc::Directive::ACCD_host_data:1185 case llvm::acc::Directive::ACCD_kernels:1186 case llvm::acc::Directive::ACCD_parallel:1187 case llvm::acc::Directive::ACCD_serial:1188 PushContext(blockDir.source, blockDir.v);1189 break;1190 default:1191 break;1192 }1193 ClearDataSharingAttributeObjects();1194 return true;1195}1196 1197bool AccAttributeVisitor::Pre(const parser::OpenACCDeclarativeConstruct &x) {1198 if (const auto *declConstruct{1199 std::get_if<parser::OpenACCStandaloneDeclarativeConstruct>(&x.u)}) {1200 const auto &declDir{1201 std::get<parser::AccDeclarativeDirective>(declConstruct->t)};1202 PushContext(declDir.source, llvm::acc::Directive::ACCD_declare);1203 }1204 ClearDataSharingAttributeObjects();1205 return true;1206}1207 1208static const parser::AccObjectList &GetAccObjectList(1209 const parser::AccClause &clause) {1210 if (const auto *copyClause =1211 std::get_if<Fortran::parser::AccClause::Copy>(&clause.u)) {1212 return copyClause->v;1213 } else if (const auto *createClause =1214 std::get_if<Fortran::parser::AccClause::Create>(&clause.u)) {1215 const Fortran::parser::AccObjectListWithModifier &listWithModifier =1216 createClause->v;1217 const Fortran::parser::AccObjectList &accObjectList =1218 std::get<Fortran::parser::AccObjectList>(listWithModifier.t);1219 return accObjectList;1220 } else if (const auto *copyinClause =1221 std::get_if<Fortran::parser::AccClause::Copyin>(&clause.u)) {1222 const Fortran::parser::AccObjectListWithModifier &listWithModifier =1223 copyinClause->v;1224 const Fortran::parser::AccObjectList &accObjectList =1225 std::get<Fortran::parser::AccObjectList>(listWithModifier.t);1226 return accObjectList;1227 } else if (const auto *copyoutClause =1228 std::get_if<Fortran::parser::AccClause::Copyout>(&clause.u)) {1229 const Fortran::parser::AccObjectListWithModifier &listWithModifier =1230 copyoutClause->v;1231 const Fortran::parser::AccObjectList &accObjectList =1232 std::get<Fortran::parser::AccObjectList>(listWithModifier.t);1233 return accObjectList;1234 } else if (const auto *presentClause =1235 std::get_if<Fortran::parser::AccClause::Present>(&clause.u)) {1236 return presentClause->v;1237 } else if (const auto *deviceptrClause =1238 std::get_if<Fortran::parser::AccClause::Deviceptr>(1239 &clause.u)) {1240 return deviceptrClause->v;1241 } else if (const auto *deviceResidentClause =1242 std::get_if<Fortran::parser::AccClause::DeviceResident>(1243 &clause.u)) {1244 return deviceResidentClause->v;1245 } else if (const auto *linkClause =1246 std::get_if<Fortran::parser::AccClause::Link>(&clause.u)) {1247 return linkClause->v;1248 } else {1249 llvm_unreachable("Clause without object list!");1250 }1251}1252 1253void AccAttributeVisitor::Post(1254 const parser::OpenACCStandaloneDeclarativeConstruct &x) {1255 const auto &clauseList = std::get<parser::AccClauseList>(x.t);1256 for (const auto &clause : clauseList.v) {1257 // Restriction - line 24141258 // We assume the restriction is present because clauses that require1259 // moving data would require the size of the data to be present, but1260 // the deviceptr and present clauses do not require moving data and1261 // thus we permit them.1262 if (!std::holds_alternative<parser::AccClause::Deviceptr>(clause.u) &&1263 !std::holds_alternative<parser::AccClause::Present>(clause.u)) {1264 DoNotAllowAssumedSizedArray(GetAccObjectList(clause));1265 }1266 }1267}1268 1269bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {1270 const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};1271 const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};1272 const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};1273 if (loopDir.v == llvm::acc::Directive::ACCD_loop) {1274 PushContext(loopDir.source, loopDir.v);1275 }1276 ClearDataSharingAttributeObjects();1277 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));1278 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};1279 CheckAssociatedLoop(*outer, HasForceCollapseModifier(clauseList));1280 return true;1281}1282 1283bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {1284 const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};1285 switch (standaloneDir.v) {1286 case llvm::acc::Directive::ACCD_enter_data:1287 case llvm::acc::Directive::ACCD_exit_data:1288 case llvm::acc::Directive::ACCD_init:1289 case llvm::acc::Directive::ACCD_set:1290 case llvm::acc::Directive::ACCD_shutdown:1291 case llvm::acc::Directive::ACCD_update:1292 PushContext(standaloneDir.source, standaloneDir.v);1293 break;1294 default:1295 break;1296 }1297 ClearDataSharingAttributeObjects();1298 return true;1299}1300 1301Symbol *AccAttributeVisitor::ResolveName(const parser::Name &name) {1302 return name.symbol;1303}1304 1305Symbol *AccAttributeVisitor::ResolveFctName(const parser::Name &name) {1306 Symbol *prev{currScope().FindSymbol(name.source)};1307 if (prev && prev->IsFuncResult()) {1308 prev = currScope().parent().FindSymbol(name.source);1309 }1310 if (!prev) {1311 prev = &*context_.globalScope()1312 .try_emplace(name.source, ProcEntityDetails{})1313 .first->second;1314 }1315 CHECK(!name.symbol || name.symbol == prev);1316 name.symbol = prev;1317 return prev;1318}1319 1320template <typename T>1321common::IfNoLvalue<T, T> FoldExpr(1322 evaluate::FoldingContext &foldingContext, T &&expr) {1323 return evaluate::Fold(foldingContext, std::move(expr));1324}1325 1326template <typename T>1327MaybeExpr EvaluateExpr(1328 Fortran::semantics::SemanticsContext &semanticsContext, const T &expr) {1329 return FoldExpr(1330 semanticsContext.foldingContext(), AnalyzeExpr(semanticsContext, expr));1331}1332 1333void AccAttributeVisitor::AddRoutineInfoToSymbol(1334 Symbol &symbol, const parser::OpenACCRoutineConstruct &x) {1335 if (symbol.has<SubprogramDetails>()) {1336 Fortran::semantics::OpenACCRoutineInfo info;1337 std::vector<OpenACCRoutineDeviceTypeInfo *> currentDevices;1338 currentDevices.push_back(&info);1339 const auto &clauses{std::get<Fortran::parser::AccClauseList>(x.t)};1340 for (const Fortran::parser::AccClause &clause : clauses.v) {1341 if (const auto *dTypeClause{1342 std::get_if<Fortran::parser::AccClause::DeviceType>(&clause.u)}) {1343 currentDevices.clear();1344 for (const auto &deviceTypeExpr : dTypeClause->v.v) {1345 currentDevices.push_back(&info.add_deviceTypeInfo(deviceTypeExpr.v));1346 }1347 } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) {1348 info.set_isNohost();1349 } else if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) {1350 for (auto &device : currentDevices) {1351 device->set_isSeq();1352 }1353 } else if (std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) {1354 for (auto &device : currentDevices) {1355 device->set_isVector();1356 }1357 } else if (std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) {1358 for (auto &device : currentDevices) {1359 device->set_isWorker();1360 }1361 } else if (const auto *gangClause{1362 std::get_if<Fortran::parser::AccClause::Gang>(1363 &clause.u)}) {1364 for (auto &device : currentDevices) {1365 device->set_isGang();1366 }1367 if (gangClause->v) {1368 const Fortran::parser::AccGangArgList &x = *gangClause->v;1369 int numArgs{0};1370 for (const Fortran::parser::AccGangArg &gangArg : x.v) {1371 CHECK(numArgs <= 1 && "expecting 0 or 1 gang dim args");1372 if (const auto *dim{std::get_if<Fortran::parser::AccGangArg::Dim>(1373 &gangArg.u)}) {1374 if (const auto v{EvaluateInt64(context_, dim->v)}) {1375 for (auto &device : currentDevices) {1376 device->set_gangDim(*v);1377 }1378 }1379 }1380 numArgs++;1381 }1382 }1383 } else if (const auto *bindClause{1384 std::get_if<Fortran::parser::AccClause::Bind>(1385 &clause.u)}) {1386 if (const auto *name{1387 std::get_if<Fortran::parser::Name>(&bindClause->v.u)}) {1388 if (Symbol * sym{ResolveFctName(*name)}) {1389 Symbol &ultimate{sym->GetUltimate()};1390 for (auto &device : currentDevices) {1391 device->set_bindName(SymbolRef{ultimate});1392 }1393 } else {1394 context_.Say((*name).source,1395 "No function or subroutine declared for '%s'"_err_en_US,1396 (*name).source);1397 }1398 } else if (const auto charExpr{1399 std::get_if<Fortran::parser::ScalarDefaultCharExpr>(1400 &bindClause->v.u)}) {1401 auto *charConst{1402 Fortran::parser::Unwrap<Fortran::parser::CharLiteralConstant>(1403 *charExpr)};1404 std::string str{std::get<std::string>(charConst->t)};1405 for (auto &device : currentDevices) {1406 device->set_bindName(std::string(str));1407 }1408 }1409 }1410 }1411 symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info);1412 }1413}1414 1415bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) {1416 const auto &verbatim{std::get<parser::Verbatim>(x.t)};1417 if (topScope_) {1418 PushContext(1419 verbatim.source, llvm::acc::Directive::ACCD_routine, *topScope_);1420 } else {1421 PushContext(verbatim.source, llvm::acc::Directive::ACCD_routine);1422 }1423 if (const auto &optName{std::get<std::optional<parser::Name>>(x.t)}) {1424 if (Symbol * sym{ResolveFctName(*optName)}) {1425 Symbol &ultimate{sym->GetUltimate()};1426 AddRoutineInfoToSymbol(ultimate, x);1427 } else {1428 context_.Say((*optName).source,1429 "No function or subroutine declared for '%s'"_err_en_US,1430 (*optName).source);1431 }1432 } else {1433 if (currScope().symbol()) {1434 AddRoutineInfoToSymbol(*currScope().symbol(), x);1435 }1436 }1437 return true;1438}1439 1440bool AccAttributeVisitor::Pre(const parser::AccBindClause &x) {1441 if (const auto *name{std::get_if<parser::Name>(&x.u)}) {1442 if (!ResolveFctName(*name)) {1443 context_.Say(name->source,1444 "No function or subroutine declared for '%s'"_err_en_US,1445 name->source);1446 }1447 }1448 return true;1449}1450 1451bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {1452 const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};1453 const auto &combinedDir{1454 std::get<parser::AccCombinedDirective>(beginBlockDir.t)};1455 switch (combinedDir.v) {1456 case llvm::acc::Directive::ACCD_kernels_loop:1457 case llvm::acc::Directive::ACCD_parallel_loop:1458 case llvm::acc::Directive::ACCD_serial_loop:1459 PushContext(x.source, combinedDir.v);1460 break;1461 default:1462 break;1463 }1464 const auto &clauseList{std::get<parser::AccClauseList>(beginBlockDir.t)};1465 SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));1466 const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};1467 CheckAssociatedLoop(*outer, HasForceCollapseModifier(clauseList));1468 ClearDataSharingAttributeObjects();1469 return true;1470}1471 1472static bool IsLastNameArray(const parser::Designator &designator) {1473 const auto &name{GetLastName(designator)};1474 const evaluate::DataRef dataRef{*(name.symbol)};1475 return common::visit(1476 common::visitors{1477 [](const evaluate::SymbolRef &ref) {1478 return ref->Rank() > 0 ||1479 ref->GetType()->category() == DeclTypeSpec::Numeric;1480 },1481 [](const evaluate::ArrayRef &aref) {1482 return aref.base().IsSymbol() ||1483 aref.base().GetComponent().base().Rank() == 0;1484 },1485 [](const auto &) { return false; },1486 },1487 dataRef.u);1488}1489 1490void AccAttributeVisitor::AllowOnlyArrayAndSubArray(1491 const parser::AccObjectList &objectList) {1492 for (const auto &accObject : objectList.v) {1493 common::visit(1494 common::visitors{1495 [&](const parser::Designator &designator) {1496 if (!IsLastNameArray(designator)) {1497 context_.Say(designator.source,1498 "Only array element or subarray are allowed in %s directive"_err_en_US,1499 parser::ToUpperCaseLetters(1500 llvm::acc::getOpenACCDirectiveName(1501 GetContext().directive)1502 .str()));1503 }1504 },1505 [&](const auto &name) {1506 context_.Say(name.source,1507 "Only array element or subarray are allowed in %s directive"_err_en_US,1508 parser::ToUpperCaseLetters(1509 llvm::acc::getOpenACCDirectiveName(GetContext().directive)1510 .str()));1511 },1512 },1513 accObject.u);1514 }1515}1516 1517void AccAttributeVisitor::DoNotAllowAssumedSizedArray(1518 const parser::AccObjectList &objectList) {1519 for (const auto &accObject : objectList.v) {1520 common::visit(1521 common::visitors{1522 [&](const parser::Designator &designator) {1523 const auto &name{GetLastName(designator)};1524 if (name.symbol && semantics::IsAssumedSizeArray(*name.symbol)) {1525 context_.Say(designator.source,1526 "Assumed-size dummy arrays may not appear on the %s "1527 "directive"_err_en_US,1528 parser::ToUpperCaseLetters(1529 llvm::acc::getOpenACCDirectiveName(1530 GetContext().directive)1531 .str()));1532 }1533 },1534 [&](const auto &name) {1535 1536 },1537 },1538 accObject.u);1539 }1540}1541 1542void AccAttributeVisitor::AllowOnlyVariable(const parser::AccObject &object) {1543 common::visit(1544 common::visitors{1545 [&](const parser::Designator &designator) {1546 const auto &name{GetLastName(designator)};1547 if (name.symbol && !semantics::IsVariableName(*name.symbol) &&1548 !semantics::IsNamedConstant(*name.symbol)) {1549 context_.Say(designator.source,1550 "Only variables are allowed in data clauses on the %s "1551 "directive"_err_en_US,1552 parser::ToUpperCaseLetters(1553 llvm::acc::getOpenACCDirectiveName(GetContext().directive)1554 .str()));1555 }1556 },1557 [&](const auto &name) {},1558 },1559 object.u);1560}1561 1562bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {1563 const auto &verbatim{std::get<parser::Verbatim>(x.t)};1564 PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);1565 ClearDataSharingAttributeObjects();1566 1567 const auto &objectListWithModifier =1568 std::get<parser::AccObjectListWithModifier>(x.t);1569 const auto &objectList =1570 std::get<Fortran::parser::AccObjectList>(objectListWithModifier.t);1571 1572 // 2.10 Cache directive restriction: A var in a cache directive must be a1573 // single array element or a simple subarray.1574 AllowOnlyArrayAndSubArray(objectList);1575 1576 return true;1577}1578 1579bool AccAttributeVisitor::HasForceCollapseModifier(1580 const parser::AccClauseList &x) {1581 for (const auto &clause : x.v) {1582 if (const auto *collapseClause{1583 std::get_if<parser::AccClause::Collapse>(&clause.u)}) {1584 const parser::AccCollapseArg &arg = collapseClause->v;1585 return std::get<bool>(arg.t);1586 }1587 }1588 return false;1589}1590 1591std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(1592 const parser::AccClauseList &x) {1593 std::int64_t collapseLevel{0};1594 for (const auto &clause : x.v) {1595 if (const auto *collapseClause{1596 std::get_if<parser::AccClause::Collapse>(&clause.u)}) {1597 const parser::AccCollapseArg &arg = collapseClause->v;1598 const auto &collapseValue{std::get<parser::ScalarIntConstantExpr>(arg.t)};1599 if (const auto v{EvaluateInt64(context_, collapseValue)}) {1600 collapseLevel = *v;1601 }1602 }1603 }1604 1605 if (collapseLevel) {1606 return collapseLevel;1607 }1608 return 1; // default is outermost loop1609}1610 1611void AccAttributeVisitor::CheckAssociatedLoop(1612 const parser::DoConstruct &outerDoConstruct, bool forceCollapsed) {1613 std::int64_t level{GetContext().associatedLoopLevel};1614 if (level <= 0) { // collapse value was negative or 01615 return;1616 }1617 1618 const auto getNextDoConstruct =1619 [this, forceCollapsed](const parser::Block &block,1620 std::int64_t &level) -> const parser::DoConstruct * {1621 for (const auto &entry : block) {1622 if (const auto *doConstruct = GetDoConstructIf(entry)) {1623 return doConstruct;1624 } else if (parser::Unwrap<parser::CompilerDirective>(entry)) {1625 // It is allowed to have a compiler directive associated with the loop.1626 continue;1627 } else if (const auto &accLoop{1628 parser::Unwrap<parser::OpenACCLoopConstruct>(entry)}) {1629 if (level == 0)1630 break;1631 const auto &beginDir{1632 std::get<parser::AccBeginLoopDirective>(accLoop->t)};1633 context_.Say(beginDir.source,1634 "LOOP directive not expected in COLLAPSE loop nest"_err_en_US);1635 level = 0;1636 } else {1637 if (!forceCollapsed) {1638 break;1639 }1640 }1641 }1642 return nullptr;1643 };1644 1645 auto checkExprHasSymbols = [&](llvm::SmallVector<Symbol *> &ivs,1646 semantics::UnorderedSymbolSet &symbols) {1647 for (auto iv : ivs) {1648 if (symbols.count(*iv) != 0) {1649 context_.Say(GetContext().directiveSource,1650 "Trip count must be computable and invariant"_err_en_US);1651 }1652 }1653 };1654 1655 Symbol::Flag flag = Symbol::Flag::AccPrivate;1656 llvm::SmallVector<Symbol *> ivs;1657 using Bounds = parser::LoopControl::Bounds;1658 for (const parser::DoConstruct *loop{&outerDoConstruct}; loop && level > 0;) {1659 // Go through all nested loops to ensure index variable exists.1660 if (const parser::Name * ivName{GetLoopIndex(*loop)}) {1661 if (auto *symbol{ResolveAcc(*ivName, flag, currScope())}) {1662 if (auto &control{loop->GetLoopControl()}) {1663 if (const Bounds * b{std::get_if<Bounds>(&control->u)}) {1664 if (auto lowerExpr{semantics::AnalyzeExpr(context_, b->lower)}) {1665 semantics::UnorderedSymbolSet lowerSyms =1666 evaluate::CollectSymbols(*lowerExpr);1667 checkExprHasSymbols(ivs, lowerSyms);1668 }1669 if (auto upperExpr{semantics::AnalyzeExpr(context_, b->upper)}) {1670 semantics::UnorderedSymbolSet upperSyms =1671 evaluate::CollectSymbols(*upperExpr);1672 checkExprHasSymbols(ivs, upperSyms);1673 }1674 }1675 }1676 ivs.push_back(symbol);1677 }1678 }1679 1680 const auto &block{std::get<parser::Block>(loop->t)};1681 --level;1682 loop = getNextDoConstruct(block, level);1683 }1684 CHECK(level == 0);1685}1686 1687void AccAttributeVisitor::EnsureAllocatableOrPointer(1688 const llvm::acc::Clause clause, const parser::AccObjectList &objectList) {1689 for (const auto &accObject : objectList.v) {1690 common::visit(1691 common::visitors{1692 [&](const parser::Designator &designator) {1693 const auto &lastName{GetLastName(designator)};1694 if (!IsAllocatableOrObjectPointer(lastName.symbol)) {1695 context_.Say(designator.source,1696 "Argument `%s` on the %s clause must be a variable or "1697 "array with the POINTER or ALLOCATABLE attribute"_err_en_US,1698 lastName.symbol->name(),1699 parser::ToUpperCaseLetters(1700 llvm::acc::getOpenACCClauseName(clause).str()));1701 }1702 },1703 [&](const auto &name) {1704 context_.Say(name.source,1705 "Argument on the %s clause must be a variable or "1706 "array with the POINTER or ALLOCATABLE attribute"_err_en_US,1707 parser::ToUpperCaseLetters(1708 llvm::acc::getOpenACCClauseName(clause).str()));1709 },1710 },1711 accObject.u);1712 }1713}1714 1715bool AccAttributeVisitor::Pre(const parser::AccClause::Attach &x) {1716 // Restriction - line 1708-17091717 EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_attach, x.v);1718 return true;1719}1720 1721bool AccAttributeVisitor::Pre(const parser::AccClause::Detach &x) {1722 // Restriction - line 1715-17171723 EnsureAllocatableOrPointer(llvm::acc::Clause::ACCC_detach, x.v);1724 return true;1725}1726 1727void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {1728 if (!dirContext_.empty()) {1729 switch (x.v) {1730 case llvm::acc::DefaultValue::ACC_Default_present:1731 SetContextDefaultDSA(Symbol::Flag::AccPresent);1732 break;1733 case llvm::acc::DefaultValue::ACC_Default_none:1734 SetContextDefaultDSA(Symbol::Flag::AccNone);1735 break;1736 }1737 }1738}1739 1740void AccAttributeVisitor::Post(const parser::Name &name) {1741 if (name.symbol && WithinConstruct()) {1742 const Symbol &symbol{name.symbol->GetUltimate()};1743 if (!symbol.owner().IsDerivedType() && !symbol.has<ProcEntityDetails>() &&1744 !symbol.has<SubprogramDetails>() && !IsObjectWithVisibleDSA(symbol)) {1745 if (Symbol * found{currScope().FindSymbol(name.source)}) {1746 if (&symbol != found) {1747 // adjust the symbol within the region1748 // TODO: why didn't name resolution set the right name originally?1749 name.symbol = found;1750 } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {1751 // 2.5.14.1752 context_.Say(name.source,1753 "The DEFAULT(NONE) clause requires that '%s' must be listed in a data-mapping clause"_err_en_US,1754 symbol.name());1755 }1756 } else {1757 // TODO: assertion here? or clear name.symbol?1758 }1759 }1760 }1761}1762 1763Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(1764 const parser::Name *name) {1765 if (name) {1766 if (Symbol *1767 cb{GetContext().scope.FindCommonBlockInVisibleScopes(name->source)}) {1768 name->symbol = cb;1769 return cb;1770 }1771 }1772 return nullptr;1773}1774 1775void AccAttributeVisitor::ResolveAccObjectList(1776 const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {1777 for (const auto &accObject : accObjectList.v) {1778 AllowOnlyVariable(accObject);1779 ResolveAccObject(accObject, accFlag);1780 }1781}1782 1783void AccAttributeVisitor::ResolveAccObject(1784 const parser::AccObject &accObject, Symbol::Flag accFlag) {1785 common::visit(1786 common::visitors{1787 [&](const parser::Designator &designator) {1788 if (const auto *name{1789 parser::GetDesignatorNameIfDataRef(designator)}) {1790 if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) {1791 AddToContextObjectWithDSA(*symbol, accFlag);1792 if (dataSharingAttributeFlags.test(accFlag)) {1793 CheckMultipleAppearances(*name, *symbol, accFlag);1794 }1795 }1796 } else {1797 // Array sections to be changed to substrings as needed1798 if (AnalyzeExpr(context_, designator)) {1799 if (std::holds_alternative<parser::Substring>(designator.u)) {1800 context_.Say(designator.source,1801 "Substrings are not allowed on OpenACC "1802 "directives or clauses"_err_en_US);1803 }1804 }1805 // other checks, more TBD1806 }1807 },1808 [&](const parser::Name &name) { // common block1809 if (auto *symbol{ResolveAccCommonBlockName(&name)}) {1810 CheckMultipleAppearances(1811 name, *symbol, Symbol::Flag::AccCommonBlock);1812 for (auto &object : symbol->get<CommonBlockDetails>().objects()) {1813 if (auto *resolvedObject{1814 ResolveAcc(*object, accFlag, currScope())}) {1815 AddToContextObjectWithDSA(*resolvedObject, accFlag);1816 }1817 }1818 } else {1819 context_.Say(name.source,1820 "Could not find COMMON block '%s' used in OpenACC directive"_err_en_US,1821 name.ToString());1822 }1823 },1824 },1825 accObject.u);1826}1827 1828Symbol *AccAttributeVisitor::ResolveAcc(1829 const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {1830 return DeclareOrMarkOtherAccessEntity(name, accFlag);1831}1832 1833Symbol *AccAttributeVisitor::ResolveAcc(1834 Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {1835 return DeclareOrMarkOtherAccessEntity(symbol, accFlag);1836}1837 1838Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(1839 const parser::Name &name, Symbol::Flag accFlag) {1840 if (name.symbol) {1841 return DeclareOrMarkOtherAccessEntity(*name.symbol, accFlag);1842 } else {1843 return nullptr;1844 }1845}1846 1847Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(1848 Symbol &object, Symbol::Flag accFlag) {1849 if (accFlagsRequireMark.test(accFlag)) {1850 if (GetContext().directive == llvm::acc::ACCD_declare) {1851 object.set(Symbol::Flag::AccDeclare);1852 object.set(accFlag);1853 }1854 }1855 return &object;1856}1857 1858static bool WithMultipleAppearancesAccException(1859 const Symbol &symbol, Symbol::Flag flag) {1860 return false; // Place holder1861}1862 1863void AccAttributeVisitor::CheckMultipleAppearances(1864 const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) {1865 const auto *target{&symbol};1866 if (HasDataSharingAttributeObject(*target) &&1867 !WithMultipleAppearancesAccException(symbol, accFlag)) {1868 context_.Say(name.source,1869 "'%s' appears in more than one data-sharing clause "1870 "on the same OpenACC directive"_err_en_US,1871 name.ToString());1872 } else {1873 AddDataSharingAttributeObject(*target);1874 }1875}1876 1877#ifndef NDEBUG1878 1879#define DEBUG_TYPE "omp"1880 1881static llvm::raw_ostream &operator<<(1882 llvm::raw_ostream &os, const Symbol::Flags &flags);1883 1884namespace dbg {1885static void DumpAssocSymbols(llvm::raw_ostream &os, const Symbol &sym);1886static std::string ScopeSourcePos(const Fortran::semantics::Scope &scope);1887} // namespace dbg1888 1889#endif1890 1891bool OmpAttributeVisitor::Pre(const parser::OmpBlockConstruct &x) {1892 const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};1893 llvm::omp::Directive dirId{dirSpec.DirId()};1894 switch (dirId) {1895 case llvm::omp::Directive::OMPD_masked:1896 case llvm::omp::Directive::OMPD_parallel_masked:1897 case llvm::omp::Directive::OMPD_master:1898 case llvm::omp::Directive::OMPD_parallel_master:1899 case llvm::omp::Directive::OMPD_ordered:1900 case llvm::omp::Directive::OMPD_parallel:1901 case llvm::omp::Directive::OMPD_scope:1902 case llvm::omp::Directive::OMPD_single:1903 case llvm::omp::Directive::OMPD_target:1904 case llvm::omp::Directive::OMPD_target_data:1905 case llvm::omp::Directive::OMPD_task:1906 case llvm::omp::Directive::OMPD_taskgraph:1907 case llvm::omp::Directive::OMPD_taskgroup:1908 case llvm::omp::Directive::OMPD_teams:1909 case llvm::omp::Directive::OMPD_workdistribute:1910 case llvm::omp::Directive::OMPD_workshare:1911 case llvm::omp::Directive::OMPD_parallel_workshare:1912 case llvm::omp::Directive::OMPD_target_teams:1913 case llvm::omp::Directive::OMPD_target_teams_workdistribute:1914 case llvm::omp::Directive::OMPD_target_parallel:1915 case llvm::omp::Directive::OMPD_teams_workdistribute:1916 PushContext(dirSpec.source, dirId);1917 break;1918 default:1919 // TODO others1920 break;1921 }1922 if (dirId == llvm::omp::Directive::OMPD_master ||1923 dirId == llvm::omp::Directive::OMPD_parallel_master)1924 IssueNonConformanceWarning(dirId, dirSpec.source, 52);1925 ClearDataSharingAttributeObjects();1926 ClearPrivateDataSharingAttributeObjects();1927 ClearAllocateNames();1928 return true;1929}1930 1931void OmpAttributeVisitor::Post(const parser::OmpBlockConstruct &x) {1932 const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};1933 llvm::omp::Directive dirId{dirSpec.DirId()};1934 switch (dirId) {1935 case llvm::omp::Directive::OMPD_masked:1936 case llvm::omp::Directive::OMPD_master:1937 case llvm::omp::Directive::OMPD_parallel_masked:1938 case llvm::omp::Directive::OMPD_parallel_master:1939 case llvm::omp::Directive::OMPD_parallel:1940 case llvm::omp::Directive::OMPD_scope:1941 case llvm::omp::Directive::OMPD_single:1942 case llvm::omp::Directive::OMPD_target:1943 case llvm::omp::Directive::OMPD_task:1944 case llvm::omp::Directive::OMPD_teams:1945 case llvm::omp::Directive::OMPD_workdistribute:1946 case llvm::omp::Directive::OMPD_parallel_workshare:1947 case llvm::omp::Directive::OMPD_target_teams:1948 case llvm::omp::Directive::OMPD_target_parallel:1949 case llvm::omp::Directive::OMPD_target_teams_workdistribute:1950 case llvm::omp::Directive::OMPD_teams_workdistribute: {1951 bool hasPrivate;1952 for (const auto *allocName : allocateNames_) {1953 hasPrivate = false;1954 for (auto privateObj : privateDataSharingAttributeObjects_) {1955 const Symbol &symbolPrivate{*privateObj};1956 if (allocName->source == symbolPrivate.name()) {1957 hasPrivate = true;1958 break;1959 }1960 }1961 if (!hasPrivate) {1962 context_.Say(allocName->source,1963 "The ALLOCATE clause requires that '%s' must be listed in a "1964 "private "1965 "data-sharing attribute clause on the same directive"_err_en_US,1966 allocName->ToString());1967 }1968 }1969 break;1970 }1971 default:1972 break;1973 }1974 PopContext();1975}1976 1977bool OmpAttributeVisitor::Pre(1978 const parser::OpenMPSimpleStandaloneConstruct &x) {1979 const auto &standaloneDir{std::get<parser::OmpDirectiveName>(x.v.t)};1980 switch (standaloneDir.v) {1981 case llvm::omp::Directive::OMPD_barrier:1982 case llvm::omp::Directive::OMPD_ordered:1983 case llvm::omp::Directive::OMPD_scan:1984 case llvm::omp::Directive::OMPD_target_enter_data:1985 case llvm::omp::Directive::OMPD_target_exit_data:1986 case llvm::omp::Directive::OMPD_target_update:1987 case llvm::omp::Directive::OMPD_taskwait:1988 case llvm::omp::Directive::OMPD_taskyield:1989 PushContext(standaloneDir.source, standaloneDir.v);1990 break;1991 default:1992 break;1993 }1994 ClearDataSharingAttributeObjects();1995 return true;1996}1997 1998bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {1999 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};2000 const parser::OmpDirectiveName &beginName{beginSpec.DirName()};2001 switch (beginName.v) {2002 case llvm::omp::Directive::OMPD_distribute:2003 case llvm::omp::Directive::OMPD_distribute_parallel_do:2004 case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:2005 case llvm::omp::Directive::OMPD_distribute_simd:2006 case llvm::omp::Directive::OMPD_do:2007 case llvm::omp::Directive::OMPD_do_simd:2008 case llvm::omp::Directive::OMPD_loop:2009 case llvm::omp::Directive::OMPD_masked_taskloop_simd:2010 case llvm::omp::Directive::OMPD_masked_taskloop:2011 case llvm::omp::Directive::OMPD_master_taskloop_simd:2012 case llvm::omp::Directive::OMPD_master_taskloop:2013 case llvm::omp::Directive::OMPD_parallel_do:2014 case llvm::omp::Directive::OMPD_parallel_do_simd:2015 case llvm::omp::Directive::OMPD_parallel_masked_taskloop_simd:2016 case llvm::omp::Directive::OMPD_parallel_masked_taskloop:2017 case llvm::omp::Directive::OMPD_parallel_master_taskloop_simd:2018 case llvm::omp::Directive::OMPD_parallel_master_taskloop:2019 case llvm::omp::Directive::OMPD_simd:2020 case llvm::omp::Directive::OMPD_target_loop:2021 case llvm::omp::Directive::OMPD_target_parallel_do:2022 case llvm::omp::Directive::OMPD_target_parallel_do_simd:2023 case llvm::omp::Directive::OMPD_target_parallel_loop:2024 case llvm::omp::Directive::OMPD_target_teams_distribute:2025 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:2026 case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:2027 case llvm::omp::Directive::OMPD_target_teams_distribute_simd:2028 case llvm::omp::Directive::OMPD_target_teams_loop:2029 case llvm::omp::Directive::OMPD_target_simd:2030 case llvm::omp::Directive::OMPD_taskloop:2031 case llvm::omp::Directive::OMPD_taskloop_simd:2032 case llvm::omp::Directive::OMPD_teams_distribute:2033 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:2034 case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:2035 case llvm::omp::Directive::OMPD_teams_distribute_simd:2036 case llvm::omp::Directive::OMPD_teams_loop:2037 case llvm::omp::Directive::OMPD_fuse:2038 case llvm::omp::Directive::OMPD_tile:2039 case llvm::omp::Directive::OMPD_unroll:2040 PushContext(beginName.source, beginName.v);2041 break;2042 default:2043 break;2044 }2045 if (beginName.v == llvm::omp::OMPD_master_taskloop ||2046 beginName.v == llvm::omp::OMPD_master_taskloop_simd ||2047 beginName.v == llvm::omp::OMPD_parallel_master_taskloop ||2048 beginName.v == llvm::omp::OMPD_parallel_master_taskloop_simd) {2049 unsigned version{context_.langOptions().OpenMPVersion};2050 IssueNonConformanceWarning(beginName.v, beginName.source, version);2051 }2052 ClearDataSharingAttributeObjects();2053 SetContextAssociatedLoopLevel(GetNumAffectedLoopsFromLoopConstruct(x));2054 2055 if (beginName.v == llvm::omp::Directive::OMPD_do) {2056 if (const parser::DoConstruct *doConstruct{x.GetNestedLoop()}) {2057 if (doConstruct->IsDoWhile()) {2058 return true;2059 }2060 }2061 }2062 2063 // Must be done before iv privatization2064 CheckPerfectNestAndRectangularLoop(x);2065 2066 PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);2067 ordCollapseLevel = GetNumAffectedLoopsFromLoopConstruct(x) + 1;2068 return true;2069}2070 2071void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(2072 const parser::Name &iv) {2073 // Find the parallel or task generating construct enclosing the2074 // sequential loop.2075 auto targetIt{dirContext_.rbegin()};2076 for (;; ++targetIt) {2077 if (targetIt == dirContext_.rend()) {2078 return;2079 }2080 if (llvm::omp::allParallelSet.test(targetIt->directive) ||2081 llvm::omp::taskGeneratingSet.test(targetIt->directive)) {2082 break;2083 }2084 }2085 // If this symbol already has a data-sharing attribute then there is nothing2086 // to do here.2087 if (const Symbol * symbol{iv.symbol}) {2088 for (auto symMap : targetIt->objectWithDSA) {2089 if (symMap.first->name() == symbol->name()) {2090 return;2091 }2092 }2093 }2094 // If this symbol already has an explicit data-sharing attribute in the2095 // enclosing OpenMP parallel or task then there is nothing to do here.2096 if (auto *symbol{targetIt->scope.FindSymbol(iv.source)}) {2097 if (symbol->owner() == targetIt->scope) {2098 if (symbol->test(Symbol::Flag::OmpExplicit) &&2099 (symbol->flags() & dataSharingAttributeFlags).any()) {2100 return;2101 }2102 }2103 }2104 // Otherwise find the symbol and make it Private for the entire enclosing2105 // parallel or task2106 if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) {2107 targetIt++;2108 SetSymbolDSA(2109 *symbol, {Symbol::Flag::OmpPreDetermined, Symbol::Flag::OmpPrivate});2110 iv.symbol = symbol; // adjust the symbol within region2111 for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) {2112 AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it);2113 }2114 }2115}2116 2117// [OMP-4.5]2.15.1.1 Data-sharing Attribute Rules - Predetermined2118// - A loop iteration variable for a sequential loop in a parallel2119// or task generating construct is private in the innermost such2120// construct that encloses the loop2121// Loop iteration variables are not well defined for DO WHILE loop.2122// Use of DO CONCURRENT inside OpenMP construct is unspecified behavior2123// till OpenMP-5.0 standard.2124// In above both cases we skip the privatization of iteration variables.2125bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {2126 if (WithinConstruct()) {2127 llvm::SmallVector<const parser::Name *> ivs;2128 if (x.IsDoNormal()) {2129 const parser::Name *iv{GetLoopIndex(x)};2130 if (iv && iv->symbol)2131 ivs.push_back(iv);2132 }2133 ordCollapseLevel--;2134 for (auto iv : ivs) {2135 if (!iv->symbol->test(Symbol::Flag::OmpPreDetermined)) {2136 ResolveSeqLoopIndexInParallelOrTaskConstruct(*iv);2137 } else {2138 // TODO: conflict checks with explicitly determined DSA2139 }2140 if (ordCollapseLevel) {2141 if (const auto *details{iv->symbol->detailsIf<HostAssocDetails>()}) {2142 const Symbol *tpSymbol = &details->symbol();2143 if (tpSymbol->test(Symbol::Flag::OmpThreadprivate)) {2144 context_.Say(iv->source,2145 "Loop iteration variable %s is not allowed in THREADPRIVATE."_err_en_US,2146 iv->ToString());2147 }2148 }2149 }2150 }2151 }2152 return true;2153}2154 2155static bool isSizesClause(const parser::OmpClause *clause) {2156 return std::holds_alternative<parser::OmpClause::Sizes>(clause->u);2157}2158 2159std::int64_t OmpAttributeVisitor::SetAssociatedMaxClause(2160 llvm::SmallVector<std::int64_t> &levels,2161 llvm::SmallVector<const parser::OmpClause *> &clauses) {2162 2163 // Find the tile level to ensure that the COLLAPSE clause value2164 // does not exeed the number of tiled loops.2165 std::int64_t tileLevel = 0;2166 for (auto [level, clause] : llvm::zip_equal(levels, clauses))2167 if (isSizesClause(clause))2168 tileLevel = level;2169 2170 std::int64_t maxLevel = 1;2171 const parser::OmpClause *maxClause = nullptr;2172 for (auto [level, clause] : llvm::zip_equal(levels, clauses)) {2173 if (tileLevel > 0 && tileLevel < level) {2174 context_.Say(clause->source,2175 "The value of the parameter in the COLLAPSE clause must"2176 " not be larger than the number of the number of tiled loops"2177 " because collapse currently is limited to independent loop"2178 " iterations."_err_en_US);2179 return 1;2180 }2181 2182 if (level > maxLevel) {2183 maxLevel = level;2184 maxClause = clause;2185 }2186 }2187 if (maxClause)2188 SetAssociatedClause(maxClause);2189 return maxLevel;2190}2191 2192std::int64_t OmpAttributeVisitor::GetNumAffectedLoopsFromLoopConstruct(2193 const parser::OpenMPLoopConstruct &x) {2194 llvm::SmallVector<std::int64_t> levels;2195 llvm::SmallVector<const parser::OmpClause *> clauses;2196 2197 CollectNumAffectedLoopsFromLoopConstruct(x, levels, clauses);2198 return SetAssociatedMaxClause(levels, clauses);2199}2200 2201void OmpAttributeVisitor::CollectNumAffectedLoopsFromLoopConstruct(2202 const parser::OpenMPLoopConstruct &x,2203 llvm::SmallVector<std::int64_t> &levels,2204 llvm::SmallVector<const parser::OmpClause *> &clauses) {2205 const auto &clauseList{x.BeginDir().Clauses()};2206 2207 CollectNumAffectedLoopsFromClauses(clauseList, levels, clauses);2208 CollectNumAffectedLoopsFromInnerLoopContruct(x, levels, clauses);2209}2210 2211void OmpAttributeVisitor::CollectNumAffectedLoopsFromInnerLoopContruct(2212 const parser::OpenMPLoopConstruct &x,2213 llvm::SmallVector<std::int64_t> &levels,2214 llvm::SmallVector<const parser::OmpClause *> &clauses) {2215 for (auto &construct : std::get<parser::Block>(x.t)) {2216 if (auto *innerConstruct{parser::omp::GetOmpLoop(construct)}) {2217 CollectNumAffectedLoopsFromLoopConstruct(2218 *innerConstruct, levels, clauses);2219 }2220 }2221}2222 2223void OmpAttributeVisitor::CollectNumAffectedLoopsFromClauses(2224 const parser::OmpClauseList &x, llvm::SmallVector<std::int64_t> &levels,2225 llvm::SmallVector<const parser::OmpClause *> &clauses) {2226 for (const auto &clause : x.v) {2227 if (const auto oclause{2228 std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {2229 std::int64_t level = 0;2230 if (const auto v{EvaluateInt64(context_, oclause->v)}) {2231 level = *v;2232 }2233 levels.push_back(level);2234 clauses.push_back(&clause);2235 }2236 2237 if (const auto cclause{2238 std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {2239 std::int64_t level = 0;2240 if (const auto v{EvaluateInt64(context_, cclause->v)}) {2241 level = *v;2242 }2243 levels.push_back(level);2244 clauses.push_back(&clause);2245 }2246 2247 if (const auto tclause{std::get_if<parser::OmpClause::Sizes>(&clause.u)}) {2248 levels.push_back(tclause->v.size());2249 clauses.push_back(&clause);2250 }2251 }2252}2253 2254void OmpAttributeVisitor::CheckPerfectNestAndRectangularLoop(2255 const parser::OpenMPLoopConstruct &x) {2256 auto &dirContext{GetContext()};2257 std::int64_t dirDepth{dirContext.associatedLoopLevel};2258 if (dirDepth <= 0)2259 return;2260 2261 auto checkExprHasSymbols = [&](llvm::SmallVector<Symbol *> &ivs,2262 const parser::ScalarExpr *bound) {2263 if (ivs.empty())2264 return;2265 auto boundExpr{semantics::AnalyzeExpr(context_, *bound)};2266 if (!boundExpr)2267 return;2268 semantics::UnorderedSymbolSet boundSyms{2269 evaluate::CollectSymbols(*boundExpr)};2270 if (boundSyms.empty())2271 return;2272 for (Symbol *iv : ivs) {2273 if (boundSyms.count(*iv) != 0) {2274 // TODO: Point to occurence of iv in boundExpr, directiveSource as a2275 // note2276 context_.Say(dirContext.directiveSource,2277 "Trip count must be computable and invariant"_err_en_US);2278 }2279 }2280 };2281 2282 // Find the associated region by skipping nested loop-associated constructs2283 // such as loop transformations2284 for (auto &construct : std::get<parser::Block>(x.t)) {2285 if (const auto *innermostConstruct{parser::omp::GetOmpLoop(construct)}) {2286 CheckPerfectNestAndRectangularLoop(*innermostConstruct);2287 } else if (const auto *doConstruct{2288 parser::omp::GetDoConstruct(construct)}) {2289 2290 llvm::SmallVector<Symbol *> ivs;2291 int curLevel{0};2292 const auto *loop{doConstruct};2293 while (true) {2294 auto [iv, lb, ub, step] = GetLoopBounds(*loop);2295 2296 if (lb)2297 checkExprHasSymbols(ivs, lb);2298 if (ub)2299 checkExprHasSymbols(ivs, ub);2300 if (step)2301 checkExprHasSymbols(ivs, step);2302 if (iv) {2303 if (auto *symbol{currScope().FindSymbol(iv->source)})2304 ivs.push_back(symbol);2305 }2306 2307 // Stop after processing all affected loops2308 if (curLevel + 1 >= dirDepth)2309 break;2310 2311 // Recurse into nested loop2312 const auto &block{std::get<parser::Block>(loop->t)};2313 if (block.empty()) {2314 // Insufficient number of nested loops already reported by2315 // CheckAssocLoopLevel()2316 break;2317 }2318 2319 loop = GetDoConstructIf(block.front());2320 if (!loop) {2321 // Insufficient number of nested loops already reported by2322 // CheckAssocLoopLevel()2323 break;2324 }2325 2326 auto checkPerfectNest = [&, this]() {2327 if (block.empty())2328 return;2329 auto last = block.end();2330 --last;2331 2332 // A trailing CONTINUE is not considered part of the loop body2333 if (parser::Unwrap<parser::ContinueStmt>(*last))2334 --last;2335 2336 // In a perfectly nested loop, the nested loop must be the only2337 // statement2338 if (last == block.begin())2339 return;2340 2341 // Non-perfectly nested loop2342 // TODO: Point to non-DO statement, directiveSource as a note2343 context_.Say(dirContext.directiveSource,2344 "Canonical loop nest must be perfectly nested."_err_en_US);2345 };2346 2347 checkPerfectNest();2348 2349 ++curLevel;2350 }2351 }2352 }2353}2354 2355// 2.15.1.1 Data-sharing Attribute Rules - Predetermined2356// - The loop iteration variable(s) in the associated do-loop(s) of a do,2357// parallel do, taskloop, or distribute construct is (are) private.2358// - The loop iteration variable in the associated do-loop of a simd construct2359// with just one associated do-loop is linear with a linear-step that is the2360// increment of the associated do-loop.2361// - The loop iteration variables in the associated do-loops of a simd2362// construct with multiple associated do-loops are lastprivate.2363void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(2364 const parser::OpenMPLoopConstruct &x) {2365 std::int64_t level{GetContext().associatedLoopLevel};2366 if (level <= 0) {2367 return;2368 }2369 Symbol::Flag ivDSA;2370 if (!llvm::omp::allSimdSet.test(GetContext().directive)) {2371 ivDSA = Symbol::Flag::OmpPrivate;2372 } else if (level == 1) {2373 ivDSA = Symbol::Flag::OmpLinear;2374 } else {2375 ivDSA = Symbol::Flag::OmpLastPrivate;2376 }2377 2378 bool isLoopConstruct{2379 GetContext().directive == llvm::omp::Directive::OMPD_loop};2380 const parser::OmpClause *clause{GetAssociatedClause()};2381 bool hasCollapseClause{2382 clause ? (clause->Id() == llvm::omp::OMPC_collapse) : false};2383 2384 for (auto &construct : std::get<parser::Block>(x.t)) {2385 if (const auto *innermostConstruct{parser::omp::GetOmpLoop(construct)}) {2386 PrivatizeAssociatedLoopIndexAndCheckLoopLevel(*innermostConstruct);2387 } else if (const auto *doConstruct{2388 parser::omp::GetDoConstruct(construct)}) {2389 for (const parser::DoConstruct *loop{&*doConstruct}; loop && level > 0;2390 --level) {2391 if (loop->IsDoConcurrent()) {2392 // DO CONCURRENT is explicitly allowed for the LOOP construct so long2393 // as there isn't a COLLAPSE clause2394 if (isLoopConstruct) {2395 if (hasCollapseClause) {2396 // hasCollapseClause implies clause != nullptr2397 context_.Say(clause->source,2398 "DO CONCURRENT loops cannot be used with the COLLAPSE clause."_err_en_US);2399 }2400 } else {2401 auto &stmt =2402 std::get<parser::Statement<parser::NonLabelDoStmt>>(loop->t);2403 context_.Say(stmt.source,2404 "DO CONCURRENT loops cannot form part of a loop nest."_err_en_US);2405 }2406 }2407 // go through all the nested do-loops and resolve index variables2408 const parser::Name *iv{GetLoopIndex(*loop)};2409 if (iv) {2410 if (auto *symbol{ResolveOmp(*iv, ivDSA, currScope())}) {2411 SetSymbolDSA(*symbol, {Symbol::Flag::OmpPreDetermined, ivDSA});2412 iv->symbol = symbol; // adjust the symbol within region2413 AddToContextObjectWithDSA(*symbol, ivDSA);2414 }2415 2416 const auto &block{std::get<parser::Block>(loop->t)};2417 const auto it{block.begin()};2418 loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;2419 }2420 }2421 CheckAssocLoopLevel(level, GetAssociatedClause());2422 }2423 }2424}2425 2426void OmpAttributeVisitor::CheckAssocLoopLevel(2427 std::int64_t level, const parser::OmpClause *clause) {2428 if (clause && level != 0) {2429 switch (clause->Id()) {2430 case llvm::omp::OMPC_sizes:2431 context_.Say(clause->source,2432 "The SIZES clause has more entries than there are nested canonical loops."_err_en_US);2433 break;2434 default:2435 context_.Say(clause->source,2436 "The value of the parameter in the COLLAPSE or ORDERED clause must"2437 " not be larger than the number of nested loops"2438 " following the construct."_err_en_US);2439 break;2440 }2441 }2442}2443 2444bool OmpAttributeVisitor::Pre(const parser::OpenMPGroupprivate &x) {2445 PushContext(x.source, llvm::omp::Directive::OMPD_groupprivate);2446 for (const parser::OmpArgument &arg : x.v.Arguments().v) {2447 if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {2448 if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {2449 ResolveOmpObject(*object, Symbol::Flag::OmpGroupPrivate);2450 }2451 }2452 }2453 return true;2454}2455 2456bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {2457 const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};2458 const parser::OmpDirectiveName &beginName{beginSpec.DirName()};2459 switch (beginName.v) {2460 case llvm::omp::Directive::OMPD_parallel_sections:2461 case llvm::omp::Directive::OMPD_sections:2462 PushContext(beginName.source, beginName.v);2463 GetContext().withinConstruct = true;2464 break;2465 default:2466 break;2467 }2468 ClearDataSharingAttributeObjects();2469 return true;2470}2471 2472bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionConstruct &x) {2473 PushContext(x.source, llvm::omp::Directive::OMPD_section);2474 GetContext().withinConstruct = true;2475 return true;2476}2477 2478bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) {2479 const parser::OmpBeginDirective &beginSpec{x.BeginDir()};2480 PushContext(beginSpec.DirName().source, beginSpec.DirName().v);2481 GetContext().withinConstruct = true;2482 return true;2483}2484 2485bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareTargetConstruct &x) {2486 PushContext(x.source, llvm::omp::Directive::OMPD_declare_target);2487 2488 for (const parser::OmpArgument &arg : x.v.Arguments().v) {2489 if (auto *object{omp::GetArgumentObject(arg)}) {2490 ResolveOmpObject(*object, Symbol::Flag::OmpDeclareTarget);2491 }2492 }2493 2494 for (const parser::OmpClause &clause : x.v.Clauses().v) {2495 if (auto *objects{parser::omp::GetOmpObjectList(clause)}) {2496 for (const parser::OmpObject &object : objects->v) {2497 ResolveOmpObject(object, Symbol::Flag::OmpDeclareTarget);2498 }2499 }2500 }2501 return true;2502}2503 2504bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) {2505 const parser::OmpDirectiveName &dirName{x.v.DirName()};2506 PushContext(dirName.source, dirName.v);2507 return true;2508}2509 2510bool OmpAttributeVisitor::Pre(2511 const parser::OpenMPDeclareReductionConstruct &x) {2512 PushContext(x.source, llvm::omp::Directive::OMPD_declare_reduction);2513 return true;2514}2515 2516bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {2517 const parser::OmpDirectiveName &dirName{x.v.DirName()};2518 PushContext(dirName.source, dirName.v);2519 2520 for (const parser::OmpArgument &arg : x.v.Arguments().v) {2521 if (auto *object{omp::GetArgumentObject(arg)}) {2522 ResolveOmpObject(*object, Symbol::Flag::OmpThreadprivate);2523 }2524 }2525 return true;2526}2527 2528bool OmpAttributeVisitor::Pre(const parser::OmpAllocateDirective &x) {2529 PushContext(x.source, llvm::omp::Directive::OMPD_allocate);2530 assert(!partStack_.empty() && "Misplaced directive");2531 2532 auto ompFlag{partStack_.back() == PartKind::SpecificationPart2533 ? Symbol::Flag::OmpDeclarativeAllocateDirective2534 : Symbol::Flag::OmpExecutableAllocateDirective};2535 2536 parser::omp::OmpAllocateInfo info{parser::omp::SplitOmpAllocate(x)};2537 for (const parser::OmpAllocateDirective *ad : info.dirs) {2538 for (const parser::OmpArgument &arg : ad->BeginDir().Arguments().v) {2539 if (auto *object{omp::GetArgumentObject(arg)}) {2540 ResolveOmpObject(*object, ompFlag);2541 }2542 }2543 }2544 2545 PopContext();2546 return false;2547}2548 2549bool OmpAttributeVisitor::Pre(const parser::OpenMPAssumeConstruct &x) {2550 PushContext(x.source, llvm::omp::Directive::OMPD_assume);2551 return true;2552}2553 2554bool OmpAttributeVisitor::Pre(const parser::OpenMPAtomicConstruct &x) {2555 PushContext(x.source, llvm::omp::Directive::OMPD_atomic);2556 return true;2557}2558 2559bool OmpAttributeVisitor::Pre(const parser::OpenMPDispatchConstruct &x) {2560 PushContext(x.source, llvm::omp::Directive::OMPD_dispatch);2561 return true;2562}2563 2564bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) {2565 const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};2566 PushContext(x.source, dirSpec.DirId());2567 2568 for (const auto &clause : dirSpec.Clauses().v) {2569 if (const auto *allocClause{2570 std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {2571 ResolveOmpObjectList(std::get<parser::OmpObjectList>(allocClause->v.t),2572 Symbol::Flag::OmpExecutableAllocateDirective);2573 }2574 }2575 return true;2576}2577 2578void OmpAttributeVisitor::Post(const parser::OmpClause::Defaultmap &x) {2579 using ImplicitBehavior = parser::OmpDefaultmapClause::ImplicitBehavior;2580 using VariableCategory = parser::OmpVariableCategory;2581 2582 VariableCategory::Value varCategory;2583 ImplicitBehavior impBehavior;2584 2585 if (!dirContext_.empty()) {2586 impBehavior = std::get<ImplicitBehavior>(x.v.t);2587 2588 auto &modifiers{OmpGetModifiers(x.v)};2589 auto *maybeCategory{2590 OmpGetUniqueModifier<parser::OmpVariableCategory>(modifiers)};2591 if (maybeCategory)2592 varCategory = maybeCategory->v;2593 else2594 varCategory = VariableCategory::Value::All;2595 2596 AddContextDefaultmapBehaviour(varCategory, impBehavior);2597 }2598}2599 2600void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {2601 // The DEFAULT clause may also be used on METADIRECTIVE. In that case2602 // there is nothing to do.2603 using DataSharingAttribute = parser::OmpDefaultClause::DataSharingAttribute;2604 if (auto *dsa{std::get_if<DataSharingAttribute>(&x.u)}) {2605 if (!dirContext_.empty()) {2606 switch (*dsa) {2607 case DataSharingAttribute::Private:2608 SetContextDefaultDSA(Symbol::Flag::OmpPrivate);2609 break;2610 case DataSharingAttribute::Firstprivate:2611 SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);2612 break;2613 case DataSharingAttribute::Shared:2614 SetContextDefaultDSA(Symbol::Flag::OmpShared);2615 break;2616 case DataSharingAttribute::None:2617 SetContextDefaultDSA(Symbol::Flag::OmpNone);2618 break;2619 }2620 }2621 }2622}2623 2624bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) {2625 if (dirContext_.size() >= 1) {2626 for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {2627 if (dirContext_[i - 1].directive == directive) {2628 return true;2629 }2630 }2631 }2632 return false;2633}2634 2635void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) {2636 PopContext();2637}2638 2639static bool IsPrivatizable(const Symbol *sym) {2640 auto *misc{sym->detailsIf<MiscDetails>()};2641 return IsVariableName(*sym) && !IsProcedure(*sym) && !IsNamedConstant(*sym) &&2642 ( // OpenMP 5.2, 5.1.1: Assumed-size arrays are shared2643 !semantics::IsAssumedSizeArray(*sym) ||2644 // If CrayPointer is among the DSA list then the2645 // CrayPointee is Privatizable2646 sym->test(Symbol::Flag::CrayPointee)) &&2647 !sym->owner().IsDerivedType() &&2648 sym->owner().kind() != Scope::Kind::ImpliedDos &&2649 sym->owner().kind() != Scope::Kind::Forall &&2650 !sym->detailsIf<semantics::AssocEntityDetails>() &&2651 !sym->detailsIf<semantics::NamelistDetails>() &&2652 (!misc ||2653 (misc->kind() != MiscDetails::Kind::ComplexPartRe &&2654 misc->kind() != MiscDetails::Kind::ComplexPartIm &&2655 misc->kind() != MiscDetails::Kind::KindParamInquiry &&2656 misc->kind() != MiscDetails::Kind::LenParamInquiry &&2657 misc->kind() != MiscDetails::Kind::ConstructName));2658}2659 2660static bool IsSymbolStaticStorageDuration(const Symbol &symbol) {2661 LLVM_DEBUG(llvm::dbgs() << "IsSymbolStaticStorageDuration(" << symbol.name()2662 << "):\n");2663 auto ultSym = symbol.GetUltimate();2664 // Module-scope variable2665 return (ultSym.owner().kind() == Scope::Kind::Module) ||2666 // Data statement variable2667 (ultSym.flags().test(Symbol::Flag::InDataStmt)) ||2668 // Save attribute variable2669 (ultSym.attrs().test(Attr::SAVE)) ||2670 // Referenced in a common block2671 (ultSym.flags().test(Symbol::Flag::InCommonBlock));2672}2673 2674static bool IsTargetCaptureImplicitlyFirstprivatizeable(const Symbol &symbol,2675 const Symbol::Flags &dsa, const Symbol::Flags &dataSharingAttributeFlags,2676 const Symbol::Flags &dataMappingAttributeFlags,2677 std::map<parser::OmpVariableCategory::Value,2678 parser::OmpDefaultmapClause::ImplicitBehavior>2679 defaultMap) {2680 // If a Defaultmap clause is present for the current target scope, and it has2681 // specified behaviour other than Firstprivate for scalars then we exit early,2682 // as it overrides the implicit Firstprivatization of scalars OpenMP rule.2683 if (!defaultMap.empty()) {2684 if (llvm::is_contained(2685 defaultMap, parser::OmpVariableCategory::Value::All) &&2686 defaultMap[parser::OmpVariableCategory::Value::All] !=2687 parser::OmpDefaultmapClause::ImplicitBehavior::Firstprivate) {2688 return false;2689 }2690 2691 if (llvm::is_contained(2692 defaultMap, parser::OmpVariableCategory::Value::Scalar) &&2693 defaultMap[parser::OmpVariableCategory::Value::Scalar] !=2694 parser::OmpDefaultmapClause::ImplicitBehavior::Firstprivate) {2695 return false;2696 }2697 }2698 2699 auto checkSymbol = [&](const Symbol &checkSym) {2700 // if we're associated with any other flags we skip implicit privitization2701 // for now. If we're an allocatable, pointer or declare target, we're not2702 // implicitly firstprivitizeable under OpenMP restrictions.2703 // TODO: Relax restriction as we progress privitization and further2704 // investigate the flags we can intermix with.2705 if (!(dsa & (dataSharingAttributeFlags | dataMappingAttributeFlags))2706 .none() ||2707 !checkSym.flags().none() || IsAssumedShape(checkSym) ||2708 semantics::IsAllocatableOrPointer(checkSym)) {2709 return false;2710 }2711 2712 // It is default firstprivatizeable as far as the OpenMP specification is2713 // concerned if it is a non-array scalar type that has been implicitly2714 // captured in a target region2715 const auto *type{checkSym.GetType()};2716 if ((!checkSym.GetShape() || checkSym.GetShape()->empty()) &&2717 (type->category() ==2718 Fortran::semantics::DeclTypeSpec::Category::Numeric ||2719 type->category() ==2720 Fortran::semantics::DeclTypeSpec::Category::Logical ||2721 type->category() ==2722 Fortran::semantics::DeclTypeSpec::Category::Character)) {2723 return true;2724 }2725 return false;2726 };2727 2728 return common::visit(2729 common::visitors{2730 [&](const UseDetails &x) -> bool { return checkSymbol(x.symbol()); },2731 [&](const HostAssocDetails &x) -> bool {2732 return checkSymbol(x.symbol());2733 },2734 [&](const auto &) -> bool { return checkSymbol(symbol); },2735 },2736 symbol.details());2737}2738 2739void OmpAttributeVisitor::CreateImplicitSymbols(const Symbol *symbol) {2740 if (!IsPrivatizable(symbol)) {2741 return;2742 }2743 2744 LLVM_DEBUG(llvm::dbgs() << "CreateImplicitSymbols: " << *symbol << '\n');2745 2746 // Implicitly determined DSAs2747 // OMP 5.2 5.1.1 - Variables Referenced in a Construct2748 Symbol *lastDeclSymbol = nullptr;2749 Symbol::Flags prevDSA;2750 for (int dirDepth{0}; dirDepth < (int)dirContext_.size(); ++dirDepth) {2751 DirContext &dirContext = dirContext_[dirDepth];2752 Symbol::Flags dsa;2753 2754 Scope &scope{context_.FindScope(dirContext.directiveSource)};2755 auto it{scope.find(symbol->name())};2756 if (it != scope.end()) {2757 // There is already a symbol in the current scope, use its DSA.2758 dsa = GetSymbolDSA(*it->second);2759 } else {2760 for (auto symMap : dirContext.objectWithDSA) {2761 if (symMap.first->name() == symbol->name()) {2762 // `symbol` already has a data-sharing attribute in the current2763 // context, use it.2764 dsa.set(symMap.second);2765 break;2766 }2767 }2768 }2769 2770 // When handling each implicit rule for a given symbol, one of the2771 // following actions may be taken:2772 // 1. Declare a new private or shared symbol.2773 // 2. Use the last declared symbol, by inserting a new symbol in the2774 // scope being processed, associated with it.2775 // If no symbol was declared previously, then no association is needed2776 // and the symbol from the enclosing scope will be inherited by the2777 // current one.2778 //2779 // Because of how symbols are collected in lowering, not inserting a new2780 // symbol in the second case could lead to the conclusion that a symbol2781 // from an enclosing construct was declared in the current construct,2782 // which would result in wrong privatization code being generated.2783 // Consider the following example:2784 //2785 // !$omp parallel default(private) ! p12786 // !$omp parallel default(private) shared(x) ! p22787 // x = 102788 // !$omp end parallel2789 // !$omp end parallel2790 //2791 // If a new x symbol was not inserted in the inner parallel construct2792 // (p2), it would use the x symbol definition from the enclosing scope.2793 // Then, when p2's default symbols were collected in lowering, the x2794 // symbol from the outer parallel construct (p1) would be collected, as2795 // it would have the private flag set.2796 // This would make x appear to be defined in p2, causing it to be2797 // privatized in p2 and its privatization in p1 to be skipped.2798 auto makeSymbol = [&](Symbol::Flags flags) {2799 const Symbol *hostSymbol =2800 lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate();2801 assert(flags.LeastElement());2802 Symbol::Flag flag = *flags.LeastElement();2803 lastDeclSymbol = DeclareNewAccessEntity(2804 *hostSymbol, flag, context_.FindScope(dirContext.directiveSource));2805 lastDeclSymbol->flags() |= flags;2806 return lastDeclSymbol;2807 };2808 auto useLastDeclSymbol = [&]() {2809 if (lastDeclSymbol) {2810 const Symbol *hostSymbol =2811 lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate();2812 MakeAssocSymbol(symbol->name(), *hostSymbol,2813 context_.FindScope(dirContext.directiveSource));2814 }2815 };2816 2817#ifndef NDEBUG2818 auto printImplicitRule = [&](const char *id) {2819 LLVM_DEBUG(llvm::dbgs() << "\t" << id << ": dsa: " << dsa << '\n');2820 LLVM_DEBUG(2821 llvm::dbgs() << "\t\tScope: " << dbg::ScopeSourcePos(scope) << '\n');2822 };2823#define PRINT_IMPLICIT_RULE(id) printImplicitRule(id)2824#else2825#define PRINT_IMPLICIT_RULE(id)2826#endif2827 2828 bool taskGenDir = llvm::omp::taskGeneratingSet.test(dirContext.directive);2829 bool targetDir = llvm::omp::allTargetSet.test(dirContext.directive);2830 bool parallelDir = llvm::omp::topParallelSet.test(dirContext.directive);2831 bool teamsDir = llvm::omp::allTeamsSet.test(dirContext.directive);2832 bool isStaticStorageDuration = IsSymbolStaticStorageDuration(*symbol);2833 2834 if (dsa.any()) {2835 if (parallelDir || taskGenDir || teamsDir) {2836 Symbol *prevDeclSymbol{lastDeclSymbol};2837 // NOTE As `dsa` will match that of the symbol in the current scope2838 // (if any), we won't override the DSA of any existing symbol.2839 if ((dsa & dataSharingAttributeFlags).any()) {2840 makeSymbol(dsa);2841 }2842 // Fix host association of explicit symbols, as they can be created2843 // before implicit ones in enclosing scope.2844 if (prevDeclSymbol && prevDeclSymbol != lastDeclSymbol &&2845 lastDeclSymbol->test(Symbol::Flag::OmpExplicit)) {2846 const auto *hostAssoc{lastDeclSymbol->detailsIf<HostAssocDetails>()};2847 if (hostAssoc && hostAssoc->symbol() != *prevDeclSymbol) {2848 lastDeclSymbol->set_details(HostAssocDetails{*prevDeclSymbol});2849 }2850 }2851 }2852 prevDSA = dsa;2853 PRINT_IMPLICIT_RULE("0) already has DSA");2854 continue;2855 }2856 2857 // NOTE Because of how lowering uses OmpImplicit flag, we can only set it2858 // for symbols with private DSA.2859 // Also, as the default clause is handled separately in lowering,2860 // don't mark its symbols with OmpImplicit either.2861 // Ideally, lowering should be changed and all implicit symbols2862 // should be marked with OmpImplicit.2863 2864 if (dirContext.defaultDSA == Symbol::Flag::OmpPrivate ||2865 dirContext.defaultDSA == Symbol::Flag::OmpFirstPrivate ||2866 dirContext.defaultDSA == Symbol::Flag::OmpShared) {2867 // 1) default2868 // Allowed only with parallel, teams and task generating constructs.2869 if (!parallelDir && !taskGenDir && !teamsDir) {2870 return;2871 }2872 dsa = {dirContext.defaultDSA};2873 makeSymbol(dsa);2874 PRINT_IMPLICIT_RULE("1) default");2875 } else if (parallelDir) {2876 // 2) parallel -> shared2877 dsa = {Symbol::Flag::OmpShared};2878 makeSymbol(dsa);2879 PRINT_IMPLICIT_RULE("2) parallel");2880 } else if (!taskGenDir && !targetDir) {2881 // 3) enclosing context2882 dsa = prevDSA;2883 useLastDeclSymbol();2884 PRINT_IMPLICIT_RULE("3) enclosing context");2885 } else if (targetDir) {2886 // 4) not mapped target variable -> firstprivate2887 // - i.e. implicit, but meets OpenMP specification rules for2888 // firstprivate "promotion"2889 if (enableDelayedPrivatizationStaging &&2890 IsTargetCaptureImplicitlyFirstprivatizeable(*symbol, prevDSA,2891 dataSharingAttributeFlags, dataMappingAttributeFlags,2892 dirContext.defaultMap)) {2893 prevDSA.set(Symbol::Flag::OmpImplicit);2894 prevDSA.set(Symbol::Flag::OmpFirstPrivate);2895 makeSymbol(prevDSA);2896 }2897 dsa = prevDSA;2898 PRINT_IMPLICIT_RULE("4) not mapped target variable -> firstprivate");2899 } else if (taskGenDir) {2900 // TODO 5) dummy arg in orphaned taskgen construct -> firstprivate2901 if (prevDSA.test(Symbol::Flag::OmpShared) ||2902 (isStaticStorageDuration &&2903 (prevDSA & dataSharingAttributeFlags).none())) {2904 // 6) shared in enclosing context -> shared2905 dsa = {Symbol::Flag::OmpShared};2906 makeSymbol(dsa);2907 PRINT_IMPLICIT_RULE("6) taskgen: shared");2908 } else {2909 // 7) firstprivate2910 dsa = {Symbol::Flag::OmpFirstPrivate};2911 makeSymbol(dsa)->set(Symbol::Flag::OmpImplicit);2912 PRINT_IMPLICIT_RULE("7) taskgen: firstprivate");2913 }2914 }2915 prevDSA = dsa;2916 }2917}2918 2919static bool IsOpenMPPointer(const Symbol &symbol) {2920 if (IsPointer(symbol) || IsBuiltinCPtr(symbol))2921 return true;2922 return false;2923}2924 2925static bool IsOpenMPAggregate(const Symbol &symbol) {2926 if (IsAllocatable(symbol) || IsOpenMPPointer(symbol))2927 return false;2928 2929 const auto *type{symbol.GetType()};2930 // OpenMP categorizes Fortran characters as aggregates.2931 if (type->category() == Fortran::semantics::DeclTypeSpec::Category::Character)2932 return true;2933 2934 if (const auto *det{symbol.GetUltimate()2935 .detailsIf<Fortran::semantics::ObjectEntityDetails>()})2936 if (det->IsArray())2937 return true;2938 2939 if (type->AsDerived())2940 return true;2941 2942 if (IsDeferredShape(symbol) || IsAssumedRank(symbol) ||2943 IsAssumedShape(symbol))2944 return true;2945 return false;2946}2947 2948static bool IsOpenMPScalar(const Symbol &symbol) {2949 if (IsOpenMPAggregate(symbol) || IsOpenMPPointer(symbol) ||2950 IsAllocatable(symbol))2951 return false;2952 const auto *type{symbol.GetType()};2953 if ((!symbol.GetShape() || symbol.GetShape()->empty()) &&2954 (type->category() ==2955 Fortran::semantics::DeclTypeSpec::Category::Numeric ||2956 type->category() ==2957 Fortran::semantics::DeclTypeSpec::Category::Logical))2958 return true;2959 return false;2960}2961 2962static bool DefaultMapCategoryMatchesSymbol(2963 parser::OmpVariableCategory::Value category, const Symbol &symbol) {2964 using VarCat = parser::OmpVariableCategory::Value;2965 switch (category) {2966 case VarCat::Scalar:2967 return IsOpenMPScalar(symbol);2968 case VarCat::Allocatable:2969 return IsAllocatable(symbol);2970 case VarCat::Aggregate:2971 return IsOpenMPAggregate(symbol);2972 case VarCat::Pointer:2973 return IsOpenMPPointer(symbol);2974 case VarCat::All:2975 return true;2976 }2977 return false;2978}2979 2980// For OpenMP constructs, check all the data-refs within the constructs2981// and adjust the symbol for each Name if necessary2982void OmpAttributeVisitor::Post(const parser::Name &name) {2983 auto *symbol{name.symbol};2984 2985 if (symbol && WithinConstruct()) {2986 if (IsPrivatizable(symbol) && !IsObjectWithDSA(*symbol)) {2987 // TODO: create a separate function to go through the rules for2988 // predetermined, explicitly determined, and implicitly2989 // determined data-sharing attributes (2.15.1.1).2990 if (Symbol * found{currScope().FindSymbol(name.source)}) {2991 if (symbol != found) {2992 name.symbol = found; // adjust the symbol within region2993 } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone &&2994 !symbol->GetUltimate().test(Symbol::Flag::OmpThreadprivate) &&2995 // Exclude indices of sequential loops that are privatised in2996 // the scope of the parallel region, and not in this scope.2997 // TODO: check whether this should be caught in IsObjectWithDSA2998 !symbol->test(Symbol::Flag::OmpPrivate)) {2999 if (symbol->GetUltimate().test(Symbol::Flag::CrayPointee)) {3000 std::string crayPtrName{3001 semantics::GetCrayPointer(*symbol).name().ToString()};3002 if (!IsObjectWithDSA(*currScope().FindSymbol(crayPtrName)))3003 context_.Say(name.source,3004 "The DEFAULT(NONE) clause requires that the Cray Pointer '%s' must be listed in a data-sharing attribute clause"_err_en_US,3005 crayPtrName);3006 } else {3007 context_.Say(name.source,3008 "The DEFAULT(NONE) clause requires that '%s' must be listed in a data-sharing attribute clause"_err_en_US,3009 symbol->name());3010 }3011 }3012 }3013 }3014 3015 // TODO: handle case where default and defaultmap are present on the same3016 // construct and conflict, defaultmap should supersede default if they3017 // conflict.3018 if (!GetContext().defaultMap.empty()) {3019 // Checked before implicit data sharing attributes as this rule ignores3020 // them and expects explicit predetermined/specified attributes to be in3021 // place for the types specified.3022 if (Symbol * found{currScope().FindSymbol(name.source)}) {3023 // If the variable has declare target applied to it (enter or link) it3024 // is exempt from defaultmap(none) restrictions.3025 // We also exempt procedures and named constants from defaultmap(none)3026 // checking.3027 if (!symbol->GetUltimate().test(Symbol::Flag::OmpDeclareTarget) &&3028 !(IsProcedure(*symbol) &&3029 !semantics::IsProcedurePointer(*symbol)) &&3030 !IsNamedConstant(*symbol)) {3031 auto &dMap = GetContext().defaultMap;3032 for (auto defaults : dMap) {3033 if (defaults.second ==3034 parser::OmpDefaultmapClause::ImplicitBehavior::None) {3035 if (DefaultMapCategoryMatchesSymbol(defaults.first, *found)) {3036 if (!IsObjectWithDSA(*symbol)) {3037 context_.Say(name.source,3038 "The DEFAULTMAP(NONE) clause requires that '%s' must be "3039 "listed in a "3040 "data-sharing attribute, data-mapping attribute, or is_device_ptr clause"_err_en_US,3041 symbol->name());3042 }3043 }3044 }3045 }3046 }3047 }3048 }3049 3050 if (Symbol * found{currScope().FindSymbol(name.source)}) {3051 if (found->GetUltimate().test(semantics::Symbol::Flag::OmpThreadprivate))3052 return;3053 }3054 3055 CreateImplicitSymbols(symbol);3056 } // within OpenMP construct3057}3058 3059Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) {3060 // TODO: why is the symbol not properly resolved by name resolution?3061 if (auto *resolvedSymbol{3062 name ? GetContext().scope.FindSymbol(name->source) : nullptr}) {3063 name->symbol = resolvedSymbol;3064 return resolvedSymbol;3065 } else {3066 return nullptr;3067 }3068}3069 3070void OmpAttributeVisitor::ResolveOmpName(3071 const parser::Name &name, Symbol::Flag ompFlag) {3072 if (ResolveName(&name)) {3073 if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) {3074 if (dataSharingAttributeFlags.test(ompFlag)) {3075 AddToContextObjectWithExplicitDSA(*resolvedSymbol, ompFlag);3076 }3077 }3078 } else if (ompFlag == Symbol::Flag::OmpCriticalLock) {3079 const auto pair{3080 GetContext().scope.try_emplace(name.source, Attrs{}, UnknownDetails{})};3081 CHECK(pair.second);3082 name.symbol = &pair.first->second.get();3083 }3084}3085 3086void OmpAttributeVisitor::ResolveOmpNameList(3087 const std::list<parser::Name> &nameList, Symbol::Flag ompFlag) {3088 for (const auto &name : nameList) {3089 ResolveOmpName(name, ompFlag);3090 }3091}3092 3093Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(3094 const parser::Name *name) {3095 if (!name) {3096 return nullptr;3097 }3098 if (auto *cb{GetProgramUnitOrBlockConstructContaining(GetContext().scope)3099 .FindCommonBlock(name->source)}) {3100 name->symbol = cb;3101 return cb;3102 }3103 return nullptr;3104}3105 3106void OmpAttributeVisitor::ResolveOmpObjectList(3107 const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {3108 for (const auto &ompObject : ompObjectList.v) {3109 ResolveOmpObject(ompObject, ompFlag);3110 }3111}3112 3113/// True if either symbol is in a namelist or some other symbol in the same3114/// equivalence set as symbol is in a namelist.3115static bool SymbolOrEquivalentIsInNamelist(const Symbol &symbol) {3116 auto isInNamelist{[](const Symbol &sym) {3117 const Symbol &ultimate{sym.GetUltimate()};3118 return ultimate.test(Symbol::Flag::InNamelist);3119 }};3120 3121 const EquivalenceSet *eqv{FindEquivalenceSet(symbol)};3122 if (!eqv) {3123 return isInNamelist(symbol);3124 }3125 3126 return llvm::any_of(*eqv, [isInNamelist](const EquivalenceObject &obj) {3127 return isInNamelist(obj.symbol);3128 });3129}3130 3131void OmpAttributeVisitor::ResolveOmpDesignator(3132 const parser::Designator &designator, Symbol::Flag ompFlag) {3133 unsigned version{context_.langOptions().OpenMPVersion};3134 llvm::omp::Directive directive{GetContext().directive};3135 3136 const auto *name{parser::GetDesignatorNameIfDataRef(designator)};3137 if (!name) {3138 // Array sections to be changed to substrings as needed3139 if (AnalyzeExpr(context_, designator)) {3140 if (std::holds_alternative<parser::Substring>(designator.u)) {3141 context_.Say(designator.source,3142 "Substrings are not allowed on OpenMP directives or clauses"_err_en_US);3143 }3144 }3145 // other checks, more TBD3146 return;3147 }3148 3149 if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {3150 auto checkExclusivelists{//3151 [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag,3152 const Symbol *symbol2, Symbol::Flag secondOmpFlag) {3153 if ((symbol1->test(firstOmpFlag) && symbol2->test(secondOmpFlag)) ||3154 (symbol1->test(secondOmpFlag) && symbol2->test(firstOmpFlag))) {3155 context_.Say(designator.source,3156 "Variable '%s' may not appear on both %s and %s clauses on a %s construct"_err_en_US,3157 symbol2->name(), Symbol::OmpFlagToClauseName(firstOmpFlag),3158 Symbol::OmpFlagToClauseName(secondOmpFlag),3159 parser::ToUpperCaseLetters(3160 llvm::omp::getOpenMPDirectiveName(directive, version)));3161 }3162 }};3163 if (dataCopyingAttributeFlags.test(ompFlag)) {3164 CheckDataCopyingClause(*name, *symbol, ompFlag);3165 } else {3166 AddToContextObjectWithExplicitDSA(*symbol, ompFlag);3167 if (dataSharingAttributeFlags.test(ompFlag)) {3168 CheckMultipleAppearances(*name, *symbol, ompFlag);3169 }3170 if (privateDataSharingAttributeFlags.test(ompFlag)) {3171 CheckObjectIsPrivatizable(*name, *symbol, ompFlag);3172 }3173 3174 if (ompFlag == Symbol::Flag::OmpAllocate) {3175 AddAllocateName(name);3176 }3177 }3178 if (ompFlag == Symbol::Flag::OmpReduction) {3179 // Using variables inside of a namelist in OpenMP reductions3180 // is allowed by the standard, but is not allowed for3181 // privatisation. This looks like an oversight. If the3182 // namelist is hoisted to a global, we cannot apply the3183 // mapping for the reduction variable: resulting in incorrect3184 // results. Disabling this hoisting could make some real3185 // production code go slower. See discussion in #1093033186 if (SymbolOrEquivalentIsInNamelist(*symbol)) {3187 context_.Say(name->source,3188 "Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US,3189 name->ToString());3190 }3191 }3192 if (ompFlag == Symbol::Flag::OmpInclusiveScan ||3193 ompFlag == Symbol::Flag::OmpExclusiveScan) {3194 if (!symbol->test(Symbol::Flag::OmpInScanReduction)) {3195 context_.Say(name->source,3196 "List item %s must appear in REDUCTION clause with the INSCAN modifier of the parent directive"_err_en_US,3197 name->ToString());3198 }3199 }3200 if (ompFlag == Symbol::Flag::OmpDeclareTarget) {3201 if (symbol->IsFuncResult()) {3202 if (Symbol * func{currScope().symbol()}) {3203 CHECK(func->IsSubprogram());3204 func->set(ompFlag);3205 name->symbol = func;3206 }3207 }3208 }3209 if (directive == llvm::omp::Directive::OMPD_target_data) {3210 checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr, symbol,3211 Symbol::Flag::OmpUseDeviceAddr);3212 }3213 if (llvm::omp::allDistributeSet.test(directive)) {3214 checkExclusivelists(symbol, Symbol::Flag::OmpFirstPrivate, symbol,3215 Symbol::Flag::OmpLastPrivate);3216 }3217 if (llvm::omp::allTargetSet.test(directive)) {3218 checkExclusivelists(symbol, Symbol::Flag::OmpIsDevicePtr, symbol,3219 Symbol::Flag::OmpHasDeviceAddr);3220 const auto *hostAssocSym{symbol};3221 if (!symbol->test(Symbol::Flag::OmpIsDevicePtr) &&3222 !symbol->test(Symbol::Flag::OmpHasDeviceAddr)) {3223 if (const auto *details{symbol->detailsIf<HostAssocDetails>()}) {3224 hostAssocSym = &details->symbol();3225 }3226 }3227 static Symbol::Flag dataMappingAttributeFlags[] = {//3228 Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,3229 Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapStorage,3230 Symbol::Flag::OmpMapDelete, Symbol::Flag::OmpIsDevicePtr,3231 Symbol::Flag::OmpHasDeviceAddr};3232 3233 static Symbol::Flag dataSharingAttributeFlags[] = {//3234 Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,3235 Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,3236 Symbol::Flag::OmpLinear};3237 3238 // For OMP TARGET TEAMS directive some sharing attribute3239 // flags and mapping attribute flags can co-exist.3240 if (!llvm::omp::allTeamsSet.test(directive) &&3241 !llvm::omp::allParallelSet.test(directive)) {3242 for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) {3243 for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) {3244 if ((hostAssocSym->test(ompFlag2) &&3245 hostAssocSym->test(Symbol::Flag::OmpExplicit)) ||3246 (symbol->test(ompFlag2) &&3247 symbol->test(Symbol::Flag::OmpExplicit))) {3248 checkExclusivelists(hostAssocSym, ompFlag1, symbol, ompFlag2);3249 }3250 }3251 }3252 }3253 }3254 }3255}3256 3257void OmpAttributeVisitor::ResolveOmpCommonBlock(3258 const parser::Name &name, Symbol::Flag ompFlag) {3259 if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {3260 if (!dataCopyingAttributeFlags.test(ompFlag)) {3261 CheckMultipleAppearances(name, *symbol, Symbol::Flag::OmpCommonBlock);3262 }3263 // 2.15.3 When a named common block appears in a list, it has the3264 // same meaning as if every explicit member of the common block3265 // appeared in the list3266 auto &details{symbol->get<CommonBlockDetails>()};3267 for (auto [index, object] : llvm::enumerate(details.objects())) {3268 if (auto *resolvedObject{ResolveOmp(*object, ompFlag, currScope())}) {3269 if (dataCopyingAttributeFlags.test(ompFlag)) {3270 CheckDataCopyingClause(name, *resolvedObject, ompFlag);3271 } else {3272 AddToContextObjectWithExplicitDSA(*resolvedObject, ompFlag);3273 }3274 details.replace_object(*resolvedObject, index);3275 }3276 }3277 } else {3278 context_.Say(name.source, // 2.15.33279 "COMMON block must be declared in the same scoping unit in which the OpenMP directive or clause appears"_err_en_US);3280 }3281}3282 3283void OmpAttributeVisitor::ResolveOmpObject(3284 const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {3285 common::visit( //3286 common::visitors{3287 [&](const parser::Designator &designator) {3288 ResolveOmpDesignator(designator, ompFlag);3289 },3290 [&](const parser::Name &name) { // common block3291 ResolveOmpCommonBlock(name, ompFlag);3292 },3293 [&](const parser::OmpObject::Invalid &invalid) {3294 switch (invalid.v) {3295 SWITCH_COVERS_ALL_CASES3296 case parser::OmpObject::Invalid::Kind::BlankCommonBlock:3297 context_.Say(invalid.source,3298 "Blank common blocks are not allowed as directive or clause arguments"_err_en_US);3299 break;3300 }3301 },3302 },3303 ompObject.u);3304}3305 3306Symbol *OmpAttributeVisitor::ResolveOmp(3307 const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) {3308 if (ompFlagsRequireNewSymbol.test(ompFlag)) {3309 return DeclareAccessEntity(name, ompFlag, scope);3310 } else {3311 return DeclareOrMarkOtherAccessEntity(name, ompFlag);3312 }3313}3314 3315Symbol *OmpAttributeVisitor::ResolveOmp(3316 Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) {3317 if (ompFlagsRequireNewSymbol.test(ompFlag)) {3318 return DeclareAccessEntity(symbol, ompFlag, scope);3319 } else {3320 return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);3321 }3322}3323 3324Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(3325 const parser::Name &name, Symbol::Flag ompFlag) {3326 Symbol *prev{currScope().FindSymbol(name.source)};3327 if (!name.symbol || !prev) {3328 return nullptr;3329 } else if (prev != name.symbol) {3330 name.symbol = prev;3331 }3332 return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);3333}3334 3335Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(3336 Symbol &object, Symbol::Flag ompFlag) {3337 if (ompFlagsRequireMark.test(ompFlag)) {3338 object.set(ompFlag);3339 }3340 return &object;3341}3342 3343static bool WithMultipleAppearancesOmpException(3344 const Symbol &symbol, Symbol::Flag flag) {3345 return (flag == Symbol::Flag::OmpFirstPrivate &&3346 symbol.test(Symbol::Flag::OmpLastPrivate)) ||3347 (flag == Symbol::Flag::OmpLastPrivate &&3348 symbol.test(Symbol::Flag::OmpFirstPrivate));3349}3350 3351void OmpAttributeVisitor::CheckMultipleAppearances(3352 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {3353 const auto *target{&symbol};3354 if (ompFlagsRequireNewSymbol.test(ompFlag)) {3355 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {3356 target = &details->symbol();3357 }3358 }3359 if (HasDataSharingAttributeObject(target->GetUltimate()) &&3360 !WithMultipleAppearancesOmpException(symbol, ompFlag)) {3361 context_.Say(name.source,3362 "'%s' appears in more than one data-sharing clause "3363 "on the same OpenMP directive"_err_en_US,3364 name.ToString());3365 } else {3366 AddDataSharingAttributeObject(target->GetUltimate());3367 if (privateDataSharingAttributeFlags.test(ompFlag)) {3368 AddPrivateDataSharingAttributeObjects(*target);3369 }3370 }3371}3372 3373void ResolveAccParts(SemanticsContext &context, const parser::ProgramUnit &node,3374 Scope *topScope) {3375 if (context.IsEnabled(common::LanguageFeature::OpenACC)) {3376 AccAttributeVisitor{context, topScope}.Walk(node);3377 }3378}3379 3380void ResolveOmpParts(3381 SemanticsContext &context, const parser::ProgramUnit &node) {3382 if (context.IsEnabled(common::LanguageFeature::OpenMP)) {3383 OmpAttributeVisitor{context}.Walk(node);3384 if (!context.AnyFatalError()) {3385 // The data-sharing attribute of the loop iteration variable for a3386 // sequential loop (2.15.1.1) can only be determined when visiting3387 // the corresponding DoConstruct, a second walk is to adjust the3388 // symbols for all the data-refs of that loop iteration variable3389 // prior to the DoConstruct.3390 OmpAttributeVisitor{context}.Walk(node);3391 }3392 }3393}3394 3395static bool IsSymbolThreadprivate(const Symbol &symbol) {3396 if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {3397 return details->symbol().test(Symbol::Flag::OmpThreadprivate);3398 }3399 return symbol.test(Symbol::Flag::OmpThreadprivate);3400}3401 3402static bool IsSymbolPrivate(const Symbol &symbol) {3403 LLVM_DEBUG(llvm::dbgs() << "IsSymbolPrivate(" << symbol.name() << "):\n");3404 LLVM_DEBUG(dbg::DumpAssocSymbols(llvm::dbgs(), symbol));3405 3406 if (Symbol::Flags dsa{GetSymbolDSA(symbol)}; dsa.any()) {3407 if (dsa.test(Symbol::Flag::OmpShared)) {3408 return false;3409 }3410 return true;3411 }3412 3413 // A symbol that has not gone through constructs that may privatize the3414 // original symbol may be predetermined as private.3415 // (OMP 5.2 5.1.1 - Variables Referenced in a Construct)3416 if (symbol == symbol.GetUltimate()) {3417 switch (symbol.owner().kind()) {3418 case Scope::Kind::MainProgram:3419 case Scope::Kind::Subprogram:3420 case Scope::Kind::BlockConstruct:3421 return !symbol.attrs().test(Attr::SAVE) &&3422 !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) &&3423 !symbol.flags().test(Symbol::Flag::InCommonBlock);3424 default:3425 return false;3426 }3427 }3428 return false;3429}3430 3431void OmpAttributeVisitor::CheckDataCopyingClause(3432 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {3433 if (ompFlag == Symbol::Flag::OmpCopyIn) {3434 // List of items/objects that can appear in a 'copyin' clause must be3435 // 'threadprivate'3436 if (!IsSymbolThreadprivate(symbol)) {3437 context_.Say(name.source,3438 "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,3439 symbol.name());3440 }3441 } else if (ompFlag == Symbol::Flag::OmpCopyPrivate &&3442 GetContext().directive == llvm::omp::Directive::OMPD_single) {3443 // A list item that appears in a 'copyprivate' clause may not appear on a3444 // 'private' or 'firstprivate' clause on a single construct3445 if (IsObjectWithDSA(symbol) &&3446 (symbol.test(Symbol::Flag::OmpPrivate) ||3447 symbol.test(Symbol::Flag::OmpFirstPrivate))) {3448 context_.Say(name.source,3449 "COPYPRIVATE variable '%s' may not appear on a PRIVATE or "3450 "FIRSTPRIVATE clause on a SINGLE construct"_err_en_US,3451 symbol.name());3452 } else if (!IsSymbolThreadprivate(symbol) && !IsSymbolPrivate(symbol)) {3453 // List of items/objects that can appear in a 'copyprivate' clause must be3454 // either 'private' or 'threadprivate' in enclosing context.3455 context_.Say(name.source,3456 "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in "3457 "outer context"_err_en_US,3458 symbol.name());3459 }3460 }3461}3462 3463void OmpAttributeVisitor::CheckObjectIsPrivatizable(3464 const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {3465 const auto &ultimateSymbol{symbol.GetUltimate()};3466 llvm::StringRef clauseName{"PRIVATE"};3467 if (ompFlag == Symbol::Flag::OmpFirstPrivate) {3468 clauseName = "FIRSTPRIVATE";3469 } else if (ompFlag == Symbol::Flag::OmpLastPrivate) {3470 clauseName = "LASTPRIVATE";3471 }3472 3473 if (SymbolOrEquivalentIsInNamelist(symbol)) {3474 context_.Say(name.source,3475 "Variable '%s' in NAMELIST cannot be in a %s clause"_err_en_US,3476 name.ToString(), clauseName.str());3477 }3478 3479 if (ultimateSymbol.has<AssocEntityDetails>()) {3480 context_.Say(name.source,3481 "Variable '%s' in ASSOCIATE cannot be in a %s clause"_err_en_US,3482 name.ToString(), clauseName.str());3483 }3484 3485 if (stmtFunctionExprSymbols_.find(ultimateSymbol) !=3486 stmtFunctionExprSymbols_.end()) {3487 context_.Say(name.source,3488 "Variable '%s' in statement function expression cannot be in a "3489 "%s clause"_err_en_US,3490 name.ToString(), clauseName.str());3491 }3492}3493 3494void OmpAttributeVisitor::CheckSourceLabel(const parser::Label &label) {3495 // Get the context to check if the statement causing a jump to the 'label' is3496 // in an enclosing OpenMP construct3497 std::optional<DirContext> thisContext{GetContextIf()};3498 sourceLabels_.emplace(3499 label, std::make_pair(currentStatementSource_, thisContext));3500 // Check if the statement with 'label' to which a jump is being introduced3501 // has already been encountered3502 auto it{targetLabels_.find(label)};3503 if (it != targetLabels_.end()) {3504 // Check if both the statement with 'label' and the statement that causes a3505 // jump to the 'label' are in the same scope3506 CheckLabelContext(currentStatementSource_, it->second.first, thisContext,3507 it->second.second);3508 }3509}3510 3511// Check for invalid branch into or out of OpenMP structured blocks3512void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source,3513 const parser::CharBlock target, std::optional<DirContext> sourceContext,3514 std::optional<DirContext> targetContext) {3515 auto dirContextsSame = [](DirContext &lhs, DirContext &rhs) -> bool {3516 // Sometimes nested constructs share a scope but are different contexts.3517 // The directiveSource comparison is for OmpSection. Sections do not have3518 // their own scopes and two different sections both have the same directive.3519 // Their source however is different. This string comparison is unfortunate3520 // but should only happen for GOTOs inside of SECTION.3521 return (lhs.scope == rhs.scope) && (lhs.directive == rhs.directive) &&3522 (lhs.directiveSource == rhs.directiveSource);3523 };3524 unsigned version{context_.langOptions().OpenMPVersion};3525 if (targetContext &&3526 (!sourceContext ||3527 (!dirContextsSame(*targetContext, *sourceContext) &&3528 !DoesScopeContain(3529 &targetContext->scope, sourceContext->scope)))) {3530 context_3531 .Say(source, "invalid branch into an OpenMP structured block"_err_en_US)3532 .Attach(target, "In the enclosing %s directive branched into"_en_US,3533 parser::ToUpperCaseLetters(llvm::omp::getOpenMPDirectiveName(3534 targetContext->directive, version)3535 .str()));3536 }3537 if (sourceContext &&3538 (!targetContext ||3539 (!dirContextsSame(*sourceContext, *targetContext) &&3540 !DoesScopeContain(3541 &sourceContext->scope, targetContext->scope)))) {3542 context_3543 .Say(source,3544 "invalid branch leaving an OpenMP structured block"_err_en_US)3545 .Attach(target, "Outside the enclosing %s directive"_en_US,3546 parser::ToUpperCaseLetters(llvm::omp::getOpenMPDirectiveName(3547 sourceContext->directive, version)3548 .str()));3549 }3550}3551 3552void OmpAttributeVisitor::AddOmpRequiresToScope(Scope &scope,3553 const WithOmpDeclarative::RequiresClauses *reqs,3554 const common::OmpMemoryOrderType *memOrder) {3555 const Scope &programUnit{omp::GetProgramUnit(scope)};3556 using RequiresClauses = WithOmpDeclarative::RequiresClauses;3557 RequiresClauses combinedReqs{reqs ? *reqs : RequiresClauses{}};3558 3559 if (auto *symbol{const_cast<Symbol *>(programUnit.symbol())}) {3560 common::visit(3561 [&](auto &details) {3562 if constexpr (std::is_convertible_v<decltype(&details),3563 WithOmpDeclarative *>) {3564 if (combinedReqs.any()) {3565 if (const RequiresClauses *otherReqs{details.ompRequires()}) {3566 combinedReqs |= *otherReqs;3567 }3568 details.set_ompRequires(combinedReqs);3569 }3570 if (memOrder) {3571 if (details.has_ompAtomicDefaultMemOrder() &&3572 *details.ompAtomicDefaultMemOrder() != *memOrder) {3573 context_.Say(programUnit.sourceRange(),3574 "Conflicting '%s' REQUIRES clauses found in compilation "3575 "unit"_err_en_US,3576 parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(3577 llvm::omp::Clause::OMPC_atomic_default_mem_order)3578 .str()));3579 }3580 details.set_ompAtomicDefaultMemOrder(*memOrder);3581 }3582 }3583 },3584 symbol->details());3585 }3586}3587 3588void OmpAttributeVisitor::IssueNonConformanceWarning(llvm::omp::Directive D,3589 parser::CharBlock source, unsigned EmitFromVersion) {3590 std::string warnStr;3591 llvm::raw_string_ostream warnStrOS(warnStr);3592 unsigned version{context_.langOptions().OpenMPVersion};3593 // We only want to emit the warning when the version being used has the3594 // directive deprecated3595 if (version < EmitFromVersion) {3596 return;3597 }3598 warnStrOS << "OpenMP directive "3599 << parser::ToUpperCaseLetters(3600 llvm::omp::getOpenMPDirectiveName(D, version).str())3601 << " has been deprecated";3602 3603 auto setAlternativeStr = [&warnStrOS](llvm::StringRef alt) {3604 warnStrOS << ", please use " << alt << " instead.";3605 };3606 switch (D) {3607 case llvm::omp::OMPD_master:3608 setAlternativeStr("MASKED");3609 break;3610 case llvm::omp::OMPD_master_taskloop:3611 setAlternativeStr("MASKED TASKLOOP");3612 break;3613 case llvm::omp::OMPD_master_taskloop_simd:3614 setAlternativeStr("MASKED TASKLOOP SIMD");3615 break;3616 case llvm::omp::OMPD_parallel_master:3617 setAlternativeStr("PARALLEL MASKED");3618 break;3619 case llvm::omp::OMPD_parallel_master_taskloop:3620 setAlternativeStr("PARALLEL MASKED TASKLOOP");3621 break;3622 case llvm::omp::OMPD_parallel_master_taskloop_simd:3623 setAlternativeStr("PARALLEL_MASKED TASKLOOP SIMD");3624 break;3625 case llvm::omp::OMPD_allocate:3626 setAlternativeStr("ALLOCATORS");3627 break;3628 default:3629 break;3630 }3631 context_.Warn(common::UsageWarning::OpenMPUsage, source, "%s"_warn_en_US,3632 warnStrOS.str());3633}3634 3635#ifndef NDEBUG3636 3637static llvm::raw_ostream &operator<<(3638 llvm::raw_ostream &os, const Symbol::Flags &flags) {3639 flags.Dump(os, Symbol::EnumToString);3640 return os;3641}3642 3643namespace dbg {3644 3645static llvm::raw_ostream &operator<<(3646 llvm::raw_ostream &os, std::optional<parser::SourcePosition> srcPos) {3647 if (srcPos) {3648 os << *srcPos.value().path << ":" << srcPos.value().line << ": ";3649 }3650 return os;3651}3652 3653static std::optional<parser::SourcePosition> GetSourcePosition(3654 const Fortran::semantics::Scope &scope,3655 const Fortran::parser::CharBlock &src) {3656 parser::AllCookedSources &allCookedSources{3657 scope.context().allCookedSources()};3658 if (std::optional<parser::ProvenanceRange> prange{3659 allCookedSources.GetProvenanceRange(src)}) {3660 return allCookedSources.allSources().GetSourcePosition(prange->start());3661 }3662 return std::nullopt;3663}3664 3665// Returns a string containing the source location of `scope` followed by3666// its first source line.3667static std::string ScopeSourcePos(const Fortran::semantics::Scope &scope) {3668 const parser::CharBlock &sourceRange{scope.sourceRange()};3669 std::string src{sourceRange.ToString()};3670 size_t nl{src.find('\n')};3671 std::string str;3672 llvm::raw_string_ostream ss{str};3673 3674 ss << GetSourcePosition(scope, sourceRange) << src.substr(0, nl);3675 return str;3676}3677 3678static void DumpAssocSymbols(llvm::raw_ostream &os, const Symbol &sym) {3679 os << '\t' << sym << '\n';3680 os << "\t\tOwner: " << ScopeSourcePos(sym.owner()) << '\n';3681 if (const auto *details{sym.detailsIf<HostAssocDetails>()}) {3682 DumpAssocSymbols(os, details->symbol());3683 }3684}3685 3686} // namespace dbg3687 3688#endif3689 3690} // namespace Fortran::semantics3691