1 /* FPU-related code for systems with GNU libc.
2 Copyright (C) 2005-2022 Free Software Foundation, Inc.
3 Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
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 /* FPU-related code for systems with the GNU libc, providing the
27 feenableexcept function in fenv.h to set individual exceptions
28 (there's nothing to do that in C99). */
29
30 #ifdef HAVE_FENV_H
31 #include <fenv.h>
32 #endif
33
34
35 /* Check we can actually store the FPU state in the allocated size. */
36 _Static_assert (sizeof(fenv_t) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE,
37 "GFC_FPE_STATE_BUFFER_SIZE is too small");
38
39
set_fpu_trap_exceptions(int trap,int notrap)40 void set_fpu_trap_exceptions (int trap, int notrap)
41 {
42 int mode_set = 0, mode_clr = 0;
43
44 #ifdef FE_INVALID
45 if (trap & GFC_FPE_INVALID)
46 mode_set |= FE_INVALID;
47 if (notrap & GFC_FPE_INVALID)
48 mode_clr |= FE_INVALID;
49 #endif
50
51 /* Some glibc targets (like alpha) have FE_DENORMAL, but not many. */
52 #ifdef FE_DENORMAL
53 if (trap & GFC_FPE_DENORMAL)
54 mode_set |= FE_DENORMAL;
55 if (notrap & GFC_FPE_DENORMAL)
56 mode_clr |= FE_DENORMAL;
57 #endif
58
59 #ifdef FE_DIVBYZERO
60 if (trap & GFC_FPE_ZERO)
61 mode_set |= FE_DIVBYZERO;
62 if (notrap & GFC_FPE_ZERO)
63 mode_clr |= FE_DIVBYZERO;
64 #endif
65
66 #ifdef FE_OVERFLOW
67 if (trap & GFC_FPE_OVERFLOW)
68 mode_set |= FE_OVERFLOW;
69 if (notrap & GFC_FPE_OVERFLOW)
70 mode_clr |= FE_OVERFLOW;
71 #endif
72
73 #ifdef FE_UNDERFLOW
74 if (trap & GFC_FPE_UNDERFLOW)
75 mode_set |= FE_UNDERFLOW;
76 if (notrap & GFC_FPE_UNDERFLOW)
77 mode_clr |= FE_UNDERFLOW;
78 #endif
79
80 #ifdef FE_INEXACT
81 if (trap & GFC_FPE_INEXACT)
82 mode_set |= FE_INEXACT;
83 if (notrap & GFC_FPE_INEXACT)
84 mode_clr |= FE_INEXACT;
85 #endif
86
87 /* Clear stalled exception flags. */
88 feclearexcept (FE_ALL_EXCEPT);
89
90 feenableexcept (mode_set);
91 fedisableexcept (mode_clr);
92 }
93
94
95 int
get_fpu_trap_exceptions(void)96 get_fpu_trap_exceptions (void)
97 {
98 int exceptions = fegetexcept ();
99 int res = 0;
100
101 #ifdef FE_INVALID
102 if (exceptions & FE_INVALID) res |= GFC_FPE_INVALID;
103 #endif
104
105 #ifdef FE_DENORMAL
106 if (exceptions & FE_DENORMAL) res |= GFC_FPE_DENORMAL;
107 #endif
108
109 #ifdef FE_DIVBYZERO
110 if (exceptions & FE_DIVBYZERO) res |= GFC_FPE_ZERO;
111 #endif
112
113 #ifdef FE_OVERFLOW
114 if (exceptions & FE_OVERFLOW) res |= GFC_FPE_OVERFLOW;
115 #endif
116
117 #ifdef FE_UNDERFLOW
118 if (exceptions & FE_UNDERFLOW) res |= GFC_FPE_UNDERFLOW;
119 #endif
120
121 #ifdef FE_INEXACT
122 if (exceptions & FE_INEXACT) res |= GFC_FPE_INEXACT;
123 #endif
124
125 return res;
126 }
127
128
129 int
support_fpu_trap(int flag)130 support_fpu_trap (int flag)
131 {
132 return support_fpu_flag (flag);
133 }
134
135
set_fpu(void)136 void set_fpu (void)
137 {
138 #ifndef FE_INVALID
139 if (options.fpe & GFC_FPE_INVALID)
140 estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
141 "exception not supported.\n");
142 #endif
143
144 #ifndef FE_DENORMAL
145 if (options.fpe & GFC_FPE_DENORMAL)
146 estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
147 "exception not supported.\n");
148 #endif
149
150 #ifndef FE_DIVBYZERO
151 if (options.fpe & GFC_FPE_ZERO)
152 estr_write ("Fortran runtime warning: IEEE 'division by zero' "
153 "exception not supported.\n");
154 #endif
155
156 #ifndef FE_OVERFLOW
157 if (options.fpe & GFC_FPE_OVERFLOW)
158 estr_write ("Fortran runtime warning: IEEE 'overflow' "
159 "exception not supported.\n");
160 #endif
161
162 #ifndef FE_UNDERFLOW
163 if (options.fpe & GFC_FPE_UNDERFLOW)
164 estr_write ("Fortran runtime warning: IEEE 'underflow' "
165 "exception not supported.\n");
166 #endif
167
168 #ifndef FE_INEXACT
169 if (options.fpe & GFC_FPE_INEXACT)
170 estr_write ("Fortran runtime warning: IEEE 'inexact' "
171 "exception not supported.\n");
172 #endif
173
174 set_fpu_trap_exceptions (options.fpe, 0);
175 }
176
177
178 int
get_fpu_except_flags(void)179 get_fpu_except_flags (void)
180 {
181 int result, set_excepts;
182
183 result = 0;
184 set_excepts = fetestexcept (FE_ALL_EXCEPT);
185
186 #ifdef FE_INVALID
187 if (set_excepts & FE_INVALID)
188 result |= GFC_FPE_INVALID;
189 #endif
190
191 #ifdef FE_DIVBYZERO
192 if (set_excepts & FE_DIVBYZERO)
193 result |= GFC_FPE_ZERO;
194 #endif
195
196 #ifdef FE_OVERFLOW
197 if (set_excepts & FE_OVERFLOW)
198 result |= GFC_FPE_OVERFLOW;
199 #endif
200
201 #ifdef FE_UNDERFLOW
202 if (set_excepts & FE_UNDERFLOW)
203 result |= GFC_FPE_UNDERFLOW;
204 #endif
205
206 #ifdef FE_DENORMAL
207 if (set_excepts & FE_DENORMAL)
208 result |= GFC_FPE_DENORMAL;
209 #endif
210
211 #ifdef FE_INEXACT
212 if (set_excepts & FE_INEXACT)
213 result |= GFC_FPE_INEXACT;
214 #endif
215
216 return result;
217 }
218
219
220 void
set_fpu_except_flags(int set,int clear)221 set_fpu_except_flags (int set, int clear)
222 {
223 int exc_set = 0, exc_clr = 0;
224
225 #ifdef FE_INVALID
226 if (set & GFC_FPE_INVALID)
227 exc_set |= FE_INVALID;
228 else if (clear & GFC_FPE_INVALID)
229 exc_clr |= FE_INVALID;
230 #endif
231
232 #ifdef FE_DIVBYZERO
233 if (set & GFC_FPE_ZERO)
234 exc_set |= FE_DIVBYZERO;
235 else if (clear & GFC_FPE_ZERO)
236 exc_clr |= FE_DIVBYZERO;
237 #endif
238
239 #ifdef FE_OVERFLOW
240 if (set & GFC_FPE_OVERFLOW)
241 exc_set |= FE_OVERFLOW;
242 else if (clear & GFC_FPE_OVERFLOW)
243 exc_clr |= FE_OVERFLOW;
244 #endif
245
246 #ifdef FE_UNDERFLOW
247 if (set & GFC_FPE_UNDERFLOW)
248 exc_set |= FE_UNDERFLOW;
249 else if (clear & GFC_FPE_UNDERFLOW)
250 exc_clr |= FE_UNDERFLOW;
251 #endif
252
253 #ifdef FE_DENORMAL
254 if (set & GFC_FPE_DENORMAL)
255 exc_set |= FE_DENORMAL;
256 else if (clear & GFC_FPE_DENORMAL)
257 exc_clr |= FE_DENORMAL;
258 #endif
259
260 #ifdef FE_INEXACT
261 if (set & GFC_FPE_INEXACT)
262 exc_set |= FE_INEXACT;
263 else if (clear & GFC_FPE_INEXACT)
264 exc_clr |= FE_INEXACT;
265 #endif
266
267 feclearexcept (exc_clr);
268 feraiseexcept (exc_set);
269 }
270
271
272 int
support_fpu_flag(int flag)273 support_fpu_flag (int flag)
274 {
275 if (flag & GFC_FPE_INVALID)
276 {
277 #ifndef FE_INVALID
278 return 0;
279 #endif
280 }
281 else if (flag & GFC_FPE_ZERO)
282 {
283 #ifndef FE_DIVBYZERO
284 return 0;
285 #endif
286 }
287 else if (flag & GFC_FPE_OVERFLOW)
288 {
289 #ifndef FE_OVERFLOW
290 return 0;
291 #endif
292 }
293 else if (flag & GFC_FPE_UNDERFLOW)
294 {
295 #ifndef FE_UNDERFLOW
296 return 0;
297 #endif
298 }
299 else if (flag & GFC_FPE_DENORMAL)
300 {
301 #ifndef FE_DENORMAL
302 return 0;
303 #endif
304 }
305 else if (flag & GFC_FPE_INEXACT)
306 {
307 #ifndef FE_INEXACT
308 return 0;
309 #endif
310 }
311
312 return 1;
313 }
314
315
316 int
get_fpu_rounding_mode(void)317 get_fpu_rounding_mode (void)
318 {
319 int rnd_mode;
320
321 rnd_mode = fegetround ();
322
323 switch (rnd_mode)
324 {
325 #ifdef FE_TONEAREST
326 case FE_TONEAREST:
327 return GFC_FPE_TONEAREST;
328 #endif
329
330 #ifdef FE_UPWARD
331 case FE_UPWARD:
332 return GFC_FPE_UPWARD;
333 #endif
334
335 #ifdef FE_DOWNWARD
336 case FE_DOWNWARD:
337 return GFC_FPE_DOWNWARD;
338 #endif
339
340 #ifdef FE_TOWARDZERO
341 case FE_TOWARDZERO:
342 return GFC_FPE_TOWARDZERO;
343 #endif
344
345 default:
346 return 0; /* Should be unreachable. */
347 }
348 }
349
350
351 void
set_fpu_rounding_mode(int mode)352 set_fpu_rounding_mode (int mode)
353 {
354 int rnd_mode;
355
356 switch (mode)
357 {
358 #ifdef FE_TONEAREST
359 case GFC_FPE_TONEAREST:
360 rnd_mode = FE_TONEAREST;
361 break;
362 #endif
363
364 #ifdef FE_UPWARD
365 case GFC_FPE_UPWARD:
366 rnd_mode = FE_UPWARD;
367 break;
368 #endif
369
370 #ifdef FE_DOWNWARD
371 case GFC_FPE_DOWNWARD:
372 rnd_mode = FE_DOWNWARD;
373 break;
374 #endif
375
376 #ifdef FE_TOWARDZERO
377 case GFC_FPE_TOWARDZERO:
378 rnd_mode = FE_TOWARDZERO;
379 break;
380 #endif
381
382 default:
383 return; /* Should be unreachable. */
384 }
385
386 fesetround (rnd_mode);
387 }
388
389
390 int
support_fpu_rounding_mode(int mode)391 support_fpu_rounding_mode (int mode)
392 {
393 switch (mode)
394 {
395 case GFC_FPE_TONEAREST:
396 #ifdef FE_TONEAREST
397 return 1;
398 #else
399 return 0;
400 #endif
401
402 case GFC_FPE_UPWARD:
403 #ifdef FE_UPWARD
404 return 1;
405 #else
406 return 0;
407 #endif
408
409 case GFC_FPE_DOWNWARD:
410 #ifdef FE_DOWNWARD
411 return 1;
412 #else
413 return 0;
414 #endif
415
416 case GFC_FPE_TOWARDZERO:
417 #ifdef FE_TOWARDZERO
418 return 1;
419 #else
420 return 0;
421 #endif
422
423 default:
424 return 0; /* Should be unreachable. */
425 }
426 }
427
428
429 void
get_fpu_state(void * state)430 get_fpu_state (void *state)
431 {
432 fegetenv (state);
433 }
434
435
436 void
set_fpu_state(void * state)437 set_fpu_state (void *state)
438 {
439 fesetenv (state);
440 }
441
442
443 /* Underflow in glibc is currently only supported on alpha, through
444 the FE_MAP_UMZ macro and __ieee_set_fp_control() function call. */
445
446 int
support_fpu_underflow_control(int kind)447 support_fpu_underflow_control (int kind __attribute__((unused)))
448 {
449 #if defined(__alpha__) && defined(FE_MAP_UMZ)
450 return (kind == 4 || kind == 8) ? 1 : 0;
451 #else
452 return 0;
453 #endif
454 }
455
456
457 int
get_fpu_underflow_mode(void)458 get_fpu_underflow_mode (void)
459 {
460 #if defined(__alpha__) && defined(FE_MAP_UMZ)
461
462 fenv_t state = __ieee_get_fp_control ();
463
464 /* Return 0 for abrupt underflow (flush to zero), 1 for gradual underflow. */
465 return (state & FE_MAP_UMZ) ? 0 : 1;
466
467 #else
468
469 return 0;
470
471 #endif
472 }
473
474
475 void
set_fpu_underflow_mode(int gradual)476 set_fpu_underflow_mode (int gradual __attribute__((unused)))
477 {
478 #if defined(__alpha__) && defined(FE_MAP_UMZ)
479
480 fenv_t state = __ieee_get_fp_control ();
481
482 if (gradual)
483 state &= ~FE_MAP_UMZ;
484 else
485 state |= FE_MAP_UMZ;
486
487 __ieee_set_fp_control (state);
488
489 #endif
490 }
491
492