1714 lines · cpp
1//===-- lib/Semantics/check-omp-atomic.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-exception6//7//===----------------------------------------------------------------------===//8//9// Semantic checks related to the ATOMIC construct.10//11//===----------------------------------------------------------------------===//12 13#include "check-omp-structure.h"14 15#include "flang/Common/indirection.h"16#include "flang/Common/template.h"17#include "flang/Evaluate/expression.h"18#include "flang/Evaluate/match.h"19#include "flang/Evaluate/rewrite.h"20#include "flang/Evaluate/tools.h"21#include "flang/Parser/char-block.h"22#include "flang/Parser/openmp-utils.h"23#include "flang/Parser/parse-tree.h"24#include "flang/Semantics/openmp-utils.h"25#include "flang/Semantics/symbol.h"26#include "flang/Semantics/tools.h"27#include "flang/Semantics/type.h"28 29#include "llvm/ADT/ArrayRef.h"30#include "llvm/ADT/STLExtras.h"31#include "llvm/Frontend/OpenMP/OMP.h"32#include "llvm/Support/ErrorHandling.h"33 34#include <cassert>35#include <list>36#include <optional>37#include <string_view>38#include <tuple>39#include <utility>40#include <variant>41#include <vector>42 43namespace Fortran::semantics {44 45using namespace Fortran::parser::omp;46using namespace Fortran::semantics::omp;47 48namespace operation = Fortran::evaluate::operation;49 50static MaybeExpr PostSemaRewrite(const SomeExpr &atom, const SomeExpr &expr);51 52template <typename T, typename U>53static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {54 return !(e == f);55}56 57namespace {58template <typename...> struct IsIntegral {59 static constexpr bool value{false};60};61 62template <common::TypeCategory C, int K>63struct IsIntegral<evaluate::Type<C, K>> {64 static constexpr bool value{//65 C == common::TypeCategory::Integer ||66 C == common::TypeCategory::Unsigned};67};68 69template <typename T> constexpr bool is_integral_v{IsIntegral<T>::value};70 71template <typename...> struct IsFloatingPoint {72 static constexpr bool value{false};73};74 75template <common::TypeCategory C, int K>76struct IsFloatingPoint<evaluate::Type<C, K>> {77 static constexpr bool value{//78 C == common::TypeCategory::Real || C == common::TypeCategory::Complex};79};80 81template <typename T>82constexpr bool is_floating_point_v{IsFloatingPoint<T>::value};83 84template <typename T>85constexpr bool is_numeric_v{is_integral_v<T> || is_floating_point_v<T>};86 87template <typename...> struct IsLogical {88 static constexpr bool value{false};89};90 91template <common::TypeCategory C, int K>92struct IsLogical<evaluate::Type<C, K>> {93 static constexpr bool value{C == common::TypeCategory::Logical};94};95 96template <typename T> constexpr bool is_logical_v{IsLogical<T>::value};97 98template <typename T, typename Op0, typename Op1>99using ReassocOpBase = evaluate::match::AnyOfPattern< //100 evaluate::match::Add<T, Op0, Op1>, //101 evaluate::match::Mul<T, Op0, Op1>, //102 evaluate::match::LogicalOp<common::LogicalOperator::And, T, Op0, Op1>,103 evaluate::match::LogicalOp<common::LogicalOperator::Or, T, Op0, Op1>,104 evaluate::match::LogicalOp<common::LogicalOperator::Eqv, T, Op0, Op1>,105 evaluate::match::LogicalOp<common::LogicalOperator::Neqv, T, Op0, Op1>>;106 107template <typename T, typename Op0, typename Op1>108struct ReassocOp : public ReassocOpBase<T, Op0, Op1> {109 using Base = ReassocOpBase<T, Op0, Op1>;110 using Base::Base;111};112 113template <typename T, typename Op0, typename Op1>114ReassocOp<T, Op0, Op1> reassocOp(const Op0 &op0, const Op1 &op1) {115 return ReassocOp<T, Op0, Op1>(op0, op1);116}117} // namespace118 119struct ReassocRewriter : public evaluate::rewrite::Identity {120 using Id = evaluate::rewrite::Identity;121 struct NonIntegralTag {};122 123 ReassocRewriter(const SomeExpr &atom, const SemanticsContext &context)124 : atom_(atom), context_(context) {}125 126 // Try to find cases where the input expression is of the form127 // (1) (a . b) . c, or128 // (2) a . (b . c),129 // where . denotes an associative operation, and a, b, c are some130 // subexpresions.131 // If one of the operands in the nested operation is the atomic variable132 // (with some possible type conversions applied to it), bring it to the133 // top-level operation, and move the top-level operand into the nested134 // operation.135 // For example, assuming x is the atomic variable:136 // (a + x) + b -> (a + b) + x, i.e. (conceptually) swap x and b.137 template <typename T, typename U,138 typename = std::enable_if_t<is_numeric_v<T> || is_logical_v<T>>>139 evaluate::Expr<T> operator()(evaluate::Expr<T> &&x, const U &u) {140 if constexpr (is_floating_point_v<T>) {141 if (!context_.langOptions().AssociativeMath) {142 return Id::operator()(std::move(x), u);143 }144 }145 // As per the above comment, there are 3 subexpressions involved in this146 // transformation. A match::Expr<T> will match evaluate::Expr<U> when T is147 // same as U, plus it will store a pointer (ref) to the matched expression.148 // When the match is successful, the sub[i].ref will point to a, b, x (in149 // some order) from the example above.150 evaluate::match::Expr<T> sub[3];151 auto inner{reassocOp<T>(sub[0], sub[1])};152 auto outer1{reassocOp<T>(inner, sub[2])}; // inner . something153 auto outer2{reassocOp<T>(sub[2], inner)}; // something . inner154#if !defined(__clang__) && !defined(_MSC_VER) && \155 (__GNUC__ < 8 || (__GNUC__ == 8 && __GNUC_MINOR__ < 5))156 // If GCC version < 8.5, use this definition. For the other definition157 // (which is equivalent), GCC 7.5 emits a somewhat cryptic error:158 // use of ‘outer1’ before deduction of ‘auto’159 // inside of the visitor function in common::visit.160 // Since this works with clang, MSVC and at least GCC 8.5, I'm assuming161 // that this is some kind of a GCC issue.162 using MatchTypes = std::tuple<evaluate::Add<T>, evaluate::Multiply<T>,163 evaluate::LogicalOperation<T::kind>>;164#else165 using MatchTypes = typename decltype(outer1)::MatchTypes;166#endif167 // There is no way to ensure that the outer operation is the same as168 // the inner one. They are matched independently, so we need to compare169 // the index in the member variant that represents the matched type.170 if ((match(outer1, x) && outer1.ref.index() == inner.ref.index()) ||171 (match(outer2, x) && outer2.ref.index() == inner.ref.index())) {172 size_t atomIdx{[&]() { // sub[atomIdx] will be the atom.173 size_t idx;174 for (idx = 0; idx != 3; ++idx) {175 if (IsAtom(*sub[idx].ref)) {176 break;177 }178 }179 return idx;180 }()};181 182 if (atomIdx > 2) {183 return Id::operator()(std::move(x), u);184 }185 return common::visit(186 [&](auto &&s) {187 // Build the new expression from the matched components.188 return Reconstruct<T, MatchTypes>(s, *sub[atomIdx].ref,189 *sub[(atomIdx + 1) % 3].ref, *sub[(atomIdx + 2) % 3].ref);190 },191 evaluate::match::deparen(x).u);192 }193 return Id::operator()(std::move(x), u);194 }195 196 template <typename T, typename U,197 typename = std::enable_if_t<!is_numeric_v<T> && !is_logical_v<T>>>198 evaluate::Expr<T> operator()(199 evaluate::Expr<T> &&x, const U &u, NonIntegralTag = {}) {200 return Id::operator()(std::move(x), u);201 }202 203private:204 template <typename T, typename MatchTypes, typename S>205 evaluate::Expr<T> Reconstruct(const S &op, evaluate::Expr<T> atom,206 evaluate::Expr<T> op1, evaluate::Expr<T> op2) {207 using TypeS = llvm::remove_cvref_t<decltype(op)>;208 // This function has to be semantically correct for all possible types209 // of S even though at runtime s will only be one of the matched types.210 // Limit the construction to the operation types that we tried to match211 // (otherwise TypeS(op1, op2) would fail for non-binary operations).212 if constexpr (!common::HasMember<TypeS, MatchTypes>) {213 return evaluate::Expr<T>(TypeS(op));214 } else if constexpr (is_logical_v<T>) {215 constexpr int K{T::kind};216 if constexpr (std::is_same_v<TypeS, evaluate::LogicalOperation<K>>) {217 // Logical operators take an extra argument in their constructor,218 // so they need their own reconstruction code.219 common::LogicalOperator opCode{op.logicalOperator};220 return evaluate::Expr<T>(TypeS( //221 opCode, std::move(atom),222 evaluate::Expr<T>(TypeS( //223 opCode, std::move(op1), std::move(op2)))));224 }225 } else {226 // Generic reconstruction.227 return evaluate::Expr<T>(TypeS( //228 std::move(atom),229 evaluate::Expr<T>(TypeS( //230 std::move(op1), std::move(op2)))));231 }232 }233 234 template <typename T> bool IsAtom(const evaluate::Expr<T> &x) const {235 return IsSameOrConvertOf(evaluate::AsGenericExpr(AsRvalue(x)), atom_);236 }237 238 const SomeExpr &atom_;239 const SemanticsContext &context_;240};241 242struct AnalyzedCondStmt {243 SomeExpr cond{evaluate::NullPointer{}}; // Default ctor is deleted244 parser::CharBlock source;245 SourcedActionStmt ift, iff;246};247 248// Compute the `evaluate::Assignment` from parser::ActionStmt. The assumption249// is that the ActionStmt will be either an assignment or a pointer-assignment,250// otherwise return std::nullopt.251// Note: This function can return std::nullopt on [Pointer]AssignmentStmt where252// the "typedAssignment" is unset. This can happen if there are semantic errors253// in the purported assignment.254static std::optional<evaluate::Assignment> GetEvaluateAssignment(255 const parser::ActionStmt *x) {256 if (x == nullptr) {257 return std::nullopt;258 }259 260 using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;261 using PointerAssignmentStmt =262 common::Indirection<parser::PointerAssignmentStmt>;263 using TypedAssignment = parser::AssignmentStmt::TypedAssignment;264 265 return common::visit(266 [](auto &&s) -> std::optional<evaluate::Assignment> {267 using BareS = llvm::remove_cvref_t<decltype(s)>;268 if constexpr (std::is_same_v<BareS, AssignmentStmt> ||269 std::is_same_v<BareS, PointerAssignmentStmt>) {270 const TypedAssignment &typed{s.value().typedAssignment};271 // ForwardOwningPointer typedAssignment272 // `- GenericAssignmentWrapper ^.get()273 // `- std::optional<Assignment> ^->v274 return typed.get()->v;275 } else {276 return std::nullopt;277 }278 },279 x->u);280}281 282static std::optional<AnalyzedCondStmt> AnalyzeConditionalStmt(283 const parser::ExecutionPartConstruct *x) {284 if (x == nullptr) {285 return std::nullopt;286 }287 288 // Extract the evaluate::Expr from ScalarLogicalExpr.289 auto getFromLogical{[](const parser::ScalarLogicalExpr &logical) {290 // ScalarLogicalExpr is Scalar<Logical<common::Indirection<Expr>>>291 auto &expr{parser::UnwrapRef<parser::Expr>(logical)};292 return GetEvaluateExpr(expr);293 }};294 295 // Recognize either296 // ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt, or297 // ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct.298 299 if (auto &&action{GetActionStmt(x)}) {300 if (auto *ifs{std::get_if<common::Indirection<parser::IfStmt>>(301 &action.stmt->u)}) {302 const parser::IfStmt &s{ifs->value()};303 auto &&maybeCond{304 getFromLogical(std::get<parser::ScalarLogicalExpr>(s.t))};305 auto &thenStmt{306 std::get<parser::UnlabeledStatement<parser::ActionStmt>>(s.t)};307 if (maybeCond) {308 return AnalyzedCondStmt{std::move(*maybeCond), action.source,309 SourcedActionStmt{&thenStmt.statement, thenStmt.source},310 SourcedActionStmt{}};311 }312 }313 return std::nullopt;314 }315 316 if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {317 if (auto *ifc{318 std::get_if<common::Indirection<parser::IfConstruct>>(&exec->u)}) {319 using ElseBlock = parser::IfConstruct::ElseBlock;320 using ElseIfBlock = parser::IfConstruct::ElseIfBlock;321 const parser::IfConstruct &s{ifc->value()};322 323 if (!std::get<std::list<ElseIfBlock>>(s.t).empty()) {324 // Not expecting any else-if statements.325 return std::nullopt;326 }327 auto &stmt{std::get<parser::Statement<parser::IfThenStmt>>(s.t)};328 auto &&maybeCond{getFromLogical(329 std::get<parser::ScalarLogicalExpr>(stmt.statement.t))};330 if (!maybeCond) {331 return std::nullopt;332 }333 334 if (auto &maybeElse{std::get<std::optional<ElseBlock>>(s.t)}) {335 AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,336 GetActionStmt(std::get<parser::Block>(s.t)),337 GetActionStmt(std::get<parser::Block>(maybeElse->t))};338 if (result.ift.stmt && result.iff.stmt) {339 return result;340 }341 } else {342 AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,343 GetActionStmt(std::get<parser::Block>(s.t)), SourcedActionStmt{}};344 if (result.ift.stmt) {345 return result;346 }347 }348 }349 return std::nullopt;350 }351 352 return std::nullopt;353}354 355static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(356 parser::CharBlock source) {357 // Find => in the range, if not found, find = that is not a part of358 // <=, >=, ==, or /=.359 auto trim{[](std::string_view v) {360 const char *begin{v.data()};361 const char *end{begin + v.size()};362 while (*begin == ' ' && begin != end) {363 ++begin;364 }365 while (begin != end && end[-1] == ' ') {366 --end;367 }368 assert(begin != end && "Source should not be empty");369 return parser::CharBlock(begin, end - begin);370 }};371 372 std::string_view sv(source.begin(), source.size());373 374 if (auto where{sv.find("=>")}; where != sv.npos) {375 std::string_view lhs(sv.data(), where);376 std::string_view rhs(sv.data() + where + 2, sv.size() - where - 2);377 return std::make_pair(trim(lhs), trim(rhs));378 }379 380 // Go backwards, since all the exclusions above end with a '='.381 for (size_t next{source.size()}; next > 1; --next) {382 if (sv[next - 1] == '=' && !llvm::is_contained("<>=/", sv[next - 2])) {383 std::string_view lhs(sv.data(), next - 1);384 std::string_view rhs(sv.data() + next, sv.size() - next);385 return std::make_pair(trim(lhs), trim(rhs));386 }387 }388 llvm_unreachable("Could not find assignment operator");389}390 391static std::vector<SomeExpr> GetNonAtomExpressions(392 const SomeExpr &atom, const std::vector<SomeExpr> &exprs) {393 std::vector<SomeExpr> nonAtom;394 for (const SomeExpr &e : exprs) {395 if (!IsSameOrConvertOf(e, atom)) {396 nonAtom.push_back(e);397 }398 }399 return nonAtom;400}401 402static std::vector<SomeExpr> GetNonAtomArguments(403 const SomeExpr &atom, const SomeExpr &expr) {404 if (auto &&maybe{GetConvertInput(expr)}) {405 return GetNonAtomExpressions(406 atom, GetTopLevelOperationIgnoreResizing(*maybe).second);407 }408 return {};409}410 411static bool IsCheckForAssociated(const SomeExpr &cond) {412 return GetTopLevelOperationIgnoreResizing(cond).first ==413 operation::Operator::Associated;414}415 416static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {417 // This ignores function calls, so it will accept "f(x) = f(x) + 1"418 // for example.419 return HasStorageOverlap(assign.lhs, assign.rhs) == nullptr;420}421 422static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) {423 if (value) {424 expr.Reset(new evaluate::GenericExprWrapper(std::move(value)),425 evaluate::GenericExprWrapper::Deleter);426 }427}428 429static void SetAssignment(parser::AssignmentStmt::TypedAssignment &assign,430 std::optional<evaluate::Assignment> value) {431 if (value) {432 assign.Reset(new evaluate::GenericAssignmentWrapper(std::move(value)),433 evaluate::GenericAssignmentWrapper::Deleter);434 }435}436 437namespace {438struct AtomicAnalysis {439 AtomicAnalysis(const SomeExpr &atom, const MaybeExpr &cond = std::nullopt)440 : atom_(atom), cond_(cond) {}441 442 AtomicAnalysis &addOp0(int what,443 const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {444 return addOp(op0_, what, maybeAssign);445 }446 AtomicAnalysis &addOp1(int what,447 const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {448 return addOp(op1_, what, maybeAssign);449 }450 451 operator parser::OpenMPAtomicConstruct::Analysis() const {452 // Defined in flang/include/flang/Parser/parse-tree.h453 //454 // struct Analysis {455 // struct Kind {456 // static constexpr int None = 0;457 // static constexpr int Read = 1;458 // static constexpr int Write = 2;459 // static constexpr int Update = Read | Write;460 // static constexpr int Action = 3; // Bits containing None, Read,461 // // Write, Update462 // static constexpr int IfTrue = 4;463 // static constexpr int IfFalse = 8;464 // static constexpr int Condition = 12; // Bits containing IfTrue,465 // // IfFalse466 // };467 // struct Op {468 // int what;469 // TypedAssignment assign;470 // };471 // TypedExpr atom, cond;472 // Op op0, op1;473 // };474 475 parser::OpenMPAtomicConstruct::Analysis an;476 SetExpr(an.atom, atom_);477 SetExpr(an.cond, cond_);478 an.op0 = std::move(op0_);479 an.op1 = std::move(op1_);480 return an;481 }482 483private:484 struct Op {485 operator parser::OpenMPAtomicConstruct::Analysis::Op() const {486 parser::OpenMPAtomicConstruct::Analysis::Op op;487 op.what = what;488 SetAssignment(op.assign, assign);489 return op;490 }491 492 int what;493 std::optional<evaluate::Assignment> assign;494 };495 496 AtomicAnalysis &addOp(Op &op, int what,497 const std::optional<evaluate::Assignment> &maybeAssign) {498 op.what = what;499 if (maybeAssign) {500 if (MaybeExpr rewritten{PostSemaRewrite(atom_, maybeAssign->rhs)}) {501 op.assign = evaluate::Assignment(502 AsRvalue(maybeAssign->lhs), std::move(*rewritten));503 op.assign->u = std::move(maybeAssign->u);504 } else {505 op.assign = *maybeAssign;506 }507 }508 return *this;509 }510 511 const SomeExpr &atom_;512 const MaybeExpr &cond_;513 Op op0_, op1_;514};515} // namespace516 517/// Check if `expr` satisfies the following conditions for x and v:518///519/// [6.0:189:10-12]520/// - x and v (as applicable) are either scalar variables or521/// function references with scalar data pointer result of non-character522/// intrinsic type or variables that are non-polymorphic scalar pointers523/// and any length type parameter must be constant.524void OmpStructureChecker::CheckAtomicType(SymbolRef sym,525 parser::CharBlock source, std::string_view name, bool checkTypeOnPointer) {526 const DeclTypeSpec *typeSpec{sym->GetType()};527 if (!typeSpec) {528 return;529 }530 531 if (!IsPointer(sym)) {532 using Category = DeclTypeSpec::Category;533 Category cat{typeSpec->category()};534 if (cat == Category::Character) {535 context_.Say(source,536 "Atomic variable %s cannot have CHARACTER type"_err_en_US, name);537 } else if (cat != Category::Numeric && cat != Category::Logical) {538 context_.Say(source,539 "Atomic variable %s should have an intrinsic type"_err_en_US, name);540 }541 return;542 }543 544 // Variable is a pointer.545 if (typeSpec->IsPolymorphic()) {546 context_.Say(source,547 "Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,548 name);549 return;550 }551 552 // Apply pointer-to-non-intrinsic rule only for intrinsic-assignment paths.553 if (checkTypeOnPointer) {554 using Category = DeclTypeSpec::Category;555 Category cat{typeSpec->category()};556 if (cat != Category::Numeric && cat != Category::Logical) {557 std::string details = " has the POINTER attribute";558 if (const auto *derived{typeSpec->AsDerived()}) {559 details += " and derived type '"s + derived->name().ToString() + "'";560 }561 context_.Say(source,562 "ATOMIC operation requires an intrinsic scalar variable; '%s'%s"_err_en_US,563 sym->name(), details);564 return;565 }566 }567 568 // Go over all length parameters, if any, and check if they are569 // explicit.570 if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {571 if (llvm::any_of(derived->parameters(), [](auto &&entry) {572 // "entry" is a map entry573 return entry.second.isLen() && !entry.second.isExplicit();574 })) {575 context_.Say(source,576 "Atomic variable %s is a pointer to a type with non-constant length parameter"_err_en_US,577 name);578 }579 }580}581 582void OmpStructureChecker::CheckAtomicVariable(583 const SomeExpr &atom, parser::CharBlock source, bool checkTypeOnPointer) {584 if (atom.Rank() != 0) {585 context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,586 atom.AsFortran());587 }588 589 std::vector<SomeExpr> dsgs{GetAllDesignators(atom)};590 assert(dsgs.size() == 1 && "Should have a single top-level designator");591 evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};592 593 CheckAtomicType(syms.back(), source, atom.AsFortran(), checkTypeOnPointer);594 595 if (!IsArrayElement(atom) && !ExtractComplexPart(atom)) {596 if (IsAllocatable(syms.back())) {597 context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,598 atom.AsFortran());599 }600 }601}602 603void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,604 llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,605 parser::CharBlock source) {606 if (auto *expr{HasStorageOverlap(base, exprs)}) {607 context_.Say(source,608 "Within atomic operation %s and %s access the same storage"_warn_en_US,609 base.AsFortran(), expr->AsFortran());610 }611}612 613void OmpStructureChecker::ErrorShouldBeVariable(614 const MaybeExpr &expr, parser::CharBlock source) {615 if (expr) {616 context_.Say(source, "Atomic expression %s should be a variable"_err_en_US,617 expr->AsFortran());618 } else {619 context_.Say(source, "Atomic expression should be a variable"_err_en_US);620 }621}622 623std::pair<const parser::ExecutionPartConstruct *,624 const parser::ExecutionPartConstruct *>625OmpStructureChecker::CheckUpdateCapture(626 const parser::ExecutionPartConstruct *ec1,627 const parser::ExecutionPartConstruct *ec2, parser::CharBlock source) {628 // Decide which statement is the atomic update and which is the capture.629 //630 // The two allowed cases are:631 // x = ... atomic-var = ...632 // ... = x capture-var = atomic-var (with optional converts)633 // or634 // ... = x capture-var = atomic-var (with optional converts)635 // x = ... atomic-var = ...636 //637 // The case of 'a = b; b = a' is ambiguous, so pick the first one as capture638 // (which makes more sense, as it captures the original value of the atomic639 // variable).640 //641 // If the two statements don't fit these criteria, return a pair of default-642 // constructed values.643 using ReturnTy = std::pair<const parser::ExecutionPartConstruct *,644 const parser::ExecutionPartConstruct *>;645 646 SourcedActionStmt act1{GetActionStmt(ec1)};647 SourcedActionStmt act2{GetActionStmt(ec2)};648 auto maybeAssign1{GetEvaluateAssignment(act1.stmt)};649 auto maybeAssign2{GetEvaluateAssignment(act2.stmt)};650 if (!maybeAssign1 || !maybeAssign2) {651 if (!IsAssignment(act1.stmt) || !IsAssignment(act2.stmt)) {652 context_.Say(source,653 "ATOMIC UPDATE operation with CAPTURE should contain two assignments"_err_en_US);654 }655 return std::make_pair(nullptr, nullptr);656 }657 658 auto as1{*maybeAssign1}, as2{*maybeAssign2};659 660 auto isUpdateCapture{661 [](const evaluate::Assignment &u, const evaluate::Assignment &c) {662 return IsSameOrConvertOf(c.rhs, u.lhs);663 }};664 665 // Do some checks that narrow down the possible choices for the update666 // and the capture statements. This will help to emit better diagnostics.667 // 1. An assignment could be an update (cbu) if the left-hand side is a668 // subexpression of the right-hand side.669 // 2. An assignment could be a capture (cbc) if the right-hand side is670 // a variable (or a function ref), with potential type conversions.671 bool cbu1{IsVarSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?672 bool cbu2{IsVarSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?673 bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?674 bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?675 676 // We want to diagnose cases where both assignments cannot be an update,677 // or both cannot be a capture, as well as cases where either assignment678 // cannot be any of these two.679 //680 // If we organize these boolean values into a matrix681 // |cbu1 cbu2|682 // |cbc1 cbc2|683 // then we want to diagnose cases where the matrix has a zero (i.e. "false")684 // row or column, including the case where everything is zero. All these685 // cases correspond to the determinant of the matrix being 0, which suggests686 // that checking the det may be a convenient diagnostic check. There is only687 // one additional case where the det is 0, which is when the matrix is all 1688 // ("true"). The "all true" case represents the situation where both689 // assignments could be an update as well as a capture. On the other hand,690 // whenever det != 0, the roles of the update and the capture can be691 // unambiguously assigned to as1 and as2 [1].692 //693 // [1] This can be easily verified by hand: there are 10 2x2 matrices with694 // det = 0, leaving 6 cases where det != 0:695 // 0 1 0 1 1 0 1 0 1 1 1 1696 // 1 0 1 1 0 1 1 1 0 1 1 0697 // In each case the classification is unambiguous.698 699 // |cbu1 cbu2|700 // det |cbc1 cbc2| = cbu1*cbc2 - cbu2*cbc1701 int det{int(cbu1) * int(cbc2) - int(cbu2) * int(cbc1)};702 703 auto errorCaptureShouldRead{[&](const parser::CharBlock &source,704 const std::string &expr) {705 context_.Say(source,706 "In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read %s"_err_en_US,707 expr);708 }};709 710 auto errorNeitherWorks{[&]() {711 context_.Say(source,712 "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture"_err_en_US);713 }};714 715 auto makeSelectionFromDet{[&](int det) -> ReturnTy {716 // If det != 0, then the checks unambiguously suggest a specific717 // categorization.718 // If det == 0, then this function should be called only if the719 // checks haven't ruled out any possibility, i.e. when both assignments720 // could still be either updates or captures.721 if (det > 0) {722 // as1 is update, as2 is capture723 if (isUpdateCapture(as1, as2)) {724 return std::make_pair(/*Update=*/ec1, /*Capture=*/ec2);725 } else {726 errorCaptureShouldRead(act2.source, as1.lhs.AsFortran());727 return std::make_pair(nullptr, nullptr);728 }729 } else if (det < 0) {730 // as2 is update, as1 is capture731 if (isUpdateCapture(as2, as1)) {732 return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);733 } else {734 errorCaptureShouldRead(act1.source, as2.lhs.AsFortran());735 return std::make_pair(nullptr, nullptr);736 }737 } else {738 bool updateFirst{isUpdateCapture(as1, as2)};739 bool captureFirst{isUpdateCapture(as2, as1)};740 if (updateFirst && captureFirst) {741 // If both assignment could be the update and both could be the742 // capture, emit a warning about the ambiguity.743 context_.Say(act1.source,744 "In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement"_warn_en_US);745 return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);746 }747 if (updateFirst != captureFirst) {748 const parser::ExecutionPartConstruct *upd{updateFirst ? ec1 : ec2};749 const parser::ExecutionPartConstruct *cap{captureFirst ? ec1 : ec2};750 return std::make_pair(upd, cap);751 }752 assert(!updateFirst && !captureFirst);753 errorNeitherWorks();754 return std::make_pair(nullptr, nullptr);755 }756 }};757 758 if (det != 0 || (cbu1 && cbu2 && cbc1 && cbc2)) {759 return makeSelectionFromDet(det);760 }761 assert(det == 0 && "Prior checks should have covered det != 0");762 763 // If neither of the statements is an RMW update, it could still be a764 // "write" update. Pretty much any assignment can be a write update, so765 // recompute det with cbu1 = cbu2 = true.766 if (int writeDet{int(cbc2) - int(cbc1)}; writeDet || (cbc1 && cbc2)) {767 return makeSelectionFromDet(writeDet);768 }769 770 // It's only errors from here on.771 772 if (!cbu1 && !cbu2 && !cbc1 && !cbc2) {773 errorNeitherWorks();774 return std::make_pair(nullptr, nullptr);775 }776 777 // The remaining cases are that778 // - no candidate for update, or for capture,779 // - one of the assignments cannot be anything.780 781 if (!cbu1 && !cbu2) {782 context_.Say(source,783 "In ATOMIC UPDATE operation with CAPTURE neither statement could be the update"_err_en_US);784 return std::make_pair(nullptr, nullptr);785 } else if (!cbc1 && !cbc2) {786 context_.Say(source,787 "In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture"_err_en_US);788 return std::make_pair(nullptr, nullptr);789 }790 791 if ((!cbu1 && !cbc1) || (!cbu2 && !cbc2)) {792 auto &src = (!cbu1 && !cbc1) ? act1.source : act2.source;793 context_.Say(src,794 "In ATOMIC UPDATE operation with CAPTURE the statement could be neither the update nor the capture"_err_en_US);795 return std::make_pair(nullptr, nullptr);796 }797 798 // All cases should have been covered.799 llvm_unreachable("Unchecked condition");800}801 802void OmpStructureChecker::CheckAtomicCaptureAssignment(803 const evaluate::Assignment &capture, const SomeExpr &atom,804 parser::CharBlock source) {805 auto [lsrc, rsrc]{SplitAssignmentSource(source)};806 (void)lsrc;807 const SomeExpr &cap{capture.lhs};808 809 if (!IsVarOrFunctionRef(atom)) {810 ErrorShouldBeVariable(atom, rsrc);811 } else {812 CheckAtomicVariable(813 atom, rsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(capture));814 // This part should have been checked prior to calling this function.815 assert(*GetConvertInput(capture.rhs) == atom &&816 "This cannot be a capture assignment");817 CheckStorageOverlap(atom, {cap}, source);818 }819}820 821void OmpStructureChecker::CheckAtomicReadAssignment(822 const evaluate::Assignment &read, parser::CharBlock source) {823 auto [lsrc, rsrc]{SplitAssignmentSource(source)};824 (void)lsrc;825 826 if (auto maybe{GetConvertInput(read.rhs)}) {827 const SomeExpr &atom{*maybe};828 829 if (!IsVarOrFunctionRef(atom)) {830 ErrorShouldBeVariable(atom, rsrc);831 } else {832 CheckAtomicVariable(833 atom, rsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(read));834 CheckStorageOverlap(atom, {read.lhs}, source);835 }836 } else {837 ErrorShouldBeVariable(read.rhs, rsrc);838 }839}840 841void OmpStructureChecker::CheckAtomicWriteAssignment(842 const evaluate::Assignment &write, parser::CharBlock source) {843 // [6.0:190:13-15]844 // A write structured block is write-statement, a write statement that has845 // one of the following forms:846 // x = expr847 // x => expr848 auto [lsrc, rsrc]{SplitAssignmentSource(source)};849 const SomeExpr &atom{write.lhs};850 851 if (!IsVarOrFunctionRef(atom)) {852 ErrorShouldBeVariable(atom, rsrc);853 } else {854 CheckAtomicVariable(855 atom, lsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(write));856 CheckStorageOverlap(atom, {write.rhs}, source);857 }858}859 860std::optional<evaluate::Assignment>861OmpStructureChecker::CheckAtomicUpdateAssignment(862 const evaluate::Assignment &update, parser::CharBlock source) {863 // [6.0:191:1-7]864 // An update structured block is update-statement, an update statement865 // that has one of the following forms:866 // x = x operator expr867 // x = expr operator x868 // x = intrinsic-procedure-name (x)869 // x = intrinsic-procedure-name (x, expr-list)870 // x = intrinsic-procedure-name (expr-list, x)871 auto [lsrc, rsrc]{SplitAssignmentSource(source)};872 const SomeExpr &atom{update.lhs};873 874 if (!IsVarOrFunctionRef(atom)) {875 ErrorShouldBeVariable(atom, rsrc);876 // Skip other checks.877 return std::nullopt;878 }879 880 CheckAtomicVariable(881 atom, lsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(update));882 883 auto [hasErrors, tryReassoc]{CheckAtomicUpdateAssignmentRhs(884 atom, update.rhs, source, /*suppressDiagnostics=*/true)};885 886 if (!hasErrors) {887 CheckStorageOverlap(atom, GetNonAtomArguments(atom, update.rhs), source);888 return std::nullopt;889 } else if (tryReassoc) {890 ReassocRewriter ra(atom, context_);891 SomeExpr raRhs{evaluate::rewrite::Mutator(ra)(update.rhs)};892 893 std::tie(hasErrors, tryReassoc) = CheckAtomicUpdateAssignmentRhs(894 atom, raRhs, source, /*suppressDiagnostics=*/true);895 if (!hasErrors) {896 CheckStorageOverlap(atom, GetNonAtomArguments(atom, raRhs), source);897 898 evaluate::Assignment raAssign(update);899 raAssign.rhs = raRhs;900 return raAssign;901 }902 }903 904 // This is guaranteed to report errors.905 CheckAtomicUpdateAssignmentRhs(906 atom, update.rhs, source, /*suppressDiagnostics=*/false);907 return std::nullopt;908}909 910std::pair<bool, bool> OmpStructureChecker::CheckAtomicUpdateAssignmentRhs(911 const SomeExpr &atom, const SomeExpr &rhs, parser::CharBlock source,912 bool suppressDiagnostics) {913 auto [lsrc, rsrc]{SplitAssignmentSource(source)};914 (void)lsrc;915 916 std::pair<operation::Operator, std::vector<SomeExpr>> top{917 operation::Operator::Unknown, {}};918 if (auto &&maybeInput{GetConvertInput(rhs)}) {919 top = GetTopLevelOperationIgnoreResizing(*maybeInput);920 }921 switch (top.first) {922 case operation::Operator::Add:923 case operation::Operator::Sub:924 case operation::Operator::Mul:925 case operation::Operator::Div:926 case operation::Operator::And:927 case operation::Operator::Or:928 case operation::Operator::Eqv:929 case operation::Operator::Neqv:930 case operation::Operator::Min:931 case operation::Operator::Max:932 case operation::Operator::Identity:933 break;934 case operation::Operator::Call:935 if (!suppressDiagnostics) {936 context_.Say(source,937 "A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US);938 }939 return std::make_pair(true, false);940 case operation::Operator::Convert:941 if (!suppressDiagnostics) {942 context_.Say(source,943 "An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US);944 }945 return std::make_pair(true, false);946 case operation::Operator::Intrinsic:947 if (!suppressDiagnostics) {948 context_.Say(source,949 "This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US);950 }951 return std::make_pair(true, false);952 case operation::Operator::Constant:953 case operation::Operator::Unknown:954 if (!suppressDiagnostics) {955 context_.Say(956 source, "This is not a valid ATOMIC UPDATE operation"_err_en_US);957 }958 return std::make_pair(true, false);959 default:960 assert(961 top.first != operation::Operator::Identity && "Handle this separately");962 if (!suppressDiagnostics) {963 context_.Say(source,964 "The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US,965 operation::ToString(top.first));966 }967 return std::make_pair(true, false);968 }969 // Check how many times `atom` occurs as an argument, if it's a subexpression970 // of an argument, and collect the non-atom arguments.971 std::vector<SomeExpr> nonAtom;972 MaybeExpr subExpr;973 auto atomCount{[&]() {974 int count{0};975 for (const SomeExpr &arg : top.second) {976 if (IsSameOrConvertOf(arg, atom)) {977 ++count;978 } else {979 if (!subExpr && evaluate::IsVarSubexpressionOf(atom, arg)) {980 subExpr = arg;981 }982 nonAtom.push_back(arg);983 }984 }985 return count;986 }()};987 988 bool hasError{false}, tryReassoc{false};989 if (subExpr) {990 if (!suppressDiagnostics) {991 context_.Say(rsrc,992 "The atomic variable %s cannot be a proper subexpression of an argument (here: %s) in the update operation"_err_en_US,993 atom.AsFortran(), subExpr->AsFortran());994 }995 hasError = true;996 }997 if (top.first == operation::Operator::Identity) {998 // This is "x = y".999 assert((atomCount == 0 || atomCount == 1) && "Unexpected count");1000 if (atomCount == 0) {1001 if (!suppressDiagnostics) {1002 context_.Say(rsrc,1003 "The atomic variable %s should appear as an argument in the update operation"_err_en_US,1004 atom.AsFortran());1005 }1006 hasError = true;1007 }1008 } else {1009 if (atomCount == 0) {1010 if (!suppressDiagnostics) {1011 context_.Say(rsrc,1012 "The atomic variable %s should appear as an argument of the top-level %s operator"_err_en_US,1013 atom.AsFortran(), operation::ToString(top.first));1014 }1015 // If `atom` is a proper subexpression, and it not present as an1016 // argument on its own, reassociation may be able to help.1017 tryReassoc = subExpr.has_value();1018 hasError = true;1019 } else if (atomCount > 1) {1020 if (!suppressDiagnostics) {1021 context_.Say(rsrc,1022 "The atomic variable %s should be exactly one of the arguments of the top-level %s operator"_err_en_US,1023 atom.AsFortran(), operation::ToString(top.first));1024 }1025 hasError = true;1026 }1027 }1028 1029 return std::make_pair(hasError, tryReassoc);1030}1031 1032void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(1033 const SomeExpr &cond, parser::CharBlock condSource,1034 const evaluate::Assignment &assign, parser::CharBlock assignSource) {1035 auto [alsrc, arsrc]{SplitAssignmentSource(assignSource)};1036 const SomeExpr &atom{assign.lhs};1037 1038 if (!IsVarOrFunctionRef(atom)) {1039 ErrorShouldBeVariable(atom, arsrc);1040 // Skip other checks.1041 return;1042 }1043 1044 CheckAtomicVariable(1045 atom, alsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(assign));1046 1047 auto top{GetTopLevelOperationIgnoreResizing(cond)};1048 // Missing arguments to operations would have been diagnosed by now.1049 1050 switch (top.first) {1051 case operation::Operator::Associated:1052 if (atom != top.second.front()) {1053 context_.Say(assignSource,1054 "The pointer argument to ASSOCIATED must be same as the target of the assignment"_err_en_US);1055 }1056 break;1057 // x equalop e | e equalop x (allowing "e equalop x" is an extension)1058 case operation::Operator::Eq:1059 case operation::Operator::Eqv:1060 // x ordop expr | expr ordop x1061 case operation::Operator::Lt:1062 case operation::Operator::Gt: {1063 const SomeExpr &arg0{top.second[0]};1064 const SomeExpr &arg1{top.second[1]};1065 if (IsSameOrConvertOf(arg0, atom)) {1066 CheckStorageOverlap(atom, {arg1}, condSource);1067 } else if (IsSameOrConvertOf(arg1, atom)) {1068 CheckStorageOverlap(atom, {arg0}, condSource);1069 } else {1070 assert(top.first != operation::Operator::Identity &&1071 "Handle this separately");1072 context_.Say(assignSource,1073 "An argument of the %s operator should be the target of the assignment"_err_en_US,1074 operation::ToString(top.first));1075 }1076 break;1077 }1078 case operation::Operator::Identity:1079 case operation::Operator::True:1080 case operation::Operator::False:1081 break;1082 default:1083 assert(1084 top.first != operation::Operator::Identity && "Handle this separately");1085 context_.Say(condSource,1086 "The %s operator is not a valid condition for ATOMIC operation"_err_en_US,1087 operation::ToString(top.first));1088 break;1089 }1090}1091 1092void OmpStructureChecker::CheckAtomicConditionalUpdateStmt(1093 const AnalyzedCondStmt &update, parser::CharBlock source) {1094 // The condition/statements must be:1095 // - cond: x equalop e ift: x = d iff: -1096 // - cond: x ordop expr ift: x = expr iff: - (+ commute ordop)1097 // - cond: associated(x) ift: x => expr iff: -1098 // - cond: associated(x, e) ift: x => expr iff: -1099 1100 // The if-true statement must be present, and must be an assignment.1101 auto maybeAssign{GetEvaluateAssignment(update.ift.stmt)};1102 if (!maybeAssign) {1103 if (update.ift.stmt && !IsAssignment(update.ift.stmt)) {1104 context_.Say(update.ift.source,1105 "In ATOMIC UPDATE COMPARE the update statement should be an assignment"_err_en_US);1106 } else {1107 context_.Say(1108 source, "Invalid body of ATOMIC UPDATE COMPARE operation"_err_en_US);1109 }1110 return;1111 }1112 const evaluate::Assignment assign{*maybeAssign};1113 const SomeExpr &atom{assign.lhs};1114 1115 CheckAtomicConditionalUpdateAssignment(1116 update.cond, update.source, assign, update.ift.source);1117 1118 CheckStorageOverlap(atom, {assign.rhs}, update.ift.source);1119 1120 if (update.iff) {1121 context_.Say(update.iff.source,1122 "In ATOMIC UPDATE COMPARE the update statement should not have an ELSE branch"_err_en_US);1123 }1124}1125 1126void OmpStructureChecker::CheckAtomicUpdateOnly(1127 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,1128 parser::CharBlock source) {1129 if (body.size() == 1) {1130 SourcedActionStmt action{GetActionStmt(&body.front())};1131 if (auto maybeUpdate{GetEvaluateAssignment(action.stmt)}) {1132 const SomeExpr &atom{maybeUpdate->lhs};1133 auto maybeAssign{1134 CheckAtomicUpdateAssignment(*maybeUpdate, action.source)};1135 auto &updateAssign{maybeAssign.has_value() ? maybeAssign : maybeUpdate};1136 1137 using Analysis = parser::OpenMPAtomicConstruct::Analysis;1138 x.analysis = AtomicAnalysis(atom)1139 .addOp0(Analysis::Update, updateAssign)1140 .addOp1(Analysis::None);1141 } else if (!IsAssignment(action.stmt)) {1142 context_.Say(1143 source, "ATOMIC UPDATE operation should be an assignment"_err_en_US);1144 }1145 } else {1146 context_.Say(x.source,1147 "ATOMIC UPDATE operation should have a single statement"_err_en_US);1148 }1149}1150 1151void OmpStructureChecker::CheckAtomicConditionalUpdate(1152 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,1153 parser::CharBlock source) {1154 // Allowable forms are (single-statement):1155 // - if ...1156 // - x = (... ? ... : x)1157 // and two-statement:1158 // - r = cond ; if (r) ...1159 1160 const parser::ExecutionPartConstruct *ust{nullptr}; // update1161 const parser::ExecutionPartConstruct *cst{nullptr}; // condition1162 1163 if (body.size() == 1) {1164 ust = &body.front();1165 } else if (body.size() == 2) {1166 cst = &body.front();1167 ust = &body.back();1168 } else {1169 context_.Say(source,1170 "ATOMIC UPDATE COMPARE operation should contain one or two statements"_err_en_US);1171 return;1172 }1173 1174 // Flang doesn't support conditional-expr yet, so all update statements1175 // are if-statements.1176 1177 // IfStmt: if (...) ...1178 // IfConstruct: if (...) then ... endif1179 auto maybeUpdate{AnalyzeConditionalStmt(ust)};1180 if (!maybeUpdate) {1181 context_.Say(source,1182 "In ATOMIC UPDATE COMPARE the update statement should be a conditional statement"_err_en_US);1183 return;1184 }1185 1186 AnalyzedCondStmt &update{*maybeUpdate};1187 1188 if (SourcedActionStmt action{GetActionStmt(cst)}) {1189 // The "condition" statement must be `r = cond`.1190 if (auto maybeCond{GetEvaluateAssignment(action.stmt)}) {1191 if (maybeCond->lhs != update.cond) {1192 context_.Say(update.source,1193 "In ATOMIC UPDATE COMPARE the conditional statement must use %s as the condition"_err_en_US,1194 maybeCond->lhs.AsFortran());1195 } else {1196 // If it's "r = ...; if (r) ..." then put the original condition1197 // in `update`.1198 update.cond = maybeCond->rhs;1199 }1200 } else {1201 context_.Say(action.source,1202 "In ATOMIC UPDATE COMPARE with two statements the first statement should compute the condition"_err_en_US);1203 }1204 }1205 1206 evaluate::Assignment assign{*GetEvaluateAssignment(update.ift.stmt)};1207 1208 CheckAtomicConditionalUpdateStmt(update, source);1209 if (IsCheckForAssociated(update.cond)) {1210 if (!IsPointerAssignment(assign)) {1211 context_.Say(source,1212 "The assignment should be a pointer-assignment when the condition is ASSOCIATED"_err_en_US);1213 }1214 } else {1215 if (IsPointerAssignment(assign)) {1216 context_.Say(source,1217 "The assignment cannot be a pointer-assignment except when the condition is ASSOCIATED"_err_en_US);1218 }1219 }1220 1221 using Analysis = parser::OpenMPAtomicConstruct::Analysis;1222 const SomeExpr &atom{assign.lhs};1223 1224 x.analysis = AtomicAnalysis(atom, update.cond)1225 .addOp0(Analysis::Update | Analysis::IfTrue, assign)1226 .addOp1(Analysis::None);1227}1228 1229void OmpStructureChecker::CheckAtomicUpdateCapture(1230 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,1231 parser::CharBlock source) {1232 if (body.size() != 2) {1233 context_.Say(source,1234 "ATOMIC UPDATE operation with CAPTURE should contain two statements"_err_en_US);1235 return;1236 }1237 1238 auto [uec, cec]{CheckUpdateCapture(&body.front(), &body.back(), source)};1239 if (!uec || !cec) {1240 // Diagnostics already emitted.1241 return;1242 }1243 SourcedActionStmt uact{GetActionStmt(uec)};1244 SourcedActionStmt cact{GetActionStmt(cec)};1245 // The "dereferences" of std::optional are guaranteed to be valid after1246 // CheckUpdateCapture.1247 evaluate::Assignment update{*GetEvaluateAssignment(uact.stmt)};1248 evaluate::Assignment capture{*GetEvaluateAssignment(cact.stmt)};1249 1250 const SomeExpr &atom{update.lhs};1251 1252 using Analysis = parser::OpenMPAtomicConstruct::Analysis;1253 int action;1254 1255 std::optional<evaluate::Assignment> updateAssign{update};1256 if (IsMaybeAtomicWrite(update)) {1257 action = Analysis::Write;1258 CheckAtomicWriteAssignment(update, uact.source);1259 } else {1260 action = Analysis::Update;1261 if (auto &&maybe{CheckAtomicUpdateAssignment(update, uact.source)}) {1262 updateAssign = maybe;1263 }1264 }1265 CheckAtomicCaptureAssignment(capture, atom, cact.source);1266 1267 if (IsPointerAssignment(*updateAssign) != IsPointerAssignment(capture)) {1268 context_.Say(cact.source,1269 "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);1270 return;1271 }1272 1273 if (GetActionStmt(&body.front()).stmt == uact.stmt) {1274 x.analysis = AtomicAnalysis(atom)1275 .addOp0(action, updateAssign)1276 .addOp1(Analysis::Read, capture);1277 } else {1278 x.analysis = AtomicAnalysis(atom)1279 .addOp0(Analysis::Read, capture)1280 .addOp1(action, updateAssign);1281 }1282}1283 1284void OmpStructureChecker::CheckAtomicConditionalUpdateCapture(1285 const parser::OpenMPAtomicConstruct &x, const parser::Block &body,1286 parser::CharBlock source) {1287 // There are two different variants of this:1288 // (1) conditional-update and capture separately:1289 // This form only allows single-statement updates, i.e. the update1290 // form "r = cond; if (r) ..." is not allowed.1291 // (2) conditional-update combined with capture in a single statement:1292 // This form does allow the condition to be calculated separately,1293 // i.e. "r = cond; if (r) ...".1294 // Regardless of what form it is, the actual update assignment is a1295 // proper write, i.e. "x = d", where d does not depend on x.1296 1297 AnalyzedCondStmt update;1298 SourcedActionStmt capture;1299 bool captureAlways{true}, captureFirst{true};1300 1301 auto extractCapture{[&]() {1302 capture = update.iff;1303 captureAlways = false;1304 update.iff = SourcedActionStmt{};1305 }};1306 1307 auto classifyNonUpdate{[&](const SourcedActionStmt &action) {1308 // The non-update statement is either "r = cond" or the capture.1309 if (auto maybeAssign{GetEvaluateAssignment(action.stmt)}) {1310 if (update.cond == maybeAssign->lhs) {1311 // If this is "r = cond; if (r) ...", then update the condition.1312 update.cond = maybeAssign->rhs;1313 update.source = action.source;1314 // In this form, the update and the capture are combined into1315 // an IF-THEN-ELSE statement.1316 extractCapture();1317 } else {1318 // Assume this is the capture-statement.1319 capture = action;1320 }1321 }1322 }};1323 1324 if (body.size() == 2) {1325 // This could be1326 // - capture; conditional-update (in any order), or1327 // - r = cond; if (r) capture-update1328 const parser::ExecutionPartConstruct *st1{&body.front()};1329 const parser::ExecutionPartConstruct *st2{&body.back()};1330 // In either case, the conditional statement can be analyzed by1331 // AnalyzeConditionalStmt, whereas the other statement cannot.1332 if (auto maybeUpdate1{AnalyzeConditionalStmt(st1)}) {1333 update = *maybeUpdate1;1334 classifyNonUpdate(GetActionStmt(st2));1335 captureFirst = false;1336 } else if (auto maybeUpdate2{AnalyzeConditionalStmt(st2)}) {1337 update = *maybeUpdate2;1338 classifyNonUpdate(GetActionStmt(st1));1339 } else {1340 // None of the statements are conditional, this rules out the1341 // "r = cond; if (r) ..." and the "capture + conditional-update"1342 // variants. This could still be capture + write (which is classified1343 // as conditional-update-capture in the spec).1344 auto [uec, cec]{CheckUpdateCapture(st1, st2, source)};1345 if (!uec || !cec) {1346 // Diagnostics already emitted.1347 return;1348 }1349 SourcedActionStmt uact{GetActionStmt(uec)};1350 SourcedActionStmt cact{GetActionStmt(cec)};1351 update.ift = uact;1352 capture = cact;1353 if (uec == st1) {1354 captureFirst = false;1355 }1356 }1357 } else if (body.size() == 1) {1358 if (auto maybeUpdate{AnalyzeConditionalStmt(&body.front())}) {1359 update = *maybeUpdate;1360 // This is the form with update and capture combined into an IF-THEN-ELSE1361 // statement. The capture-statement is always the ELSE branch.1362 extractCapture();1363 } else {1364 goto invalid;1365 }1366 } else {1367 context_.Say(source,1368 "ATOMIC UPDATE COMPARE CAPTURE operation should contain one or two statements"_err_en_US);1369 return;1370 invalid:1371 context_.Say(source,1372 "Invalid body of ATOMIC UPDATE COMPARE CAPTURE operation"_err_en_US);1373 return;1374 }1375 1376 // The update must have a form `x = d` or `x => d`.1377 if (auto maybeWrite{GetEvaluateAssignment(update.ift.stmt)}) {1378 const SomeExpr &atom{maybeWrite->lhs};1379 CheckAtomicWriteAssignment(*maybeWrite, update.ift.source);1380 if (auto maybeCapture{GetEvaluateAssignment(capture.stmt)}) {1381 CheckAtomicCaptureAssignment(*maybeCapture, atom, capture.source);1382 1383 if (IsPointerAssignment(*maybeWrite) !=1384 IsPointerAssignment(*maybeCapture)) {1385 context_.Say(capture.source,1386 "The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);1387 return;1388 }1389 } else {1390 if (!IsAssignment(capture.stmt)) {1391 context_.Say(capture.source,1392 "In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US);1393 }1394 return;1395 }1396 } else {1397 if (!IsAssignment(update.ift.stmt)) {1398 context_.Say(update.ift.source,1399 "In ATOMIC UPDATE COMPARE CAPTURE the update statement should be an assignment"_err_en_US);1400 }1401 return;1402 }1403 1404 // update.iff should be empty here, the capture statement should be1405 // stored in "capture".1406 1407 // Fill out the analysis in the AST node.1408 using Analysis = parser::OpenMPAtomicConstruct::Analysis;1409 bool condUnused{std::visit(1410 [](auto &&s) {1411 using BareS = llvm::remove_cvref_t<decltype(s)>;1412 if constexpr (std::is_same_v<BareS, evaluate::NullPointer>) {1413 return true;1414 } else {1415 return false;1416 }1417 },1418 update.cond.u)};1419 1420 int updateWhen{!condUnused ? Analysis::IfTrue : 0};1421 int captureWhen{!captureAlways ? Analysis::IfFalse : 0};1422 1423 evaluate::Assignment updAssign{*GetEvaluateAssignment(update.ift.stmt)};1424 evaluate::Assignment capAssign{*GetEvaluateAssignment(capture.stmt)};1425 const SomeExpr &atom{updAssign.lhs};1426 1427 if (captureFirst) {1428 x.analysis = AtomicAnalysis(atom, update.cond)1429 .addOp0(Analysis::Read | captureWhen, capAssign)1430 .addOp1(Analysis::Write | updateWhen, updAssign);1431 } else {1432 x.analysis = AtomicAnalysis(atom, update.cond)1433 .addOp0(Analysis::Write | updateWhen, updAssign)1434 .addOp1(Analysis::Read | captureWhen, capAssign);1435 }1436}1437 1438void OmpStructureChecker::CheckAtomicRead(1439 const parser::OpenMPAtomicConstruct &x) {1440 // [6.0:190:5-7]1441 // A read structured block is read-statement, a read statement that has one1442 // of the following forms:1443 // v = x1444 // v => x1445 auto &block{std::get<parser::Block>(x.t)};1446 1447 // Read cannot be conditional or have a capture statement.1448 if (x.IsCompare() || x.IsCapture()) {1449 context_.Say(x.BeginDir().source,1450 "ATOMIC READ cannot have COMPARE or CAPTURE clauses"_err_en_US);1451 return;1452 }1453 1454 const parser::Block &body{GetInnermostExecPart(block)};1455 1456 if (body.size() == 1) {1457 SourcedActionStmt action{GetActionStmt(&body.front())};1458 if (auto maybeRead{GetEvaluateAssignment(action.stmt)}) {1459 CheckAtomicReadAssignment(*maybeRead, action.source);1460 1461 if (auto maybe{GetConvertInput(maybeRead->rhs)}) {1462 const SomeExpr &atom{*maybe};1463 using Analysis = parser::OpenMPAtomicConstruct::Analysis;1464 x.analysis = AtomicAnalysis(atom)1465 .addOp0(Analysis::Read, maybeRead)1466 .addOp1(Analysis::None);1467 }1468 } else if (!IsAssignment(action.stmt)) {1469 context_.Say(1470 x.source, "ATOMIC READ operation should be an assignment"_err_en_US);1471 }1472 } else {1473 context_.Say(x.source,1474 "ATOMIC READ operation should have a single statement"_err_en_US);1475 }1476}1477 1478void OmpStructureChecker::CheckAtomicWrite(1479 const parser::OpenMPAtomicConstruct &x) {1480 auto &block{std::get<parser::Block>(x.t)};1481 1482 // Write cannot be conditional or have a capture statement.1483 if (x.IsCompare() || x.IsCapture()) {1484 context_.Say(x.BeginDir().source,1485 "ATOMIC WRITE cannot have COMPARE or CAPTURE clauses"_err_en_US);1486 return;1487 }1488 1489 const parser::Block &body{GetInnermostExecPart(block)};1490 1491 if (body.size() == 1) {1492 SourcedActionStmt action{GetActionStmt(&body.front())};1493 if (auto maybeWrite{GetEvaluateAssignment(action.stmt)}) {1494 const SomeExpr &atom{maybeWrite->lhs};1495 CheckAtomicWriteAssignment(*maybeWrite, action.source);1496 1497 using Analysis = parser::OpenMPAtomicConstruct::Analysis;1498 x.analysis = AtomicAnalysis(atom)1499 .addOp0(Analysis::Write, maybeWrite)1500 .addOp1(Analysis::None);1501 } else if (!IsAssignment(action.stmt)) {1502 context_.Say(1503 x.source, "ATOMIC WRITE operation should be an assignment"_err_en_US);1504 }1505 } else {1506 context_.Say(x.source,1507 "ATOMIC WRITE operation should have a single statement"_err_en_US);1508 }1509}1510 1511void OmpStructureChecker::CheckAtomicUpdate(1512 const parser::OpenMPAtomicConstruct &x) {1513 auto &block{std::get<parser::Block>(x.t)};1514 1515 bool isConditional{x.IsCompare()};1516 bool isCapture{x.IsCapture()};1517 const parser::Block &body{GetInnermostExecPart(block)};1518 1519 if (isConditional && isCapture) {1520 CheckAtomicConditionalUpdateCapture(x, body, x.source);1521 } else if (isConditional) {1522 CheckAtomicConditionalUpdate(x, body, x.source);1523 } else if (isCapture) {1524 CheckAtomicUpdateCapture(x, body, x.source);1525 } else { // update-only1526 CheckAtomicUpdateOnly(x, body, x.source);1527 }1528}1529 1530void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {1531 if (visitedAtomicSource_.empty())1532 visitedAtomicSource_ = x.source;1533 1534 // All of the following groups have the "exclusive" property, i.e. at1535 // most one clause from each group is allowed.1536 // The exclusivity-checking code should eventually be unified for all1537 // clauses, with clause groups defined in OMP.td.1538 std::array atomic{llvm::omp::Clause::OMPC_read,1539 llvm::omp::Clause::OMPC_update, llvm::omp::Clause::OMPC_write};1540 std::array memoryOrder{llvm::omp::Clause::OMPC_acq_rel,1541 llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_relaxed,1542 llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_seq_cst};1543 1544 auto checkExclusive{[&](llvm::ArrayRef<llvm::omp::Clause> group,1545 std::string_view name,1546 const parser::OmpClauseList &clauses) {1547 const parser::OmpClause *present{nullptr};1548 for (const parser::OmpClause &clause : clauses.v) {1549 llvm::omp::Clause id{clause.Id()};1550 if (!llvm::is_contained(group, id)) {1551 continue;1552 }1553 if (present == nullptr) {1554 present = &clause;1555 continue;1556 } else if (id == present->Id()) {1557 // Ignore repetitions of the same clause, those will be diagnosed1558 // separately.1559 continue;1560 }1561 parser::MessageFormattedText txt(1562 "At most one clause from the '%s' group is allowed on ATOMIC construct"_err_en_US,1563 name.data());1564 parser::Message message(clause.source, txt);1565 message.Attach(present->source,1566 "Previous clause from this group provided here"_en_US);1567 context_.Say(std::move(message));1568 return;1569 }1570 }};1571 1572 const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};1573 auto &dir{std::get<parser::OmpDirectiveName>(dirSpec.t)};1574 PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_atomic);1575 llvm::omp::Clause kind{x.GetKind()};1576 1577 checkExclusive(atomic, "atomic", dirSpec.Clauses());1578 checkExclusive(memoryOrder, "memory-order", dirSpec.Clauses());1579 1580 switch (kind) {1581 case llvm::omp::Clause::OMPC_read:1582 CheckAtomicRead(x);1583 break;1584 case llvm::omp::Clause::OMPC_write:1585 CheckAtomicWrite(x);1586 break;1587 case llvm::omp::Clause::OMPC_update:1588 CheckAtomicUpdate(x);1589 break;1590 default:1591 break;1592 }1593}1594 1595void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {1596 dirContext_.pop_back();1597}1598 1599// Rewrite min/max:1600// Min and max intrinsics in Fortran take an arbitrary number of arguments1601// (two or more). The first two are mandatory, the rest is optional. That1602// means that arguments beyond the first two may be optional dummy argument1603// from the caller. In that case, a reference to such an argument will1604// cause presence test to be emitted, which cannot go inside of the atomic1605// operation. Since the atom operand must be present, rewrite the min/max1606// operation in a way that avoid the presence tests in the atomic code.1607// For example, in1608// subroutine f(atom, x, y, z)1609// integer :: atom, x1610// integer, optional :: y, z1611// !$omp atomic update1612// atom = min(atom, x, y, z)1613// end1614// the min operation will become1615// atom = min(atom, min(x, y, z))1616// and in the final code1617// // Presence check is fine here.1618// tmp = min(x, y, z)1619// atomic update {1620// // Both operands are mandatory, no presence check needed.1621// atom = min(atom, tmp)1622// }1623struct MinMaxRewriter : public evaluate::rewrite::Identity {1624 using Id = evaluate::rewrite::Identity;1625 using Id::operator();1626 1627 MinMaxRewriter(const SomeExpr &atom) : atom_(atom) {}1628 1629 static bool IsMinMax(const evaluate::ProcedureDesignator &p) {1630 if (auto *intrin{p.GetSpecificIntrinsic()}) {1631 return intrin->name == "min" || intrin->name == "max";1632 }1633 return false;1634 }1635 1636 // Take a list of arguments to a min/max operation, e.g. [a0, a1, ...]1637 // One of the a_i's, say a_t, must be the atom.1638 // Generate1639 // min/max(a_t, min/max(a0, a1, ... [except a_t]))1640 template <typename T>1641 evaluate::Expr<T> operator()(1642 evaluate::Expr<T> &&x, const evaluate::FunctionRef<T> &f) {1643 const evaluate::ProcedureDesignator &proc = f.proc();1644 if (!IsMinMax(proc) || f.arguments().size() <= 2) {1645 return Id::operator()(std::move(x), f);1646 }1647 1648 // Collect arguments as SomeExpr's and find out which argument1649 // corresponds to atom.1650 const SomeExpr *atomArg{nullptr};1651 std::vector<const SomeExpr *> args;1652 for (const std::optional<evaluate::ActualArgument> &a : f.arguments()) {1653 if (!a) {1654 continue;1655 }1656 if (const SomeExpr *e{a->UnwrapExpr()}) {1657 if (evaluate::IsSameOrConvertOf(*e, atom_)) {1658 atomArg = e;1659 }1660 args.push_back(e);1661 }1662 }1663 if (!atomArg) {1664 return Id::operator()(std::move(x), f);1665 }1666 1667 evaluate::ActualArguments nonAtoms;1668 1669 auto AsActual = [](const SomeExpr &z) {1670 SomeExpr copy = z;1671 return evaluate::ActualArgument(std::move(copy));1672 };1673 // Semantic checks guarantee that the "atom" shows exactly once in the1674 // argument list (with potential conversions around it).1675 // For the first two (non-optional) arguments, if "atom" is among them,1676 // replace it with another occurrence of the other non-optional argument.1677 if (atomArg == args[0]) {1678 // (atom, x, y...) -> (x, x, y...)1679 nonAtoms.push_back(AsActual(*args[1]));1680 nonAtoms.push_back(AsActual(*args[1]));1681 } else if (atomArg == args[1]) {1682 // (x, atom, y...) -> (x, x, y...)1683 nonAtoms.push_back(AsActual(*args[0]));1684 nonAtoms.push_back(AsActual(*args[0]));1685 } else {1686 // (x, y, z...) -> unchanged1687 nonAtoms.push_back(AsActual(*args[0]));1688 nonAtoms.push_back(AsActual(*args[1]));1689 }1690 1691 // The rest of arguments are optional, so we can just skip "atom".1692 for (size_t i = 2, e = args.size(); i != e; ++i) {1693 if (atomArg != args[i])1694 nonAtoms.push_back(AsActual(*args[i]));1695 }1696 1697 SomeExpr tmp = evaluate::AsGenericExpr(1698 evaluate::FunctionRef<T>(AsRvalue(proc), AsRvalue(nonAtoms)));1699 1700 return evaluate::Expr<T>(evaluate::FunctionRef<T>(1701 AsRvalue(proc), {AsActual(*atomArg), AsActual(tmp)}));1702 }1703 1704private:1705 const SomeExpr &atom_;1706};1707 1708static MaybeExpr PostSemaRewrite(const SomeExpr &atom, const SomeExpr &expr) {1709 MinMaxRewriter rewriter(atom);1710 return evaluate::rewrite::Mutator(rewriter)(expr);1711}1712 1713} // namespace Fortran::semantics1714