/* FPU-related code for systems with GNU libc.
- Copyright (C) 2005-2015 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).
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
/* 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);
}
return GFC_FPE_TOWARDZERO;
#endif
+#ifdef FE_TONEARESTFROMZERO
+ case FE_TONEARESTFROMZERO:
+ return GFC_FPE_AWAY;
+#endif
+
default:
return 0; /* Should be unreachable. */
}
break;
#endif
+#ifdef FE_TONEARESTFROMZERO
+ case GFC_FPE_AWAY:
+ rnd_mode = FE_TONEARESTFROMZERO;
+ break;
+#endif
+
default:
return; /* Should be unreachable. */
}
return 0;
#endif
+ case GFC_FPE_AWAY:
+#ifdef FE_TONEARESTFROMZERO
+ return 1;
+#else
+ return 0;
+#endif
+
default:
return 0; /* Should be unreachable. */
}