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 | |
17 | namespace Fortran::semantics { |
18 | |
19 | using namespace parser::literals; |
20 | |
21 | class DirectiveRewriteMutator { |
22 | public: |
23 | explicit DirectiveRewriteMutator(SemanticsContext &context) |
24 | : context_{context} {} |
25 | |
26 | // Default action for a parse tree node is to visit children. |
27 | template <typename T> bool Pre(T &) { return true; } |
28 | template <typename T> void Post(T &) {} |
29 | |
30 | protected: |
31 | SemanticsContext &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. |
37 | class OmpRewriteMutator : public DirectiveRewriteMutator { |
38 | public: |
39 | explicit OmpRewriteMutator(SemanticsContext &context) |
40 | : DirectiveRewriteMutator(context) {} |
41 | |
42 | template <typename T> bool Pre(T &) { return true; } |
43 | template <typename T> void Post(T &) {} |
44 | |
45 | bool Pre(parser::OpenMPAtomicConstruct &); |
46 | bool Pre(parser::OpenMPRequiresConstruct &); |
47 | |
48 | private: |
49 | bool atomicDirectiveDefaultOrderFound_{false}; |
50 | }; |
51 | |
52 | bool OmpRewriteMutator::Pre(parser::OpenMPAtomicConstruct &x) { |
53 | // Find top-level parent of the operation. |
54 | Symbol *topLevelParent{[&]() { |
55 | Symbol *symbol{nullptr}; |
56 | Scope *scope{&context_.FindScope( |
57 | std::get<parser::OmpDirectiveSpecification>(x.t).source)}; |
58 | do { |
59 | if (Symbol * parent{scope->symbol()}) { |
60 | symbol = parent; |
61 | } |
62 | scope = &scope->parent(); |
63 | } while (!scope->IsGlobal()); |
64 | |
65 | assert(symbol && |
66 | "Atomic construct must be within a scope associated with a symbol" ); |
67 | return symbol; |
68 | }()}; |
69 | |
70 | // Get the `atomic_default_mem_order` clause from the top-level parent. |
71 | std::optional<common::OmpMemoryOrderType> defaultMemOrder; |
72 | common::visit( |
73 | [&](auto &details) { |
74 | if constexpr (std::is_convertible_v<decltype(&details), |
75 | WithOmpDeclarative *>) { |
76 | if (details.has_ompAtomicDefaultMemOrder()) { |
77 | defaultMemOrder = *details.ompAtomicDefaultMemOrder(); |
78 | } |
79 | } |
80 | }, |
81 | topLevelParent->details()); |
82 | |
83 | if (!defaultMemOrder) { |
84 | return false; |
85 | } |
86 | |
87 | auto findMemOrderClause{[](const parser::OmpClauseList &clauses) { |
88 | return llvm::any_of( |
89 | clauses.v, [](auto &clause) -> const parser::OmpClause * { |
90 | switch (clause.Id()) { |
91 | case llvm::omp::Clause::OMPC_acq_rel: |
92 | case llvm::omp::Clause::OMPC_acquire: |
93 | case llvm::omp::Clause::OMPC_relaxed: |
94 | case llvm::omp::Clause::OMPC_release: |
95 | case llvm::omp::Clause::OMPC_seq_cst: |
96 | return &clause; |
97 | default: |
98 | return nullptr; |
99 | } |
100 | }); |
101 | }}; |
102 | |
103 | auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)}; |
104 | auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(dirSpec.t)}; |
105 | if (clauseList) { |
106 | if (findMemOrderClause(*clauseList)) { |
107 | return false; |
108 | } |
109 | } else { |
110 | clauseList = parser::OmpClauseList(decltype(parser::OmpClauseList::v){}); |
111 | } |
112 | |
113 | // Add a memory order clause to the atomic directive. |
114 | atomicDirectiveDefaultOrderFound_ = true; |
115 | switch (*defaultMemOrder) { |
116 | case common::OmpMemoryOrderType::Acq_Rel: |
117 | clauseList->v.emplace_back(parser::OmpClause{parser::OmpClause::AcqRel{}}); |
118 | break; |
119 | case common::OmpMemoryOrderType::Relaxed: |
120 | clauseList->v.emplace_back(parser::OmpClause{parser::OmpClause::Relaxed{}}); |
121 | break; |
122 | case common::OmpMemoryOrderType::Seq_Cst: |
123 | clauseList->v.emplace_back(parser::OmpClause{parser::OmpClause::SeqCst{}}); |
124 | break; |
125 | default: |
126 | // FIXME: Don't process other values at the moment since their validity |
127 | // depends on the OpenMP version (which is unavailable here). |
128 | break; |
129 | } |
130 | |
131 | return false; |
132 | } |
133 | |
134 | bool OmpRewriteMutator::Pre(parser::OpenMPRequiresConstruct &x) { |
135 | for (parser::OmpClause &clause : std::get<parser::OmpClauseList>(x.t).v) { |
136 | if (std::holds_alternative<parser::OmpClause::AtomicDefaultMemOrder>( |
137 | clause.u) && |
138 | atomicDirectiveDefaultOrderFound_) { |
139 | context_.Say(clause.source, |
140 | "REQUIRES directive with '%s' clause found lexically after atomic " |
141 | "operation without a memory order clause"_err_en_US , |
142 | parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName( |
143 | llvm::omp::OMPC_atomic_default_mem_order) |
144 | .str())); |
145 | } |
146 | } |
147 | return false; |
148 | } |
149 | |
150 | bool RewriteOmpParts(SemanticsContext &context, parser::Program &program) { |
151 | if (!context.IsEnabled(common::LanguageFeature::OpenMP)) { |
152 | return true; |
153 | } |
154 | OmpRewriteMutator ompMutator{context}; |
155 | parser::Walk(program, ompMutator); |
156 | return !context.AnyFatalError(); |
157 | } |
158 | |
159 | } // namespace Fortran::semantics |
160 | |