From 4637a1d293c978816ad622ba33e3a32a78640edd Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Wed, 31 Aug 2022 19:15:20 +0200 Subject: [PATCH] Fortran: F2018 rounding modes changes Add the new IEEE_AWAY rounding mode. It is unsupported on all known targets, but could be supported by glibc and AIX as part of the C2x proposal. Testing for now is minimal. Add the optional RADIX argument to IEEE_SET_ROUNDING_MODE and IEEE_GET_ROUNDING_MODE. It is unused for now, because we do not support radices other than 2. 2022-08-31 Francois-Xavier Coudert gcc/fortran/ * libgfortran.h: Declare GFC_FPE_AWAY. gcc/testsuite/ * gfortran.dg/ieee/rounding_2.f90: New test. libgfortran/ * ieee/ieee_arithmetic.F90: Add RADIX argument to IEEE_SET_ROUNDING_MODE and IEEE_GET_ROUNDING_MODE. * config/fpu-387.h: Add IEEE_AWAY mode. * config/fpu-aarch64.h: Add IEEE_AWAY mode. * config/fpu-aix.h: Add IEEE_AWAY mode. * config/fpu-generic.h: Add IEEE_AWAY mode. * config/fpu-glibc.h: Add IEEE_AWAY mode. * config/fpu-sysv.h: Add IEEE_AWAY mode. --- gcc/fortran/libgfortran.h | 1 + gcc/testsuite/gfortran.dg/ieee/rounding_2.f90 | 20 +++++++++++++++++ libgfortran/config/fpu-387.h | 7 ++++-- libgfortran/config/fpu-aarch64.h | 7 ++++-- libgfortran/config/fpu-aix.h | 22 +++++++++++++++++-- libgfortran/config/fpu-generic.h | 11 ++++++++-- libgfortran/config/fpu-glibc.h | 18 +++++++++++++++ libgfortran/config/fpu-sysv.h | 7 ++++-- libgfortran/ieee/ieee_arithmetic.F90 | 7 ++++-- 9 files changed, 88 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/ieee/rounding_2.f90 diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index ef06194eeb16..79a8c2ff4503 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -60,6 +60,7 @@ along with GCC; see the file COPYING3. If not see #define GFC_FPE_TONEAREST 2 #define GFC_FPE_TOWARDZERO 3 #define GFC_FPE_UPWARD 4 +#define GFC_FPE_AWAY 5 /* Size of the buffer required to store FPU state for any target. In particular, this has to be larger than fenv_t on all glibc targets. diff --git a/gcc/testsuite/gfortran.dg/ieee/rounding_2.f90 b/gcc/testsuite/gfortran.dg/ieee/rounding_2.f90 new file mode 100644 index 000000000000..8af6c9182f45 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/rounding_2.f90 @@ -0,0 +1,20 @@ +! { dg-do run } + + use, intrinsic :: ieee_arithmetic + implicit none + + real :: sx1, sx2, sx3 + double precision :: dx1, dx2, dx3 + + ! IEEE_AWAY was added in Fortran 2018 and not supported by any target + ! at the moment. Just check we can query for its support. + + ! We should support at least C float and C double types + if (ieee_support_rounding(ieee_away) & + .or. ieee_support_rounding(ieee_away, 0.) & + .or. ieee_support_rounding(ieee_away, 0.d0)) then + print *, "If a target / libc now supports this, we need to add a proper check!" + stop 1 + end if + +end diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h index fd00dab829ab..e2f4a7d3fbfd 100644 --- a/libgfortran/config/fpu-387.h +++ b/libgfortran/config/fpu-387.h @@ -418,9 +418,12 @@ get_fpu_rounding_mode (void) } int -support_fpu_rounding_mode (int mode __attribute__((unused))) +support_fpu_rounding_mode (int mode) { - return 1; + if (mode == GFC_FPE_AWAY) + return 0; + else + return 1; } void diff --git a/libgfortran/config/fpu-aarch64.h b/libgfortran/config/fpu-aarch64.h index 3a2e4bab8eb9..47893908f604 100644 --- a/libgfortran/config/fpu-aarch64.h +++ b/libgfortran/config/fpu-aarch64.h @@ -293,9 +293,12 @@ set_fpu_rounding_mode (int round) int -support_fpu_rounding_mode (int mode __attribute__((unused))) +support_fpu_rounding_mode (int mode) { - return 1; + if (mode == GFC_FPE_AWAY) + return 0; + else + return 1; } diff --git a/libgfortran/config/fpu-aix.h b/libgfortran/config/fpu-aix.h index c643874af03f..fb1ac809f035 100644 --- a/libgfortran/config/fpu-aix.h +++ b/libgfortran/config/fpu-aix.h @@ -320,6 +320,11 @@ get_fpu_rounding_mode (void) return GFC_FPE_TOWARDZERO; #endif +#ifdef FE_TONEARESTFROMZERO + case FE_TONEARESTFROMZERO: + return GFC_FPE_AWAY; +#endif + default: return 0; /* Should be unreachable. */ } @@ -357,8 +362,14 @@ set_fpu_rounding_mode (int mode) break; #endif +#ifdef FE_TONEARESTFROMZERO + case GFC_FPE_AWAY: + rnd_mode = FE_TONEARESTFROMZERO; + break; +#endif + default: - return; /* Should be unreachable. */ + return; } fesetround (rnd_mode); @@ -398,8 +409,15 @@ support_fpu_rounding_mode (int mode) return 0; #endif + case GFC_FPE_AWAY: +#ifdef FE_TONEARESTFROMZERO + return 1; +#else + return 0; +#endif + default: - return 0; /* Should be unreachable. */ + return 0; } } diff --git a/libgfortran/config/fpu-generic.h b/libgfortran/config/fpu-generic.h index 3b62228c1a1d..9e976a8ded86 100644 --- a/libgfortran/config/fpu-generic.h +++ b/libgfortran/config/fpu-generic.h @@ -66,9 +66,16 @@ get_fpu_except_flags (void) int get_fpu_rounding_mode (void) -{ +{ + return 0; +} + + +int +support_fpu_rounding_mode (int mode __attribute__((unused))) +{ return 0; -} +} void diff --git a/libgfortran/config/fpu-glibc.h b/libgfortran/config/fpu-glibc.h index 265ef6938032..f34b696a5f74 100644 --- a/libgfortran/config/fpu-glibc.h +++ b/libgfortran/config/fpu-glibc.h @@ -342,6 +342,11 @@ get_fpu_rounding_mode (void) return GFC_FPE_TOWARDZERO; #endif +#ifdef FE_TONEARESTFROMZERO + case FE_TONEARESTFROMZERO: + return GFC_FPE_AWAY; +#endif + default: return 0; /* Should be unreachable. */ } @@ -379,6 +384,12 @@ set_fpu_rounding_mode (int mode) break; #endif +#ifdef FE_TONEARESTFROMZERO + case GFC_FPE_AWAY: + rnd_mode = FE_TONEARESTFROMZERO; + break; +#endif + default: return; /* Should be unreachable. */ } @@ -420,6 +431,13 @@ support_fpu_rounding_mode (int mode) return 0; #endif + case GFC_FPE_AWAY: +#ifdef FE_TONEARESTFROMZERO + return 1; +#else + return 0; +#endif + default: return 0; /* Should be unreachable. */ } diff --git a/libgfortran/config/fpu-sysv.h b/libgfortran/config/fpu-sysv.h index 4de3852cea8f..4681322ae9b2 100644 --- a/libgfortran/config/fpu-sysv.h +++ b/libgfortran/config/fpu-sysv.h @@ -374,9 +374,12 @@ set_fpu_rounding_mode (int mode) int -support_fpu_rounding_mode (int mode __attribute__((unused))) +support_fpu_rounding_mode (int mode) { - return 1; + if (mode == GFC_FPE_AWAY) + return 0; + else + return 1; } diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index 4e01aa5504c1..7dce37a50999 100644 --- a/libgfortran/ieee/ieee_arithmetic.F90 +++ b/libgfortran/ieee/ieee_arithmetic.F90 @@ -73,6 +73,7 @@ module IEEE_ARITHMETIC IEEE_TO_ZERO = IEEE_ROUND_TYPE(GFC_FPE_TOWARDZERO), & IEEE_UP = IEEE_ROUND_TYPE(GFC_FPE_UPWARD), & IEEE_DOWN = IEEE_ROUND_TYPE(GFC_FPE_DOWNWARD), & + IEEE_AWAY = IEEE_ROUND_TYPE(GFC_FPE_AWAY), & IEEE_OTHER = IEEE_ROUND_TYPE(0) @@ -1044,9 +1045,10 @@ contains ! IEEE_GET_ROUNDING_MODE - subroutine IEEE_GET_ROUNDING_MODE (ROUND_VALUE) + subroutine IEEE_GET_ROUNDING_MODE (ROUND_VALUE, RADIX) implicit none type(IEEE_ROUND_TYPE), intent(out) :: ROUND_VALUE + integer, intent(in), optional :: RADIX interface integer function helper() & @@ -1060,9 +1062,10 @@ contains ! IEEE_SET_ROUNDING_MODE - subroutine IEEE_SET_ROUNDING_MODE (ROUND_VALUE) + subroutine IEEE_SET_ROUNDING_MODE (ROUND_VALUE, RADIX) implicit none type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE + integer, intent(in), optional :: RADIX interface subroutine helper(val) & -- 2.39.2