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