/* FPU-related code for systems with GNU libc.
- Copyright (C) 2005-2014 Free Software Foundation, Inc.
+ Copyright (C) 2005-2024 Free Software Foundation, Inc.
Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
This file is part of the GNU Fortran runtime library (libgfortran).
feenableexcept function in fenv.h to set individual exceptions
(there's nothing to do that in C99). */
-#include <assert.h>
-
#ifdef HAVE_FENV_H
#include <fenv.h>
#endif
+/* Check we can actually store the FPU state in the allocated size. */
+_Static_assert (sizeof(fenv_t) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE,
+ "GFC_FPE_STATE_BUFFER_SIZE is too small");
+
+
void set_fpu_trap_exceptions (int trap, int notrap)
{
+ int mode_set = 0, mode_clr = 0;
+
#ifdef FE_INVALID
if (trap & GFC_FPE_INVALID)
- feenableexcept (FE_INVALID);
+ mode_set |= FE_INVALID;
if (notrap & GFC_FPE_INVALID)
- fedisableexcept (FE_INVALID);
+ mode_clr |= FE_INVALID;
#endif
-/* glibc does never have a FE_DENORMAL. */
+/* Some glibc targets (like alpha) have FE_DENORMAL, but not many. */
#ifdef FE_DENORMAL
if (trap & GFC_FPE_DENORMAL)
- feenableexcept (FE_DENORMAL);
+ mode_set |= FE_DENORMAL;
if (notrap & GFC_FPE_DENORMAL)
- fedisableexcept (FE_DENORMAL);
+ mode_clr |= FE_DENORMAL;
#endif
#ifdef FE_DIVBYZERO
if (trap & GFC_FPE_ZERO)
- feenableexcept (FE_DIVBYZERO);
+ mode_set |= FE_DIVBYZERO;
if (notrap & GFC_FPE_ZERO)
- fedisableexcept (FE_DIVBYZERO);
+ mode_clr |= FE_DIVBYZERO;
#endif
#ifdef FE_OVERFLOW
if (trap & GFC_FPE_OVERFLOW)
- feenableexcept (FE_OVERFLOW);
+ mode_set |= FE_OVERFLOW;
if (notrap & GFC_FPE_OVERFLOW)
- fedisableexcept (FE_OVERFLOW);
+ mode_clr |= FE_OVERFLOW;
#endif
#ifdef FE_UNDERFLOW
if (trap & GFC_FPE_UNDERFLOW)
- feenableexcept (FE_UNDERFLOW);
+ mode_set |= FE_UNDERFLOW;
if (notrap & GFC_FPE_UNDERFLOW)
- fedisableexcept (FE_UNDERFLOW);
+ mode_clr |= FE_UNDERFLOW;
#endif
#ifdef FE_INEXACT
if (trap & GFC_FPE_INEXACT)
- feenableexcept (FE_INEXACT);
+ mode_set |= FE_INEXACT;
if (notrap & GFC_FPE_INEXACT)
- fedisableexcept (FE_INEXACT);
+ mode_clr |= FE_INEXACT;
#endif
+
+ /* Clear stalled exception flags. */
+ feclearexcept (FE_ALL_EXCEPT);
+
+ feenableexcept (mode_set);
+ fedisableexcept (mode_clr);
}
"exception not supported.\n");
#endif
-/* glibc does never have a FE_DENORMAL. */
#ifndef FE_DENORMAL
if (options.fpe & GFC_FPE_DENORMAL)
estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
case FE_TOWARDZERO:
return GFC_FPE_TOWARDZERO;
#endif
+
+#ifdef FE_TONEARESTFROMZERO
+ case FE_TONEARESTFROMZERO:
+ return GFC_FPE_AWAY;
+#endif
+
default:
- return GFC_FPE_INVALID;
+ return 0; /* Should be unreachable. */
}
}
rnd_mode = FE_TOWARDZERO;
break;
#endif
+
+#ifdef FE_TONEARESTFROMZERO
+ case GFC_FPE_AWAY:
+ rnd_mode = FE_TONEARESTFROMZERO;
+ break;
+#endif
+
default:
- return;
+ return; /* Should be unreachable. */
}
fesetround (rnd_mode);
return 0;
#endif
+ case GFC_FPE_UPWARD:
#ifdef FE_UPWARD
return 1;
#else
return 0;
#endif
+ case GFC_FPE_DOWNWARD:
#ifdef FE_DOWNWARD
return 1;
#else
return 0;
#endif
+ case GFC_FPE_TOWARDZERO:
#ifdef FE_TOWARDZERO
return 1;
#else
return 0;
#endif
- default:
+ case GFC_FPE_AWAY:
+#ifdef FE_TONEARESTFROMZERO
+ return 1;
+#else
return 0;
+#endif
+
+ default:
+ return 0; /* Should be unreachable. */
}
}
void
get_fpu_state (void *state)
{
- /* Check we can actually store the FPU state in the allocated size. */
- assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
-
fegetenv (state);
}
void
set_fpu_state (void *state)
{
- /* Check we can actually store the FPU state in the allocated size. */
- assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
-
fesetenv (state);
}
+
+/* Underflow in glibc is currently only supported on alpha, through
+ the FE_MAP_UMZ macro and __ieee_set_fp_control() function call. */
+
+int
+support_fpu_underflow_control (int kind __attribute__((unused)))
+{
+#if defined(__alpha__) && defined(FE_MAP_UMZ)
+ return (kind == 4 || kind == 8) ? 1 : 0;
+#else
+ return 0;
+#endif
+}
+
+
+int
+get_fpu_underflow_mode (void)
+{
+#if defined(__alpha__) && defined(FE_MAP_UMZ)
+
+ fenv_t state = __ieee_get_fp_control ();
+
+ /* Return 0 for abrupt underflow (flush to zero), 1 for gradual underflow. */
+ return (state & FE_MAP_UMZ) ? 0 : 1;
+
+#else
+
+ return 0;
+
+#endif
+}
+
+
+void
+set_fpu_underflow_mode (int gradual __attribute__((unused)))
+{
+#if defined(__alpha__) && defined(FE_MAP_UMZ)
+
+ fenv_t state = __ieee_get_fp_control ();
+
+ if (gradual)
+ state &= ~FE_MAP_UMZ;
+ else
+ state |= FE_MAP_UMZ;
+
+ __ieee_set_fp_control (state);
+
+#endif
+}
+