flang/lib/Semantics/check-acc-structure.cpp

   1 //===-- lib/Semantics/check-acc-structure.cpp -----------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8 #include "check-acc-structure.h"
   9 #include "flang/Parser/parse-tree.h"
  10 #include "flang/Semantics/tools.h"
  11
  12 #define CHECK_SIMPLE_CLAUSE(X, Y) \
  13   void AccStructureChecker::Enter(const parser::AccClause::X &) { \
  14     CheckAllowed(llvm::acc::Clause::Y); \
  15   }
  16
  17 #define CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(X, Y) \
  18   void AccStructureChecker::Enter(const parser::AccClause::X &c) { \
  19     CheckAllowed(llvm::acc::Clause::Y); \
  20     RequiresConstantPositiveParameter(llvm::acc::Clause::Y, c.v); \
  21   }
  22
  23 namespace Fortran::semantics {
  24
  25 static constexpr inline AccClauseSet
  26     computeConstructOnlyAllowedAfterDeviceTypeClauses{
  27         llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait,
  28         llvm::acc::Clause::ACCC_num_gangs, llvm::acc::Clause::ACCC_num_workers,
  29         llvm::acc::Clause::ACCC_vector_length};
  30
  31 static constexpr inline AccClauseSet loopOnlyAllowedAfterDeviceTypeClauses{
  32     llvm::acc::Clause::ACCC_auto, llvm::acc::Clause::ACCC_collapse,
  33     llvm::acc::Clause::ACCC_independent, llvm::acc::Clause::ACCC_gang,
  34     llvm::acc::Clause::ACCC_seq, llvm::acc::Clause::ACCC_tile,
  35     llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker};
  36
  37 static constexpr inline AccClauseSet updateOnlyAllowedAfterDeviceTypeClauses{
  38     llvm::acc::Clause::ACCC_async, llvm::acc::Clause::ACCC_wait};
  39
  40 static constexpr inline AccClauseSet routineOnlyAllowedAfterDeviceTypeClauses{
  41     llvm::acc::Clause::ACCC_bind, llvm::acc::Clause::ACCC_gang,
  42     llvm::acc::Clause::ACCC_vector, llvm::acc::Clause::ACCC_worker};
  43
  44 bool AccStructureChecker::CheckAllowedModifier(llvm::acc::Clause clause) {
  45   if (GetContext().directive == llvm::acc::ACCD_enter_data ||
  46       GetContext().directive == llvm::acc::ACCD_exit_data) {
  47     context_.Say(GetContext().clauseSource,
  48         "Modifier is not allowed for the %s clause "
  49         "on the %s directive"_err_en_US,
  50         parser::ToUpperCaseLetters(getClauseName(clause).str()),
  51         ContextDirectiveAsFortran());
  52     return true;
  53   }
  54   return false;
  55 }
  56
  57 bool AccStructureChecker::IsComputeConstruct(
  58     llvm::acc::Directive directive) const {
  59   return directive == llvm::acc::ACCD_parallel ||
  60       directive == llvm::acc::ACCD_parallel_loop ||
  61       directive == llvm::acc::ACCD_serial ||
  62       directive == llvm::acc::ACCD_serial_loop ||
  63       directive == llvm::acc::ACCD_kernels ||
  64       directive == llvm::acc::ACCD_kernels_loop;
  65 }
  66
  67 bool AccStructureChecker::IsInsideComputeConstruct() const {
  68   if (dirContext_.size() <= 1) {
  69     return false;
  70   }
  71
  72   // Check all nested context skipping the first one.
  73   for (std::size_t i = dirContext_.size() - 1; i > 0; --i) {
  74     if (IsComputeConstruct(dirContext_[i - 1].directive)) {
  75       return true;
  76     }
  77   }
  78   return false;
  79 }
  80
  81 void AccStructureChecker::CheckNotInComputeConstruct() {
  82   if (IsInsideComputeConstruct()) {
  83     context_.Say(GetContext().directiveSource,
  84         "Directive %s may not be called within a compute region"_err_en_US,
  85         ContextDirectiveAsFortran());
  86   }
  87 }
  88
  89 void AccStructureChecker::Enter(const parser::AccClause &x) {
  90   SetContextClause(x);
  91 }
  92
  93 void AccStructureChecker::Leave(const parser::AccClauseList &) {}
  94
  95 void AccStructureChecker::Enter(const parser::OpenACCBlockConstruct &x) {
  96   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
  97   const auto &endBlockDir{std::get<parser::AccEndBlockDirective>(x.t)};
  98   const auto &beginAccBlockDir{
  99       std::get<parser::AccBlockDirective>(beginBlockDir.t)};
 100
 101   CheckMatching(beginAccBlockDir, endBlockDir.v);
 102   PushContextAndClauseSets(beginAccBlockDir.source, beginAccBlockDir.v);
 103 }
 104
 105 void AccStructureChecker::Leave(const parser::OpenACCBlockConstruct &x) {
 106   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
 107   const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
 108   const parser::Block &block{std::get<parser::Block>(x.t)};
 109   switch (blockDir.v) {
 110   case llvm::acc::Directive::ACCD_kernels:
 111   case llvm::acc::Directive::ACCD_parallel:
 112   case llvm::acc::Directive::ACCD_serial:
 113     // Restriction - line 1004-1005
 114     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
 115         computeConstructOnlyAllowedAfterDeviceTypeClauses);
 116     // Restriction - line 1001
 117     CheckNoBranching(block, GetContext().directive, blockDir.source);
 118     break;
 119   case llvm::acc::Directive::ACCD_data:
 120     // Restriction - line 1249-1250
 121     CheckRequireAtLeastOneOf();
 122     break;
 123   case llvm::acc::Directive::ACCD_host_data:
 124     // Restriction - line 1746
 125     CheckRequireAtLeastOneOf();
 126     break;
 127   default:
 128     break;
 129   }
 130   dirContext_.pop_back();
 131 }
 132
 133 void AccStructureChecker::Enter(
 134     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
 135   const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
 136   PushContextAndClauseSets(declarativeDir.source, declarativeDir.v);
 137 }
 138
 139 void AccStructureChecker::Leave(
 140     const parser::OpenACCStandaloneDeclarativeConstruct &x) {
 141   // Restriction - line 2409
 142   CheckAtLeastOneClause();
 143
 144   // Restriction - line 2417-2418 - In a Fortran module declaration section,
 145   // only create, copyin, device_resident, and link clauses are allowed.
 146   const auto &declarativeDir{std::get<parser::AccDeclarativeDirective>(x.t)};
 147   const auto &scope{context_.FindScope(declarativeDir.source)};
 148   const Scope &containingScope{GetProgramUnitContaining(scope)};
 149   if (containingScope.kind() == Scope::Kind::Module) {
 150     for (auto cl : GetContext().actualClauses) {
 151       if (cl != llvm::acc::Clause::ACCC_create &&
 152           cl != llvm::acc::Clause::ACCC_copyin &&
 153           cl != llvm::acc::Clause::ACCC_device_resident &&
 154           cl != llvm::acc::Clause::ACCC_link) {
 155         context_.Say(GetContext().directiveSource,
 156             "%s clause is not allowed on the %s directive in module "
 157             "declaration "
 158             "section"_err_en_US,
 159             parser::ToUpperCaseLetters(
 160                 llvm::acc::getOpenACCClauseName(cl).str()),
 161             ContextDirectiveAsFortran());
 162       }
 163     }
 164   }
 165   dirContext_.pop_back();
 166 }
 167
 168 void AccStructureChecker::Enter(const parser::OpenACCCombinedConstruct &x) {
 169   const auto &beginCombinedDir{
 170       std::get<parser::AccBeginCombinedDirective>(x.t)};
 171   const auto &combinedDir{
 172       std::get<parser::AccCombinedDirective>(beginCombinedDir.t)};
 173
 174   // check matching, End directive is optional
 175   if (const auto &endCombinedDir{
 176           std::get<std::optional<parser::AccEndCombinedDirective>>(x.t)}) {
 177     CheckMatching<parser::AccCombinedDirective>(combinedDir, endCombinedDir->v);
 178   }
 179
 180   PushContextAndClauseSets(combinedDir.source, combinedDir.v);
 181 }
 182
 183 void AccStructureChecker::Leave(const parser::OpenACCCombinedConstruct &x) {
 184   const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
 185   const auto &combinedDir{
 186       std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
 187   switch (combinedDir.v) {
 188   case llvm::acc::Directive::ACCD_kernels_loop:
 189   case llvm::acc::Directive::ACCD_parallel_loop:
 190   case llvm::acc::Directive::ACCD_serial_loop:
 191     // Restriction - line 1004-1005
 192     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
 193         computeConstructOnlyAllowedAfterDeviceTypeClauses);
 194     break;
 195   default:
 196     break;
 197   }
 198   dirContext_.pop_back();
 199 }
 200
 201 void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) {
 202   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
 203   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
 204   PushContextAndClauseSets(loopDir.source, loopDir.v);
 205 }
 206
 207 void AccStructureChecker::Leave(const parser::OpenACCLoopConstruct &x) {
 208   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
 209   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
 210   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
 211     // Restriction - line 1818-1819
 212     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
 213         loopOnlyAllowedAfterDeviceTypeClauses);
 214     // Restriction - line 1834
 215     CheckNotAllowedIfClause(llvm::acc::Clause::ACCC_seq,
 216         {llvm::acc::Clause::ACCC_gang, llvm::acc::Clause::ACCC_vector,
 217             llvm::acc::Clause::ACCC_worker});
 218   }
 219   dirContext_.pop_back();
 220 }
 221
 222 void AccStructureChecker::Enter(const parser::OpenACCStandaloneConstruct &x) {
 223   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
 224   PushContextAndClauseSets(standaloneDir.source, standaloneDir.v);
 225 }
 226
 227 void AccStructureChecker::Leave(const parser::OpenACCStandaloneConstruct &x) {
 228   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
 229   switch (standaloneDir.v) {
 230   case llvm::acc::Directive::ACCD_enter_data:
 231   case llvm::acc::Directive::ACCD_exit_data:
 232     // Restriction - line 1310-1311 (ENTER DATA)
 233     // Restriction - line 1312-1313 (EXIT DATA)
 234     CheckRequireAtLeastOneOf();
 235     break;
 236   case llvm::acc::Directive::ACCD_set:
 237     // Restriction - line 2610
 238     CheckRequireAtLeastOneOf();
 239     // Restriction - line 2602
 240     CheckNotInComputeConstruct();
 241     break;
 242   case llvm::acc::Directive::ACCD_update:
 243     // Restriction - line 2636
 244     CheckRequireAtLeastOneOf();
 245     // Restriction - line 2669
 246     CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
 247         updateOnlyAllowedAfterDeviceTypeClauses);
 248     break;
 249   case llvm::acc::Directive::ACCD_init:
 250   case llvm::acc::Directive::ACCD_shutdown:
 251     // Restriction - line 2525 (INIT)
 252     // Restriction - line 2561 (SHUTDOWN)
 253     CheckNotInComputeConstruct();
 254     break;
 255   default:
 256     break;
 257   }
 258   dirContext_.pop_back();
 259 }
 260
 261 void AccStructureChecker::Enter(const parser::OpenACCRoutineConstruct &x) {
 262   PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_routine);
 263   const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
 264   if (!optName) {
 265     const auto &verbatim{std::get<parser::Verbatim>(x.t)};
 266     const auto &scope{context_.FindScope(verbatim.source)};
 267     const Scope &containingScope{GetProgramUnitContaining(scope)};
 268     if (containingScope.kind() == Scope::Kind::Module) {
 269       context_.Say(GetContext().directiveSource,
 270           "ROUTINE directive without name must appear within the specification "
 271           "part of a subroutine or function definition, or within an interface "
 272           "body for a subroutine or function in an interface block"_err_en_US);
 273     }
 274   }
 275 }
 276 void AccStructureChecker::Leave(const parser::OpenACCRoutineConstruct &) {
 277   // Restriction - line 2790
 278   CheckRequireAtLeastOneOf();
 279   // Restriction - line 2788-2789
 280   CheckOnlyAllowedAfter(llvm::acc::Clause::ACCC_device_type,
 281       routineOnlyAllowedAfterDeviceTypeClauses);
 282   dirContext_.pop_back();
 283 }
 284
 285 void AccStructureChecker::Enter(const parser::OpenACCWaitConstruct &x) {
 286   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
 287   PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_wait);
 288 }
 289 void AccStructureChecker::Leave(const parser::OpenACCWaitConstruct &x) {
 290   dirContext_.pop_back();
 291 }
 292
 293 void AccStructureChecker::Enter(const parser::OpenACCAtomicConstruct &x) {
 294   PushContextAndClauseSets(x.source, llvm::acc::Directive::ACCD_atomic);
 295 }
 296 void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {
 297   dirContext_.pop_back();
 298 }
 299
 300 void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) {
 301   const auto &verbatim = std::get<parser::Verbatim>(x.t);
 302   PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache);
 303   SetContextDirectiveSource(verbatim.source);
 304 }
 305 void AccStructureChecker::Leave(const parser::OpenACCCacheConstruct &x) {
 306   dirContext_.pop_back();
 307 }
 308
 309 // Clause checkers
 310 CHECK_REQ_SCALAR_INT_CONSTANT_CLAUSE(Collapse, ACCC_collapse)
 311
 312 CHECK_SIMPLE_CLAUSE(Auto, ACCC_auto)
 313 CHECK_SIMPLE_CLAUSE(Async, ACCC_async)
 314 CHECK_SIMPLE_CLAUSE(Attach, ACCC_attach)
 315 CHECK_SIMPLE_CLAUSE(Bind, ACCC_bind)
 316 CHECK_SIMPLE_CLAUSE(Capture, ACCC_capture)
 317 CHECK_SIMPLE_CLAUSE(Copy, ACCC_copy)
 318 CHECK_SIMPLE_CLAUSE(Default, ACCC_default)
 319 CHECK_SIMPLE_CLAUSE(DefaultAsync, ACCC_default_async)
 320 CHECK_SIMPLE_CLAUSE(Delete, ACCC_delete)
 321 CHECK_SIMPLE_CLAUSE(Detach, ACCC_detach)
 322 CHECK_SIMPLE_CLAUSE(Device, ACCC_device)
 323 CHECK_SIMPLE_CLAUSE(DeviceNum, ACCC_device_num)
 324 CHECK_SIMPLE_CLAUSE(Deviceptr, ACCC_deviceptr)
 325 CHECK_SIMPLE_CLAUSE(DeviceResident, ACCC_device_resident)
 326 CHECK_SIMPLE_CLAUSE(DeviceType, ACCC_device_type)
 327 CHECK_SIMPLE_CLAUSE(Finalize, ACCC_finalize)
 328 CHECK_SIMPLE_CLAUSE(Firstprivate, ACCC_firstprivate)
 329 CHECK_SIMPLE_CLAUSE(Gang, ACCC_gang)
 330 CHECK_SIMPLE_CLAUSE(Host, ACCC_host)
 331 CHECK_SIMPLE_CLAUSE(If, ACCC_if)
 332 CHECK_SIMPLE_CLAUSE(IfPresent, ACCC_if_present)
 333 CHECK_SIMPLE_CLAUSE(Independent, ACCC_independent)
 334 CHECK_SIMPLE_CLAUSE(Link, ACCC_link)
 335 CHECK_SIMPLE_CLAUSE(NoCreate, ACCC_no_create)
 336 CHECK_SIMPLE_CLAUSE(Nohost, ACCC_nohost)
 337 CHECK_SIMPLE_CLAUSE(NumGangs, ACCC_num_gangs)
 338 CHECK_SIMPLE_CLAUSE(NumWorkers, ACCC_num_workers)
 339 CHECK_SIMPLE_CLAUSE(Present, ACCC_present)
 340 CHECK_SIMPLE_CLAUSE(Private, ACCC_private)
 341 CHECK_SIMPLE_CLAUSE(Read, ACCC_read)
 342 CHECK_SIMPLE_CLAUSE(Reduction, ACCC_reduction)
 343 CHECK_SIMPLE_CLAUSE(Seq, ACCC_seq)
 344 CHECK_SIMPLE_CLAUSE(Tile, ACCC_tile)
 345 CHECK_SIMPLE_CLAUSE(UseDevice, ACCC_use_device)
 346 CHECK_SIMPLE_CLAUSE(Vector, ACCC_vector)
 347 CHECK_SIMPLE_CLAUSE(VectorLength, ACCC_vector_length)
 348 CHECK_SIMPLE_CLAUSE(Wait, ACCC_wait)
 349 CHECK_SIMPLE_CLAUSE(Worker, ACCC_worker)
 350 CHECK_SIMPLE_CLAUSE(Write, ACCC_write)
 351 CHECK_SIMPLE_CLAUSE(Unknown, ACCC_unknown)
 352
 353 void AccStructureChecker::Enter(const parser::AccClause::Create &c) {
 354   CheckAllowed(llvm::acc::Clause::ACCC_create);
 355   const auto &modifierClause{c.v};
 356   if (const auto &modifier{
 357           std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
 358     if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
 359       context_.Say(GetContext().clauseSource,
 360           "Only the ZERO modifier is allowed for the %s clause "
 361           "on the %s directive"_err_en_US,
 362           parser::ToUpperCaseLetters(
 363               llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_create)
 364                   .str()),
 365           ContextDirectiveAsFortran());
 366     }
 367   }
 368 }
 369
 370 void AccStructureChecker::Enter(const parser::AccClause::Copyin &c) {
 371   CheckAllowed(llvm::acc::Clause::ACCC_copyin);
 372   const auto &modifierClause{c.v};
 373   if (const auto &modifier{
 374           std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
 375     if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyin)) {
 376       return;
 377     }
 378     if (modifier->v != parser::AccDataModifier::Modifier::ReadOnly) {
 379       context_.Say(GetContext().clauseSource,
 380           "Only the READONLY modifier is allowed for the %s clause "
 381           "on the %s directive"_err_en_US,
 382           parser::ToUpperCaseLetters(
 383               llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyin)
 384                   .str()),
 385           ContextDirectiveAsFortran());
 386     }
 387   }
 388 }
 389
 390 void AccStructureChecker::Enter(const parser::AccClause::Copyout &c) {
 391   CheckAllowed(llvm::acc::Clause::ACCC_copyout);
 392   const auto &modifierClause{c.v};
 393   if (const auto &modifier{
 394           std::get<std::optional<parser::AccDataModifier>>(modifierClause.t)}) {
 395     if (CheckAllowedModifier(llvm::acc::Clause::ACCC_copyout)) {
 396       return;
 397     }
 398     if (modifier->v != parser::AccDataModifier::Modifier::Zero) {
 399       context_.Say(GetContext().clauseSource,
 400           "Only the ZERO modifier is allowed for the %s clause "
 401           "on the %s directive"_err_en_US,
 402           parser::ToUpperCaseLetters(
 403               llvm::acc::getOpenACCClauseName(llvm::acc::Clause::ACCC_copyout)
 404                   .str()),
 405           ContextDirectiveAsFortran());
 406     }
 407   }
 408 }
 409
 410 void AccStructureChecker::Enter(const parser::AccClause::Self &x) {
 411   CheckAllowed(llvm::acc::Clause::ACCC_self);
 412   const std::optional<parser::AccSelfClause> &accSelfClause = x.v;
 413   if (GetContext().directive == llvm::acc::Directive::ACCD_update &&
 414       ((accSelfClause &&
 415            std::holds_alternative<std::optional<parser::ScalarLogicalExpr>>(
 416                (*accSelfClause).u)) ||
 417           !accSelfClause)) {
 418     context_.Say(GetContext().clauseSource,
 419         "SELF clause on the %s directive must have a var-list"_err_en_US,
 420         ContextDirectiveAsFortran());
 421   } else if (GetContext().directive != llvm::acc::Directive::ACCD_update &&
 422       accSelfClause &&
 423       std::holds_alternative<parser::AccObjectList>((*accSelfClause).u)) {
 424     const auto &accObjectList =
 425         std::get<parser::AccObjectList>((*accSelfClause).u);
 426     if (accObjectList.v.size() != 1) {
 427       context_.Say(GetContext().clauseSource,
 428           "SELF clause on the %s directive only accepts optional scalar logical"
 429           " expression"_err_en_US,
 430           ContextDirectiveAsFortran());
 431     }
 432   }
 433 }
 434
 435 llvm::StringRef AccStructureChecker::getClauseName(llvm::acc::Clause clause) {
 436   return llvm::acc::getOpenACCClauseName(clause);
 437 }
 438
 439 llvm::StringRef AccStructureChecker::getDirectiveName(
 440     llvm::acc::Directive directive) {
 441   return llvm::acc::getOpenACCDirectiveName(directive);
 442 }
 443
 444 } // namespace Fortran::semantics