summaryrefslogtreecommitdiffstats
path: root/libgfortran
diff options
context:
space:
mode:
authorFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>2022-01-17 12:46:48 +0100
committerFrancois-Xavier Coudert <fxcoudert@gmail.com>2022-01-24 23:16:16 +0100
commite89d0befe3ec3238fca6de2cb078eb403b8c7e99 (patch)
tree41fae2bcc0c07ac87ddfa6c3c32dc3a9b283fb47 /libgfortran
parentrtl: builtins: (not just) rs6000: Add builtins for fegetround, feclearexcept ... (diff)
downloadgcc-e89d0befe3ec3238fca6de2cb078eb403b8c7e99.tar.gz
gcc-e89d0befe3ec3238fca6de2cb078eb403b8c7e99.tar.bz2
gcc-e89d0befe3ec3238fca6de2cb078eb403b8c7e99.tar.xz
Fortran: provide a fallback implementation of issignaling
For targets with IEEE support but without the issignaling macro in libc (currently, everywhere except glibc), this allows us to provide a fallback implementation. In order to keep the code in ieee_helper.c relatively readable, I've put that new implementation in a separate file, issignaling_fallback.h. libgfortran/ChangeLog: * ieee/issignaling_fallback.h: New file. * ieee/ieee_helper.c: Include issignaling_fallback.h when target does not define issignaling macro. gcc/testsuite/ChangeLog: * gfortran.dg/ieee/signaling_1.f90: Do not require issignaling. * gfortran.dg/ieee/signaling_2.f90: Add comment. * gfortran.dg/ieee/signaling_3.f90: New test.
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ieee/ieee_helper.c7
-rw-r--r--libgfortran/ieee/issignaling_fallback.h238
2 files changed, 241 insertions, 4 deletions
diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c
index 794ccec40ee..7e310f2c5b0 100644
--- a/libgfortran/ieee/ieee_helper.c
+++ b/libgfortran/ieee/ieee_helper.c
@@ -26,11 +26,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
26#include "libgfortran.h" 26#include "libgfortran.h"
27 27
28 28
29/* Check support for issignaling macro. 29/* Check support for issignaling macro. If not, we include our own
30 TODO: In the future, provide fallback implementations for IEEE types, 30 fallback implementation. */
31 because many libc's do not have issignaling yet. */
32#ifndef issignaling 31#ifndef issignaling
33# define issignaling(X) 0 32# include "issignaling_fallback.h"
34#endif 33#endif
35 34
36 35
diff --git a/libgfortran/ieee/issignaling_fallback.h b/libgfortran/ieee/issignaling_fallback.h
new file mode 100644
index 00000000000..e824cf8c59b
--- /dev/null
+++ b/libgfortran/ieee/issignaling_fallback.h
@@ -0,0 +1,238 @@
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
5This file is part of the GNU Fortran runtime library (libgfortran).
6
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
9License as published by the Free Software Foundation; either
10version 3 of the License, or (at your option) any later version.
11
12Libgfortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17Under Section 7 of GPL version 3, you are granted additional
18permissions described in the GCC Runtime Library Exception, version
193.1, as published by the Free Software Foundation.
20
21You should have received a copy of the GNU General Public License and
22a copy of the GCC Runtime Library Exception along with this program;
23see 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
40typedef union
41{
42 float value;
43 uint32_t word;
44} ieee_float_shape_type;
45
46static inline int
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
64typedef union
65{
66 double value;
67 uint64_t word;
68} ieee_double_shape_type;
69
70static inline int
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. */
91static inline int
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
101typedef union
102{
103 long double value;
104 struct
105 {
106#if __FLOAT_WORD_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 == __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
120static inline int
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__ = 33) && __LDBL_IS_IEC_60559__
141
142/* Long double is 128-bit type. */
143
144typedef union
145{
146 long double value;
147 struct
148 {
149#if __FLOAT_WORD_ORDER == __BIG_ENDIAN
150 uint64_t msw;
151 uint64_t lsw;
152#elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN
153 uint64_t lsw;
154 uint64_t msw;
155#endif
156 } parts64;
157} ieee854_long_double_shape_type;
158
159static inline int
160__issignalingl (long double x)
161{
162 uint64_t hxi, lxi;
163 ieee854_long_double_shape_type u;
164
165 u.value = x;
166 hxi = u.parts64.msw;
167 lxi = u.parts64.lsw;
168
169 hxi ^= UINT64_C (0x0000800000000000);
170 hxi |= (lxi | -lxi) >> 63;
171 return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
172}
173
174#else
175
176static inline int
177__issignalingl (long double x)
178{
179 return 0;
180}
181
182#endif
183
184
185#if __FLT128_IS_IEC_60559__
186
187/* We have a _Float128 type. */
188
189typedef union
190{
191 __float128 value;
192 struct
193 {
194#if __FLOAT_WORD_ORDER == __BIG_ENDIAN
195 uint64_t msw;
196 uint64_t lsw;
197#elif __FLOAT_WORD_ORDER == __LITTLE_ENDIAN
198 uint64_t lsw;
199 uint64_t msw;
200#endif
201 } parts64;
202} ieee854_float128_shape_type;
203
204static inline int
205__issignalingf128 (__float128 x)
206{
207 uint64_t hxi, lxi;
208 ieee854_float128_shape_type u;
209
210 u.value = x;
211 hxi = u.parts64.msw;
212 lxi = u.parts64.lsw;
213
214 hxi ^= UINT64_C (0x0000800000000000);
215 hxi |= (lxi | -lxi) >> 63;
216 return (hxi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7fff800000000000);
217}
218
219#endif
220
221
222/* Define the type-generic macro based on the functions above. */
223
224#if __FLT128_IS_IEC_60559__
225# define issignaling(X) \
226 _Generic ((X), \
227 __float128: __issignalingf128, \
228 float: __issignalingf, \
229 double: __issignaling, \
230 long double: __issignalingl)(X)
231#else
232# define issignaling(X) \
233 _Generic ((X), \
234 float: __issignalingf, \
235 double: __issignaling, \
236 long double: __issignalingl)(X)
237#endif
238