gcc/
[official-gcc.git] / libgfortran / config / fpu-glibc.h
blobc453f872473ebc3c1aced6c4e90ac8b552a54675
1 /* FPU-related code for systems with GNU libc.
2 Copyright (C) 2005-2015 Free Software Foundation, Inc.
3 Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
5 This file is part of the GNU Fortran runtime library (libgfortran).
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.
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.
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.
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/>. */
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). */
30 #ifdef HAVE_FENV_H
31 #include <fenv.h>
32 #endif
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");
40 void set_fpu_trap_exceptions (int trap, int notrap)
42 #ifdef FE_INVALID
43 if (trap & GFC_FPE_INVALID)
44 feenableexcept (FE_INVALID);
45 if (notrap & GFC_FPE_INVALID)
46 fedisableexcept (FE_INVALID);
47 #endif
49 /* Some glibc targets (like alpha) have FE_DENORMAL, but not many. */
50 #ifdef FE_DENORMAL
51 if (trap & GFC_FPE_DENORMAL)
52 feenableexcept (FE_DENORMAL);
53 if (notrap & GFC_FPE_DENORMAL)
54 fedisableexcept (FE_DENORMAL);
55 #endif
57 #ifdef FE_DIVBYZERO
58 if (trap & GFC_FPE_ZERO)
59 feenableexcept (FE_DIVBYZERO);
60 if (notrap & GFC_FPE_ZERO)
61 fedisableexcept (FE_DIVBYZERO);
62 #endif
64 #ifdef FE_OVERFLOW
65 if (trap & GFC_FPE_OVERFLOW)
66 feenableexcept (FE_OVERFLOW);
67 if (notrap & GFC_FPE_OVERFLOW)
68 fedisableexcept (FE_OVERFLOW);
69 #endif
71 #ifdef FE_UNDERFLOW
72 if (trap & GFC_FPE_UNDERFLOW)
73 feenableexcept (FE_UNDERFLOW);
74 if (notrap & GFC_FPE_UNDERFLOW)
75 fedisableexcept (FE_UNDERFLOW);
76 #endif
78 #ifdef FE_INEXACT
79 if (trap & GFC_FPE_INEXACT)
80 feenableexcept (FE_INEXACT);
81 if (notrap & GFC_FPE_INEXACT)
82 fedisableexcept (FE_INEXACT);
83 #endif
87 int
88 get_fpu_trap_exceptions (void)
90 int exceptions = fegetexcept ();
91 int res = 0;
93 #ifdef FE_INVALID
94 if (exceptions & FE_INVALID) res |= GFC_FPE_INVALID;
95 #endif
97 #ifdef FE_DENORMAL
98 if (exceptions & FE_DENORMAL) res |= GFC_FPE_DENORMAL;
99 #endif
101 #ifdef FE_DIVBYZERO
102 if (exceptions & FE_DIVBYZERO) res |= GFC_FPE_ZERO;
103 #endif
105 #ifdef FE_OVERFLOW
106 if (exceptions & FE_OVERFLOW) res |= GFC_FPE_OVERFLOW;
107 #endif
109 #ifdef FE_UNDERFLOW
110 if (exceptions & FE_UNDERFLOW) res |= GFC_FPE_UNDERFLOW;
111 #endif
113 #ifdef FE_INEXACT
114 if (exceptions & FE_INEXACT) res |= GFC_FPE_INEXACT;
115 #endif
117 return res;
122 support_fpu_trap (int flag)
124 return support_fpu_flag (flag);
128 void set_fpu (void)
130 #ifndef FE_INVALID
131 if (options.fpe & GFC_FPE_INVALID)
132 estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
133 "exception not supported.\n");
134 #endif
136 #ifndef FE_DENORMAL
137 if (options.fpe & GFC_FPE_DENORMAL)
138 estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
139 "exception not supported.\n");
140 #endif
142 #ifndef FE_DIVBYZERO
143 if (options.fpe & GFC_FPE_ZERO)
144 estr_write ("Fortran runtime warning: IEEE 'division by zero' "
145 "exception not supported.\n");
146 #endif
148 #ifndef FE_OVERFLOW
149 if (options.fpe & GFC_FPE_OVERFLOW)
150 estr_write ("Fortran runtime warning: IEEE 'overflow' "
151 "exception not supported.\n");
152 #endif
154 #ifndef FE_UNDERFLOW
155 if (options.fpe & GFC_FPE_UNDERFLOW)
156 estr_write ("Fortran runtime warning: IEEE 'underflow' "
157 "exception not supported.\n");
158 #endif
160 #ifndef FE_INEXACT
161 if (options.fpe & GFC_FPE_INEXACT)
162 estr_write ("Fortran runtime warning: IEEE 'inexact' "
163 "exception not supported.\n");
164 #endif
166 set_fpu_trap_exceptions (options.fpe, 0);
171 get_fpu_except_flags (void)
173 int result, set_excepts;
175 result = 0;
176 set_excepts = fetestexcept (FE_ALL_EXCEPT);
178 #ifdef FE_INVALID
179 if (set_excepts & FE_INVALID)
180 result |= GFC_FPE_INVALID;
181 #endif
183 #ifdef FE_DIVBYZERO
184 if (set_excepts & FE_DIVBYZERO)
185 result |= GFC_FPE_ZERO;
186 #endif
188 #ifdef FE_OVERFLOW
189 if (set_excepts & FE_OVERFLOW)
190 result |= GFC_FPE_OVERFLOW;
191 #endif
193 #ifdef FE_UNDERFLOW
194 if (set_excepts & FE_UNDERFLOW)
195 result |= GFC_FPE_UNDERFLOW;
196 #endif
198 #ifdef FE_DENORMAL
199 if (set_excepts & FE_DENORMAL)
200 result |= GFC_FPE_DENORMAL;
201 #endif
203 #ifdef FE_INEXACT
204 if (set_excepts & FE_INEXACT)
205 result |= GFC_FPE_INEXACT;
206 #endif
208 return result;
212 void
213 set_fpu_except_flags (int set, int clear)
215 int exc_set = 0, exc_clr = 0;
217 #ifdef FE_INVALID
218 if (set & GFC_FPE_INVALID)
219 exc_set |= FE_INVALID;
220 else if (clear & GFC_FPE_INVALID)
221 exc_clr |= FE_INVALID;
222 #endif
224 #ifdef FE_DIVBYZERO
225 if (set & GFC_FPE_ZERO)
226 exc_set |= FE_DIVBYZERO;
227 else if (clear & GFC_FPE_ZERO)
228 exc_clr |= FE_DIVBYZERO;
229 #endif
231 #ifdef FE_OVERFLOW
232 if (set & GFC_FPE_OVERFLOW)
233 exc_set |= FE_OVERFLOW;
234 else if (clear & GFC_FPE_OVERFLOW)
235 exc_clr |= FE_OVERFLOW;
236 #endif
238 #ifdef FE_UNDERFLOW
239 if (set & GFC_FPE_UNDERFLOW)
240 exc_set |= FE_UNDERFLOW;
241 else if (clear & GFC_FPE_UNDERFLOW)
242 exc_clr |= FE_UNDERFLOW;
243 #endif
245 #ifdef FE_DENORMAL
246 if (set & GFC_FPE_DENORMAL)
247 exc_set |= FE_DENORMAL;
248 else if (clear & GFC_FPE_DENORMAL)
249 exc_clr |= FE_DENORMAL;
250 #endif
252 #ifdef FE_INEXACT
253 if (set & GFC_FPE_INEXACT)
254 exc_set |= FE_INEXACT;
255 else if (clear & GFC_FPE_INEXACT)
256 exc_clr |= FE_INEXACT;
257 #endif
259 feclearexcept (exc_clr);
260 feraiseexcept (exc_set);
265 support_fpu_flag (int flag)
267 if (flag & GFC_FPE_INVALID)
269 #ifndef FE_INVALID
270 return 0;
271 #endif
273 else if (flag & GFC_FPE_ZERO)
275 #ifndef FE_DIVBYZERO
276 return 0;
277 #endif
279 else if (flag & GFC_FPE_OVERFLOW)
281 #ifndef FE_OVERFLOW
282 return 0;
283 #endif
285 else if (flag & GFC_FPE_UNDERFLOW)
287 #ifndef FE_UNDERFLOW
288 return 0;
289 #endif
291 else if (flag & GFC_FPE_DENORMAL)
293 #ifndef FE_DENORMAL
294 return 0;
295 #endif
297 else if (flag & GFC_FPE_INEXACT)
299 #ifndef FE_INEXACT
300 return 0;
301 #endif
304 return 1;
309 get_fpu_rounding_mode (void)
311 int rnd_mode;
313 rnd_mode = fegetround ();
315 switch (rnd_mode)
317 #ifdef FE_TONEAREST
318 case FE_TONEAREST:
319 return GFC_FPE_TONEAREST;
320 #endif
322 #ifdef FE_UPWARD
323 case FE_UPWARD:
324 return GFC_FPE_UPWARD;
325 #endif
327 #ifdef FE_DOWNWARD
328 case FE_DOWNWARD:
329 return GFC_FPE_DOWNWARD;
330 #endif
332 #ifdef FE_TOWARDZERO
333 case FE_TOWARDZERO:
334 return GFC_FPE_TOWARDZERO;
335 #endif
337 default:
338 return 0; /* Should be unreachable. */
343 void
344 set_fpu_rounding_mode (int mode)
346 int rnd_mode;
348 switch (mode)
350 #ifdef FE_TONEAREST
351 case GFC_FPE_TONEAREST:
352 rnd_mode = FE_TONEAREST;
353 break;
354 #endif
356 #ifdef FE_UPWARD
357 case GFC_FPE_UPWARD:
358 rnd_mode = FE_UPWARD;
359 break;
360 #endif
362 #ifdef FE_DOWNWARD
363 case GFC_FPE_DOWNWARD:
364 rnd_mode = FE_DOWNWARD;
365 break;
366 #endif
368 #ifdef FE_TOWARDZERO
369 case GFC_FPE_TOWARDZERO:
370 rnd_mode = FE_TOWARDZERO;
371 break;
372 #endif
374 default:
375 return; /* Should be unreachable. */
378 fesetround (rnd_mode);
383 support_fpu_rounding_mode (int mode)
385 switch (mode)
387 case GFC_FPE_TONEAREST:
388 #ifdef FE_TONEAREST
389 return 1;
390 #else
391 return 0;
392 #endif
394 case GFC_FPE_UPWARD:
395 #ifdef FE_UPWARD
396 return 1;
397 #else
398 return 0;
399 #endif
401 case GFC_FPE_DOWNWARD:
402 #ifdef FE_DOWNWARD
403 return 1;
404 #else
405 return 0;
406 #endif
408 case GFC_FPE_TOWARDZERO:
409 #ifdef FE_TOWARDZERO
410 return 1;
411 #else
412 return 0;
413 #endif
415 default:
416 return 0; /* Should be unreachable. */
421 void
422 get_fpu_state (void *state)
424 fegetenv (state);
428 void
429 set_fpu_state (void *state)
431 fesetenv (state);
435 /* Underflow in glibc is currently only supported on alpha, through
436 the FE_MAP_UMZ macro and __ieee_set_fp_control() function call. */
439 support_fpu_underflow_control (int kind __attribute__((unused)))
441 #if defined(__alpha__) && defined(FE_MAP_UMZ)
442 return (kind == 4 || kind == 8) ? 1 : 0;
443 #else
444 return 0;
445 #endif
450 get_fpu_underflow_mode (void)
452 #if defined(__alpha__) && defined(FE_MAP_UMZ)
454 fenv_t state = __ieee_get_fp_control ();
456 /* Return 0 for abrupt underflow (flush to zero), 1 for gradual underflow. */
457 return (state & FE_MAP_UMZ) ? 0 : 1;
459 #else
461 return 0;
463 #endif
467 void
468 set_fpu_underflow_mode (int gradual __attribute__((unused)))
470 #if defined(__alpha__) && defined(FE_MAP_UMZ)
472 fenv_t state = __ieee_get_fp_control ();
474 if (gradual)
475 state &= ~FE_MAP_UMZ;
476 else
477 state |= FE_MAP_UMZ;
479 __ieee_set_fp_control (state);
481 #endif