1 //===-- lib/Evaluate/host.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_HOST_H_
10 #define FORTRAN_EVALUATE_HOST_H_
11
12 // Define a compile-time mapping between Fortran intrinsic types and host
13 // hardware types if possible. The purpose is to avoid having to do any kind of
14 // assumption on whether a "float" matches the Scalar<Type<TypeCategory::Real,
15 // 4>> outside of this header. The main tools are HostTypeExists<T> and
16 // HostType<T>. HostTypeExists<T>() will return true if and only if a host
17 // hardware type maps to Fortran intrinsic type T. Then HostType<T> can be used
18 // to safely refer to this hardware type.
19
20 #if HAS_QUADMATHLIB
21 #include "quadmath.h"
22 #include "flang/Common/float128.h"
23 #endif
24 #include "flang/Evaluate/type.h"
25 #include <cfenv>
26 #include <complex>
27 #include <cstdint>
28 #include <limits>
29 #include <string>
30 #include <type_traits>
31
32 namespace Fortran::evaluate {
33 namespace host {
34
35 // Helper class to handle host runtime traps, status flag and errno
36 class HostFloatingPointEnvironment {
37 public:
38 void SetUpHostFloatingPointEnvironment(FoldingContext &);
39 void CheckAndRestoreFloatingPointEnvironment(FoldingContext &);
hasSubnormalFlushingHardwareControl()40 bool hasSubnormalFlushingHardwareControl() const {
41 return hasSubnormalFlushingHardwareControl_;
42 }
SetFlag(RealFlag flag)43 void SetFlag(RealFlag flag) { flags_.set(flag); }
hardwareFlagsAreReliable()44 bool hardwareFlagsAreReliable() const { return hardwareFlagsAreReliable_; }
45
46 private:
47 std::fenv_t originalFenv_;
48 #if __x86_64__
49 unsigned int originalMxcsr;
50 #endif
51 RealFlags flags_;
52 bool hasSubnormalFlushingHardwareControl_{false};
53 bool hardwareFlagsAreReliable_{true};
54 };
55
56 // Type mapping from F18 types to host types
57 struct UnsupportedType {}; // There is no host type for the F18 type
58
59 template <typename FTN_T> struct HostTypeHelper {
60 using Type = UnsupportedType;
61 };
62 template <typename FTN_T> using HostType = typename HostTypeHelper<FTN_T>::Type;
63
HostTypeExists()64 template <typename... T> constexpr inline bool HostTypeExists() {
65 return (... && (!std::is_same_v<HostType<T>, UnsupportedType>));
66 }
67
68 // Type mapping from host types to F18 types FortranType<HOST_T> is defined
69 // after all HosTypeHelper definition because it reverses them to avoid
70 // duplication.
71
72 // Scalar conversion utilities from host scalars to F18 scalars
73 template <typename FTN_T>
CastHostToFortran(const HostType<FTN_T> & x)74 inline constexpr Scalar<FTN_T> CastHostToFortran(const HostType<FTN_T> &x) {
75 static_assert(HostTypeExists<FTN_T>());
76 if constexpr (FTN_T::category == TypeCategory::Complex &&
77 sizeof(Scalar<FTN_T>) != sizeof(HostType<FTN_T>)) {
78 // X87 is usually padded to 12 or 16bytes. Need to cast piecewise for
79 // complex
80 return Scalar<FTN_T>{CastHostToFortran<typename FTN_T::Part>(std::real(x)),
81 CastHostToFortran<typename FTN_T::Part>(std::imag(x))};
82 } else {
83 return *reinterpret_cast<const Scalar<FTN_T> *>(&x);
84 }
85 }
86
87 // Scalar conversion utilities from F18 scalars to host scalars.
88 template <typename FTN_T>
CastFortranToHost(const Scalar<FTN_T> & x)89 inline constexpr HostType<FTN_T> CastFortranToHost(const Scalar<FTN_T> &x) {
90 static_assert(HostTypeExists<FTN_T>());
91 if constexpr (FTN_T::category == TypeCategory::Complex) {
92 using FortranPartType = typename FTN_T::Part;
93 return HostType<FTN_T>{CastFortranToHost<FortranPartType>(x.REAL()),
94 CastFortranToHost<FortranPartType>(x.AIMAG())};
95 } else if constexpr (std::is_same_v<FTN_T, Type<TypeCategory::Real, 10>>) {
96 // x87 80-bit floating-point occupies 16 bytes as a C "long double";
97 // copy the data to avoid a legitimate (but benign due to little-endianness)
98 // warning from GCC >= 11.2.0.
99 HostType<FTN_T> y;
100 std::memcpy(&y, &x, sizeof x);
101 return y;
102 } else {
103 static_assert(sizeof x == sizeof(HostType<FTN_T>));
104 return *reinterpret_cast<const HostType<FTN_T> *>(&x);
105 }
106 }
107
108 template <> struct HostTypeHelper<Type<TypeCategory::Integer, 1>> {
109 using Type = std::int8_t;
110 };
111
112 template <> struct HostTypeHelper<Type<TypeCategory::Integer, 2>> {
113 using Type = std::int16_t;
114 };
115
116 template <> struct HostTypeHelper<Type<TypeCategory::Integer, 4>> {
117 using Type = std::int32_t;
118 };
119
120 template <> struct HostTypeHelper<Type<TypeCategory::Integer, 8>> {
121 using Type = std::int64_t;
122 };
123
124 template <> struct HostTypeHelper<Type<TypeCategory::Integer, 16>> {
125 #if (defined(__GNUC__) || defined(__clang__)) && defined(__SIZEOF_INT128__)
126 using Type = __int128_t;
127 #else
128 using Type = UnsupportedType;
129 #endif
130 };
131
132 // TODO no mapping to host types are defined currently for 16bits float
133 // It should be defined when gcc/clang have a better support for it.
134
135 template <>
136 struct HostTypeHelper<
137 Type<TypeCategory::Real, common::RealKindForPrecision(24)>> {
138 // IEEE 754 32bits
139 using Type = std::conditional_t<sizeof(float) == 4 &&
140 std::numeric_limits<float>::is_iec559,
141 float, UnsupportedType>;
142 };
143
144 template <>
145 struct HostTypeHelper<
146 Type<TypeCategory::Real, common::RealKindForPrecision(53)>> {
147 // IEEE 754 64bits
148 using Type = std::conditional_t<sizeof(double) == 8 &&
149 std::numeric_limits<double>::is_iec559,
150 double, UnsupportedType>;
151 };
152
153 template <>
154 struct HostTypeHelper<
155 Type<TypeCategory::Real, common::RealKindForPrecision(64)>> {
156 // X87 80bits
157 using Type = std::conditional_t<sizeof(long double) >= 10 &&
158 std::numeric_limits<long double>::digits == 64 &&
159 std::numeric_limits<long double>::max_exponent == 16384,
160 long double, UnsupportedType>;
161 };
162
163 #if HAS_QUADMATHLIB
164 template <> struct HostTypeHelper<Type<TypeCategory::Real, 16>> {
165 // IEEE 754 128bits
166 using Type = __float128;
167 };
168 #else
169 template <> struct HostTypeHelper<Type<TypeCategory::Real, 16>> {
170 // IEEE 754 128bits
171 using Type = std::conditional_t<sizeof(long double) == 16 &&
172 std::numeric_limits<long double>::digits == 113 &&
173 std::numeric_limits<long double>::max_exponent == 16384,
174 long double, UnsupportedType>;
175 };
176 #endif
177
178 template <int KIND> struct HostTypeHelper<Type<TypeCategory::Complex, KIND>> {
179 using RealT = Fortran::evaluate::Type<TypeCategory::Real, KIND>;
180 using Type = std::conditional_t<HostTypeExists<RealT>(),
181 std::complex<HostType<RealT>>, UnsupportedType>;
182 };
183
184 #if HAS_QUADMATHLIB
185 template <> struct HostTypeHelper<Type<TypeCategory::Complex, 16>> {
186 using RealT = Fortran::evaluate::Type<TypeCategory::Real, 16>;
187 using Type = __complex128;
188 };
189 #endif
190
191 template <int KIND> struct HostTypeHelper<Type<TypeCategory::Logical, KIND>> {
192 using Type = std::conditional_t<KIND <= 8, std::uint8_t, UnsupportedType>;
193 };
194
195 template <int KIND> struct HostTypeHelper<Type<TypeCategory::Character, KIND>> {
196 using Type =
197 Scalar<typename Fortran::evaluate::Type<TypeCategory::Character, KIND>>;
198 };
199
200 // Type mapping from host types to F18 types. This need to be placed after all
201 // HostTypeHelper specializations.
202 template <typename T, typename... TT> struct IndexInTupleHelper {};
203 template <typename T, typename... TT>
204 struct IndexInTupleHelper<T, std::tuple<TT...>> {
205 static constexpr int value{common::TypeIndex<T, TT...>};
206 };
207 struct UnknownType {}; // the host type does not match any F18 types
208 template <typename HOST_T> struct FortranTypeHelper {
209 using HostTypeMapping =
210 common::MapTemplate<HostType, AllIntrinsicTypes, std::tuple>;
211 static constexpr int index{
212 IndexInTupleHelper<HOST_T, HostTypeMapping>::value};
213 // Both conditional types are "instantiated", so a valid type must be
214 // created for invalid index even if not used.
215 using Type = std::conditional_t<index >= 0,
216 std::tuple_element_t<(index >= 0) ? index : 0, AllIntrinsicTypes>,
217 UnknownType>;
218 };
219
220 template <typename HOST_T>
221 using FortranType = typename FortranTypeHelper<HOST_T>::Type;
222
223 template <typename... HT> constexpr inline bool FortranTypeExists() {
224 return (... && (!std::is_same_v<FortranType<HT>, UnknownType>));
225 }
226
227 } // namespace host
228 } // namespace Fortran::evaluate
229
230 #endif // FORTRAN_EVALUATE_HOST_H_
231