1 /* Fallback implementation of issignaling macro.
2 Copyright (C) 2022 Free Software Foundation, Inc.
3 Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
4
5 This file is part of the GNU Fortran runtime library (libgfortran).
6
7 Libgfortran is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public
9 License as published by the Free Software Foundation; either
10 version 3 of the License, or (at your option) any later version.
11
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
20
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
25
26 #include "libgfortran.h"
27
28 /* This header provides an implementation of the type-generic issignaling macro.
29 Some points of note:
30
31 - This header is only included if the issignaling macro is not defined.
32 - All targets for which Fortran IEEE modules are supported currently have
33 the high-order bit of the NaN mantissa clear for signaling (and set
34 for quiet), as recommended by IEEE.
35 - We use the __*_IS_IEC_60559__ macros to make sure we only deal with formats
36 we know. For other floating-point formats, we consider all NaNs as quiet.
37
38 */
39
40 typedef union
41 {
42 float value;
43 uint32_t word;
44 } ieee_float_shape_type;
45
46 static inline int
__issignalingf(float x)47 __issignalingf (float x)
48 {
49 #if __FLT_IS_IEC_60559__
50 uint32_t xi;
51 ieee_float_shape_type u;
52
53 u.value = x;
54 xi = u.word;
55
56 xi ^= 0x00400000;
57 return (xi & 0x7fffffff) > 0x7fc00000;
58 #else
59 return 0;
60 #endif
61 }
62
63
64 typedef union
65 {
66 double value;
67 uint64_t word;
68 } ieee_double_shape_type;
69
70 static inline int
__issignaling(double x)71 __issignaling (double x)
72 {
73 #if __DBL_IS_IEC_60559__
74 ieee_double_shape_type u;
75 uint64_t xi;
76
77 u.value = x;
78 xi = u.word;
79
80 xi ^= UINT64_C (0x0008000000000000);
81 return (xi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7ff8000000000000);
82 #else
83 return 0;
84 #endif
85 }
86
87
88 #if __LDBL_DIG__ == __DBL_DIG__
89
90 /* Long double is the same as double. */
91 static inline int
__issignalingl(long double x)92 __issignalingl (long double x)
93 {
94 return __issignaling (x);
95 }
96
97 #elif (__LDBL_DIG__ == 18) && __LDBL_IS_IEC_60559__
98
99 /* Long double is x86 extended type. */
100
101 typedef union
102 {
103 long double value;
104 struct
105 {
106 #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__
107 int sign_exponent:16;
108 unsigned int empty:16;
109 uint32_t msw;
110 uint32_t lsw;
111 #elif __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__
112 uint32_t lsw;
113 uint32_t msw;
114 int sign_exponent:16;
115 unsigned int empty:16;
116 #endif
117 } parts;
118 } ieee_long_double_shape_type;
119
120 static inline int
__issignalingl(long double x)121 __issignalingl (long double x)
122 {
123 int ret;
124 uint32_t exi, hxi, lxi;
125 ieee_long_double_shape_type u;
126
127 u.value = x;
128 exi = u.parts.sign_exponent;
129 hxi = u.parts.msw;
130 lxi = u.parts.lsw;
131
132 /* Pseudo numbers on x86 are always signaling. */
133 ret = (exi & 0x7fff) && ((hxi & 0x80000000) == 0);
134
135 hxi ^= 0x40000000;
136 hxi |= (lxi | -lxi) >> 31;
137 return ret || (((exi & 0x7fff) == 0x7fff) && (hxi > 0xc0000000));
138 }
139
140 #elif (__LDBL_DIG__ == 31)
141
142 /* Long double is 128-bit IBM extended type. */
143
144 static inline int
__issignalingl(long double x)145 __issignalingl (long double x)
146 {
147 union { long double value; double parts[2]; } u;
148
149 u.value = x;
150 return __issignaling (u.parts[0]);
151 }
152
153 #elif (__LDBL_DIG__ == 33) && __LDBL_IS_IEC_60559__
154
155 /* Long double is 128-bit type. */
156
157 typedef union
158 {
159 long double value;
160 struct
161 {
162 #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__
163 uint64_t msw;
164 uint64_t lsw;
165 #elif __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__
166 uint64_t lsw;
167 uint64_t msw;
168 #endif
169 } parts64;
170 } ieee854_long_double_shape_type;
171
172 static inline int
__issignalingl(long double x)173 __issignalingl (long double x)
174 {
175 uint64_t hxi, lxi;
176 ieee854_long_double_shape_type u;
177
178 u.value = x;
179 hxi = u.parts64.msw;
180 lxi = u.parts64.lsw;
181
182 hxi ^= UINT64_C (0x0000800000000000);
183 hxi |= (lxi | -lxi) >> 63;
184 return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
185 }
186
187 #else
188
189 static inline int
__issignalingl(long double x)190 __issignalingl (long double x)
191 {
192 return 0;
193 }
194
195 #endif
196
197
198 #if defined(GFC_REAL_16_IS_FLOAT128)
199
200 /* We have a __float128 type. */
201
202 typedef union
203 {
204 __float128 value;
205 struct
206 {
207 #if __FLOAT_WORD_ORDER__ == __ORDER_BIG_ENDIAN__
208 uint64_t msw;
209 uint64_t lsw;
210 #elif __FLOAT_WORD_ORDER__ == __ORDER_LITTLE_ENDIAN__
211 uint64_t lsw;
212 uint64_t msw;
213 #endif
214 } parts64;
215 } ieee854_float128_shape_type;
216
217 static inline int
__issignalingf128(__float128 x)218 __issignalingf128 (__float128 x)
219 {
220 uint64_t hxi, lxi;
221 ieee854_float128_shape_type u;
222
223 u.value = x;
224 hxi = u.parts64.msw;
225 lxi = u.parts64.lsw;
226
227 hxi ^= UINT64_C (0x0000800000000000);
228 hxi |= (lxi | -lxi) >> 63;
229 return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
230 }
231
232 #endif
233
234
235 /* Define the type-generic macro based on the functions above. */
236
237 #if defined(GFC_REAL_16_IS_FLOAT128)
238 # define issignaling(X) \
239 _Generic ((X), \
240 __float128: __issignalingf128, \
241 float: __issignalingf, \
242 double: __issignaling, \
243 long double: __issignalingl)(X)
244 #else
245 # define issignaling(X) \
246 _Generic ((X), \
247 float: __issignalingf, \
248 double: __issignaling, \
249 long double: __issignalingl)(X)
250 #endif
251
252