llvm-project
177 строк · 6.3 Кб
1//===-- lib/Semantics/rewrite-directives.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
9#include "rewrite-directives.h"
10#include "flang/Parser/parse-tree-visitor.h"
11#include "flang/Parser/parse-tree.h"
12#include "flang/Semantics/semantics.h"
13#include "flang/Semantics/symbol.h"
14#include "llvm/Frontend/OpenMP/OMP.h"
15#include <list>
16
17namespace Fortran::semantics {
18
19using namespace parser::literals;
20
21class DirectiveRewriteMutator {
22public:
23explicit DirectiveRewriteMutator(SemanticsContext &context)
24: context_{context} {}
25
26// Default action for a parse tree node is to visit children.
27template <typename T> bool Pre(T &) { return true; }
28template <typename T> void Post(T &) {}
29
30protected:
31SemanticsContext &context_;
32};
33
34// Rewrite atomic constructs to add an explicit memory ordering to all that do
35// not specify it, honoring in this way the `atomic_default_mem_order` clause of
36// the REQUIRES directive.
37class OmpRewriteMutator : public DirectiveRewriteMutator {
38public:
39explicit OmpRewriteMutator(SemanticsContext &context)
40: DirectiveRewriteMutator(context) {}
41
42template <typename T> bool Pre(T &) { return true; }
43template <typename T> void Post(T &) {}
44
45bool Pre(parser::OpenMPAtomicConstruct &);
46bool Pre(parser::OpenMPRequiresConstruct &);
47
48private:
49bool atomicDirectiveDefaultOrderFound_{false};
50};
51
52bool OmpRewriteMutator::Pre(parser::OpenMPAtomicConstruct &x) {
53// Find top-level parent of the operation.
54Symbol *topLevelParent{common::visit(
55[&](auto &atomic) {
56Symbol *symbol{nullptr};
57Scope *scope{
58&context_.FindScope(std::get<parser::Verbatim>(atomic.t).source)};
59do {
60if (Symbol * parent{scope->symbol()}) {
61symbol = parent;
62}
63scope = &scope->parent();
64} while (!scope->IsGlobal());
65
66assert(symbol &&
67"Atomic construct must be within a scope associated with a symbol");
68return symbol;
69},
70x.u)};
71
72// Get the `atomic_default_mem_order` clause from the top-level parent.
73std::optional<common::OmpAtomicDefaultMemOrderType> defaultMemOrder;
74common::visit(
75[&](auto &details) {
76if constexpr (std::is_convertible_v<decltype(&details),
77WithOmpDeclarative *>) {
78if (details.has_ompAtomicDefaultMemOrder()) {
79defaultMemOrder = *details.ompAtomicDefaultMemOrder();
80}
81}
82},
83topLevelParent->details());
84
85if (!defaultMemOrder) {
86return false;
87}
88
89auto findMemOrderClause =
90[](const std::list<parser::OmpAtomicClause> &clauses) {
91return std::find_if(
92clauses.begin(), clauses.end(), [](const auto &clause) {
93return std::get_if<parser::OmpMemoryOrderClause>(
94&clause.u);
95}) != clauses.end();
96};
97
98// Get the clause list to which the new memory order clause must be added,
99// only if there are no other memory order clauses present for this atomic
100// directive.
101std::list<parser::OmpAtomicClause> *clauseList = common::visit(
102common::visitors{[&](parser::OmpAtomic &atomicConstruct) {
103// OmpAtomic only has a single list of clauses.
104auto &clauses{std::get<parser::OmpAtomicClauseList>(
105atomicConstruct.t)};
106return !findMemOrderClause(clauses.v) ? &clauses.v
107: nullptr;
108},
109[&](auto &atomicConstruct) {
110// All other atomic constructs have two lists of clauses.
111auto &clausesLhs{std::get<0>(atomicConstruct.t)};
112auto &clausesRhs{std::get<2>(atomicConstruct.t)};
113return !findMemOrderClause(clausesLhs.v) &&
114!findMemOrderClause(clausesRhs.v)
115? &clausesRhs.v
116: nullptr;
117}},
118x.u);
119
120// Add a memory order clause to the atomic directive.
121if (clauseList) {
122atomicDirectiveDefaultOrderFound_ = true;
123switch (*defaultMemOrder) {
124case common::OmpAtomicDefaultMemOrderType::AcqRel:
125clauseList->emplace_back<parser::OmpMemoryOrderClause>(common::visit(
126common::visitors{[](parser::OmpAtomicRead &) -> parser::OmpClause {
127return parser::OmpClause::Acquire{};
128},
129[](parser::OmpAtomicCapture &) -> parser::OmpClause {
130return parser::OmpClause::AcqRel{};
131},
132[](auto &) -> parser::OmpClause {
133// parser::{OmpAtomic, OmpAtomicUpdate, OmpAtomicWrite}
134return parser::OmpClause::Release{};
135}},
136x.u));
137break;
138case common::OmpAtomicDefaultMemOrderType::Relaxed:
139clauseList->emplace_back<parser::OmpMemoryOrderClause>(
140parser::OmpClause{parser::OmpClause::Relaxed{}});
141break;
142case common::OmpAtomicDefaultMemOrderType::SeqCst:
143clauseList->emplace_back<parser::OmpMemoryOrderClause>(
144parser::OmpClause{parser::OmpClause::SeqCst{}});
145break;
146}
147}
148
149return false;
150}
151
152bool OmpRewriteMutator::Pre(parser::OpenMPRequiresConstruct &x) {
153for (parser::OmpClause &clause : std::get<parser::OmpClauseList>(x.t).v) {
154if (std::holds_alternative<parser::OmpClause::AtomicDefaultMemOrder>(
155clause.u) &&
156atomicDirectiveDefaultOrderFound_) {
157context_.Say(clause.source,
158"REQUIRES directive with '%s' clause found lexically after atomic "
159"operation without a memory order clause"_err_en_US,
160parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(
161llvm::omp::OMPC_atomic_default_mem_order)
162.str()));
163}
164}
165return false;
166}
167
168bool RewriteOmpParts(SemanticsContext &context, parser::Program &program) {
169if (!context.IsEnabled(common::LanguageFeature::OpenMP)) {
170return true;
171}
172OmpRewriteMutator ompMutator{context};
173parser::Walk(program, ompMutator);
174return !context.AnyFatalError();
175}
176
177} // namespace Fortran::semantics
178