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 <fxcoudert@gcc.gnu.org>

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.

diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index ef06194eeb16bdadc4a64171055037e5e4a6502b..79a8c2ff450345ab65420490dfb0d211ee57eea6 100644 (file)
--- 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 (file)
index 0000000..8af6c91
--- /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 fd00dab829abf78e147cc2c31de16fbd6084ad11..e2f4a7d3fbfd4bd3c6b057598c760e26a9c5b4f8 100644 (file)
--- 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 3a2e4bab8eb98afbdbe941daedbbe82c6042995d..47893908f604fc6361ab8ee5392902a08a49f8ae 100644 (file)
--- 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 c643874af03fa4a6255df51da8ca705d64210fb4..fb1ac809f035149eb1b1f269ca48c0a98c0e5bcb 100644 (file)
--- 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 3b62228c1a1d939d26cbdf26d96cc1907e656487..9e976a8ded860a36bb8cd77ef95ce80ae0c31924 100644 (file)
--- 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 265ef6938032bd99c116c5fbcde1396bcd1f907e..f34b696a5f744ea95d1b22c72d171374bf3b43a2 100644 (file)
--- 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 4de3852cea8fe77f00c96729107b96883d73b5b2..4681322ae9b2d2b2c052f74a9c30c87390090ebe 100644 (file)
--- 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 4e01aa5504c18ee4079ceb8cdd328867a2e2c36a..7dce37a509997b3dd22621f2995815f398f507a3 100644 (file)
--- 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) &