1 //===-- include/flang/Evaluate/common.h -------------------------*- C++ -*-===//
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 #ifndef FORTRAN_EVALUATE_COMMON_H_
10 #define FORTRAN_EVALUATE_COMMON_H_
11 
12 #include "flang/Common/Fortran.h"
13 #include "flang/Common/default-kinds.h"
14 #include "flang/Common/enum-set.h"
15 #include "flang/Common/idioms.h"
16 #include "flang/Common/indirection.h"
17 #include "flang/Common/restorer.h"
18 #include "flang/Parser/char-block.h"
19 #include "flang/Parser/message.h"
20 #include <cinttypes>
21 #include <map>
22 
23 namespace Fortran::semantics {
24 class DerivedTypeSpec;
25 }
26 
27 namespace Fortran::evaluate {
28 class IntrinsicProcTable;
29 
30 using common::ConstantSubscript;
31 using common::RelationalOperator;
32 
33 // Integers are always ordered; reals may not be.
ENUM_CLASS(Ordering,Less,Equal,Greater)34 ENUM_CLASS(Ordering, Less, Equal, Greater)
35 ENUM_CLASS(Relation, Less, Equal, Greater, Unordered)
36 
37 template <typename A>
38 static constexpr Ordering Compare(const A &x, const A &y) {
39   if (x < y) {
40     return Ordering::Less;
41   } else if (x > y) {
42     return Ordering::Greater;
43   } else {
44     return Ordering::Equal;
45   }
46 }
47 
Reverse(Ordering ordering)48 static constexpr Ordering Reverse(Ordering ordering) {
49   if (ordering == Ordering::Less) {
50     return Ordering::Greater;
51   } else if (ordering == Ordering::Greater) {
52     return Ordering::Less;
53   } else {
54     return Ordering::Equal;
55   }
56 }
57 
RelationFromOrdering(Ordering ordering)58 static constexpr Relation RelationFromOrdering(Ordering ordering) {
59   if (ordering == Ordering::Less) {
60     return Relation::Less;
61   } else if (ordering == Ordering::Greater) {
62     return Relation::Greater;
63   } else {
64     return Relation::Equal;
65   }
66 }
67 
Reverse(Relation relation)68 static constexpr Relation Reverse(Relation relation) {
69   if (relation == Relation::Less) {
70     return Relation::Greater;
71   } else if (relation == Relation::Greater) {
72     return Relation::Less;
73   } else {
74     return relation;
75   }
76 }
77 
Satisfies(RelationalOperator op,Ordering order)78 static constexpr bool Satisfies(RelationalOperator op, Ordering order) {
79   switch (order) {
80   case Ordering::Less:
81     return op == RelationalOperator::LT || op == RelationalOperator::LE ||
82         op == RelationalOperator::NE;
83   case Ordering::Equal:
84     return op == RelationalOperator::LE || op == RelationalOperator::EQ ||
85         op == RelationalOperator::GE;
86   case Ordering::Greater:
87     return op == RelationalOperator::NE || op == RelationalOperator::GE ||
88         op == RelationalOperator::GT;
89   }
90   return false; // silence g++ warning
91 }
92 
Satisfies(RelationalOperator op,Relation relation)93 static constexpr bool Satisfies(RelationalOperator op, Relation relation) {
94   switch (relation) {
95   case Relation::Less:
96     return Satisfies(op, Ordering::Less);
97   case Relation::Equal:
98     return Satisfies(op, Ordering::Equal);
99   case Relation::Greater:
100     return Satisfies(op, Ordering::Greater);
101   case Relation::Unordered:
102     return false;
103   }
104   return false; // silence g++ warning
105 }
106 
107 ENUM_CLASS(
108     RealFlag, Overflow, DivideByZero, InvalidArgument, Underflow, Inexact)
109 
110 using RealFlags = common::EnumSet<RealFlag, RealFlag_enumSize>;
111 
112 template <typename A> struct ValueWithRealFlags {
AccumulateFlagsValueWithRealFlags113   A AccumulateFlags(RealFlags &f) {
114     f |= flags;
115     return value;
116   }
117   A value;
118   RealFlags flags{};
119 };
120 
121 struct Rounding {
122   common::RoundingMode mode{common::RoundingMode::TiesToEven};
123   // When set, emulate status flag behavior peculiar to x86
124   // (viz., fail to set the Underflow flag when an inexact product of a
125   // multiplication is rounded up to a normal number from a subnormal
126   // in some rounding modes)
127 #if __x86_64__
128   bool x86CompatibleBehavior{true};
129 #else
130   bool x86CompatibleBehavior{false};
131 #endif
132 };
133 
134 static constexpr Rounding defaultRounding;
135 
136 #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
137 constexpr bool isHostLittleEndian{false};
138 #elif __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
139 constexpr bool isHostLittleEndian{true};
140 #else
141 #error host endianness is not known
142 #endif
143 
144 // HostUnsignedInt<BITS> finds the smallest native unsigned integer type
145 // whose size is >= BITS.
146 template <bool LE8, bool LE16, bool LE32, bool LE64> struct SmallestUInt {};
147 template <> struct SmallestUInt<true, true, true, true> {
148   using type = std::uint8_t;
149 };
150 template <> struct SmallestUInt<false, true, true, true> {
151   using type = std::uint16_t;
152 };
153 template <> struct SmallestUInt<false, false, true, true> {
154   using type = std::uint32_t;
155 };
156 template <> struct SmallestUInt<false, false, false, true> {
157   using type = std::uint64_t;
158 };
159 template <int BITS>
160 using HostUnsignedInt =
161     typename SmallestUInt<BITS <= 8, BITS <= 16, BITS <= 32, BITS <= 64>::type;
162 
163 // Many classes in this library follow a common paradigm.
164 // - There is no default constructor (Class() {}), usually to prevent the
165 //   need for std::monostate as a default constituent in a std::variant<>.
166 // - There are full copy and move semantics for construction and assignment.
167 // - Discriminated unions have a std::variant<> member "u" and support
168 //   explicit copy and move constructors as well as comparison for equality.
169 #define DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
170   t(const t &); \
171   t(t &&); \
172   t &operator=(const t &); \
173   t &operator=(t &&);
174 #define DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
175   t(const t &) = default; \
176   t(t &&) = default; \
177   t &operator=(const t &) = default; \
178   t &operator=(t &&) = default;
179 #define DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
180   t::t(const t &) = default; \
181   t::t(t &&) = default; \
182   t &t::operator=(const t &) = default; \
183   t &t::operator=(t &&) = default;
184 #define CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
185   constexpr t(const t &) = default; \
186   constexpr t(t &&) = default; \
187   constexpr t &operator=(const t &) = default; \
188   constexpr t &operator=(t &&) = default;
189 
190 #define CLASS_BOILERPLATE(t) \
191   t() = delete; \
192   DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(t)
193 
194 #define UNION_CONSTRUCTORS(t) \
195   template <typename _A> explicit t(const _A &x) : u{x} {} \
196   template <typename _A, typename = common::NoLvalue<_A>> \
197   explicit t(_A &&x) : u(std::move(x)) {}
198 
199 #define EVALUATE_UNION_CLASS_BOILERPLATE(t) \
200   CLASS_BOILERPLATE(t) \
201   UNION_CONSTRUCTORS(t) \
202   bool operator==(const t &) const;
203 
204 // Forward definition of Expr<> so that it can be indirectly used in its own
205 // definition
206 template <typename A> class Expr;
207 
208 class FoldingContext {
209 public:
210   FoldingContext(
211       const common::IntrinsicTypeDefaultKinds &d, const IntrinsicProcTable &t)
212       : defaults_{d}, intrinsics_{t} {}
213   FoldingContext(const parser::ContextualMessages &m,
214       const common::IntrinsicTypeDefaultKinds &d, const IntrinsicProcTable &t,
215       Rounding round = defaultRounding, bool flush = false)
216       : messages_{m}, defaults_{d}, intrinsics_{t}, rounding_{round},
217         flushSubnormalsToZero_{flush} {}
218   FoldingContext(const FoldingContext &that)
219       : messages_{that.messages_}, defaults_{that.defaults_},
220         intrinsics_{that.intrinsics_}, rounding_{that.rounding_},
221         flushSubnormalsToZero_{that.flushSubnormalsToZero_},
222         pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {}
223   FoldingContext(
224       const FoldingContext &that, const parser::ContextualMessages &m)
225       : messages_{m}, defaults_{that.defaults_},
226         intrinsics_{that.intrinsics_}, rounding_{that.rounding_},
227         flushSubnormalsToZero_{that.flushSubnormalsToZero_},
228         pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {}
229 
230   parser::ContextualMessages &messages() { return messages_; }
231   const parser::ContextualMessages &messages() const { return messages_; }
232   const common::IntrinsicTypeDefaultKinds &defaults() const {
233     return defaults_;
234   }
235   Rounding rounding() const { return rounding_; }
236   bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; }
237   bool bigEndian() const { return bigEndian_; }
238   const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; }
239   const IntrinsicProcTable &intrinsics() const { return intrinsics_; }
240 
241   ConstantSubscript &StartImpliedDo(parser::CharBlock, ConstantSubscript = 1);
242   std::optional<ConstantSubscript> GetImpliedDo(parser::CharBlock) const;
243   void EndImpliedDo(parser::CharBlock);
244 
245   std::map<parser::CharBlock, ConstantSubscript> &impliedDos() {
246     return impliedDos_;
247   }
248 
249   common::Restorer<const semantics::DerivedTypeSpec *> WithPDTInstance(
250       const semantics::DerivedTypeSpec &spec) {
251     return common::ScopedSet(pdtInstance_, &spec);
252   }
253 
254 private:
255   parser::ContextualMessages messages_;
256   const common::IntrinsicTypeDefaultKinds &defaults_;
257   const IntrinsicProcTable &intrinsics_;
258   Rounding rounding_{defaultRounding};
259   bool flushSubnormalsToZero_{false};
260   bool bigEndian_{false};
261   const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
262   std::map<parser::CharBlock, ConstantSubscript> impliedDos_;
263 };
264 
265 void RealFlagWarnings(FoldingContext &, const RealFlags &, const char *op);
266 } // namespace Fortran::evaluate
267 #endif // FORTRAN_EVALUATE_COMMON_H_
268