[fortran,patch] Extend IEEE support to all real kinds

[fortran,patch] Extend IEEE support to all real kinds

[FX]

[-- Attachment #1: Type: text/plain, Size: 1114 bytes --]

The attached patch extends the IEEE modules to all floating-point kinds. Last time, when I added IEEE support, I restricted it to the float and double types (real kinds 4 and 8), to be extra safe. After discussion with Uros Bizjak and some reading, I’ve come to the conclusion that on most hardware where we support IEEE at all, we do support enough IEEE features on extended and quad prec (long double and __float128, on x86_64 hardware) to satisfy the Fortran standard.

So, this enables full IEEE support for all real kinds. Nothing changes to the underlying architecture, it’s almost exclusively mechanical changes (adding the necessary variants to the interfaces, etc.). 

Bootstrapped and regtested on x86_64-apple-darwin14 (with associated libquadmath patch: https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00124.html).
OK to commit to trunk?

FX


PS: Once this is in, I intend to focus on the next item: allowing all standard-mandated IEEE functions in constant expressions. Then, I believe our IEEE support will be entirely bug-free (in the sense that there will be no known bugs in it!).


[-- Attachment #2: ieee.ChangeLog --]
[-- Type: application/octet-stream, Size: 797 bytes --]

2015-08-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/64022
	* simplify.c (gfc_simplify_ieee_selected_real_kind): Extend IEEE
	support to all real kinds.


2015-08-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/64022
	* ieee/ieee_exceptions.F90: Support all real kinds.
	* ieee/ieee_arithmetic.F90: Likewise.
	* ieee/ieee_helper.c (ieee_class_helper_10,
	ieee_class_helper_16): New functions
	* config/fpu-387.h (support_fpu_underflow_control): Declare
	support for all kinds.
	* config/fpu-glibc.h (support_fpu_underflow_control): Likewise.
	* gfortran.map (GFORTRAN_1.7): Add entries.


2015-08-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/64022
	* gfortran.dg/ieee/ieee_7.f90: Adjust test.
	* gfortran.dg/ieee/large_1.f90: New test.


[-- Attachment #3: ieee.diff --]
[-- Type: application/octet-stream, Size: 41283 bytes --]

Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 226429)
+++ gcc/fortran/simplify.c	(working copy)
@@ -5556,80 +5556,13 @@ gfc_expr *
 gfc_simplify_ieee_selected_real_kind (gfc_expr *expr)
 {
   gfc_actual_arglist *arg = expr->value.function.actual;
-  gfc_expr *p = arg->expr, *r = arg->next->expr,
-	   *rad = arg->next->next->expr;
-  int precision, range, radix, res;
-  int found_precision, found_range, found_radix, i;
-
-  if (p)
-  {
-    if (p->expr_type != EXPR_CONSTANT
-	|| gfc_extract_int (p, &precision) != NULL)
-      return NULL;
-  }
-  else
-    precision = 0;
-
-  if (r)
-  {
-    if (r->expr_type != EXPR_CONSTANT
-	|| gfc_extract_int (r, &range) != NULL)
-      return NULL;
-  }
-  else
-    range = 0;
-
-  if (rad)
-  {
-    if (rad->expr_type != EXPR_CONSTANT
-	|| gfc_extract_int (rad, &radix) != NULL)
-      return NULL;
-  }
-  else
-    radix = 0;
-
-  res = INT_MAX;
-  found_precision = 0;
-  found_range = 0;
-  found_radix = 0;
-
-  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
-    {
-      /* We only support the target's float and double types.  */
-      if (!gfc_real_kinds[i].c_float && !gfc_real_kinds[i].c_double)
-	continue;
-
-      if (gfc_real_kinds[i].precision >= precision)
-	found_precision = 1;
-
-      if (gfc_real_kinds[i].range >= range)
-	found_range = 1;
-
-      if (radix == 0 || gfc_real_kinds[i].radix == radix)
-	found_radix = 1;
-
-      if (gfc_real_kinds[i].precision >= precision
-	  && gfc_real_kinds[i].range >= range
-	  && (radix == 0 || gfc_real_kinds[i].radix == radix)
-	  && gfc_real_kinds[i].kind < res)
-	res = gfc_real_kinds[i].kind;
-    }
-
-  if (res == INT_MAX)
-    {
-      if (found_radix && found_range && !found_precision)
-	res = -1;
-      else if (found_radix && found_precision && !found_range)
-	res = -2;
-      else if (found_radix && !found_precision && !found_range)
-	res = -3;
-      else if (found_radix)
-	res = -4;
-      else
-	res = -5;
-    }
+  gfc_expr *p = arg->expr, *q = arg->next->expr,
+	   *rdx = arg->next->next->expr;
 
-  return gfc_get_int_expr (gfc_default_integer_kind, &expr->where, res);
+  /* Currently, if IEEE is supported and this module is built, it means
+     all our floating-point types conform to IEEE. Hence, we simply handle
+     IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND.  */
+  return gfc_simplify_selected_real_kind (p, q, rdx);
 }
 
 
Index: libgfortran/config/fpu-387.h
===================================================================
--- libgfortran/config/fpu-387.h	(revision 226429)
+++ libgfortran/config/fpu-387.h	(working copy)
@@ -461,12 +461,12 @@ set_fpu_state (void *state)
 
 
 int
-support_fpu_underflow_control (int kind)
+support_fpu_underflow_control (int kind __attribute__((unused)))
 {
   if (!has_sse())
     return 0;
 
-  return (kind == 4 || kind == 8) ? 1 : 0;
+  return 1;
 }
 
 
Index: libgfortran/config/fpu-glibc.h
===================================================================
--- libgfortran/config/fpu-glibc.h	(revision 226429)
+++ libgfortran/config/fpu-glibc.h	(working copy)
@@ -439,7 +439,7 @@ int
 support_fpu_underflow_control (int kind __attribute__((unused)))
 {
 #if defined(__alpha__) && defined(FE_MAP_UMZ)
-  return (kind == 4 || kind == 8) ? 1 : 0;
+  return 1;
 #else
   return 0;
 #endif
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map	(revision 226429)
+++ libgfortran/gfortran.map	(working copy)
@@ -1276,6 +1276,16 @@ GFORTRAN_1.6 {
     __ieee_exceptions_MOD_ieee_usual;
 } GFORTRAN_1.5; 
 
+GFORTRAN_1.7 {
+  global:
+    __ieee_arithmetic_MOD_ieee_class_10;
+    __ieee_arithmetic_MOD_ieee_class_16;
+    __ieee_arithmetic_MOD_ieee_value_10;
+    __ieee_arithmetic_MOD_ieee_value_16;
+    __ieee_exceptions_MOD_ieee_support_flag_10;
+    __ieee_exceptions_MOD_ieee_support_flag_16;
+} GFORTRAN_1.6; 
+
 F2C_1.0 {
   global:
     _gfortran_f2c_specific__abs_c4;
Index: libgfortran/ieee/ieee_arithmetic.F90
===================================================================
--- libgfortran/ieee/ieee_arithmetic.F90	(revision 226429)
+++ libgfortran/ieee/ieee_arithmetic.F90	(working copy)
@@ -95,10 +95,27 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_finite_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_finite_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_finite_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_FINITE
-    procedure _gfortran_ieee_is_finite_4, _gfortran_ieee_is_finite_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_finite_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_finite_10, &
+#endif
+      _gfortran_ieee_is_finite_8, _gfortran_ieee_is_finite_4
   end interface
   public :: IEEE_IS_FINITE
 
@@ -111,10 +128,27 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_nan_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_nan_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_nan_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_NAN
-    procedure _gfortran_ieee_is_nan_4, _gfortran_ieee_is_nan_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_nan_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_nan_10, &
+#endif
+      _gfortran_ieee_is_nan_8, _gfortran_ieee_is_nan_4
   end interface
   public :: IEEE_IS_NAN
 
@@ -127,10 +161,27 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_negative_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_negative_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_negative_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_NEGATIVE
-    procedure _gfortran_ieee_is_negative_4, _gfortran_ieee_is_negative_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_negative_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_negative_10, &
+#endif
+      _gfortran_ieee_is_negative_8, _gfortran_ieee_is_negative_4
   end interface
   public :: IEEE_IS_NEGATIVE
 
@@ -143,64 +194,189 @@ module IEEE_ARITHMETIC
     elemental logical function _gfortran_ieee_is_normal_8(X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental logical function _gfortran_ieee_is_normal_10(X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental logical function _gfortran_ieee_is_normal_16(X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_IS_NORMAL
-    procedure _gfortran_ieee_is_normal_4, _gfortran_ieee_is_normal_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_is_normal_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_is_normal_10, &
+#endif
+      _gfortran_ieee_is_normal_8, _gfortran_ieee_is_normal_4
   end interface
   public :: IEEE_IS_NORMAL
 
   ! IEEE_COPY_SIGN
 
+#define COPYSIGN_MACRO(A,B) \
+  elemental real(kind = A) function \
+    _gfortran_ieee_copy_sign_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental real(kind=4) function _gfortran_ieee_copy_sign_4_4 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=4) function _gfortran_ieee_copy_sign_4_8 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_copy_sign_8_4 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_copy_sign_8_8 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+COPYSIGN_MACRO(4,4)
+COPYSIGN_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(4,16)
+#endif
+COPYSIGN_MACRO(8,4)
+COPYSIGN_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(10,4)
+COPYSIGN_MACRO(10,8)
+COPYSIGN_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(16,4)
+COPYSIGN_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(16,10)
+#endif
+COPYSIGN_MACRO(16,16)
+#endif
   end interface
 
   interface IEEE_COPY_SIGN
-    procedure _gfortran_ieee_copy_sign_4_4, _gfortran_ieee_copy_sign_4_8, &
-              _gfortran_ieee_copy_sign_8_4, _gfortran_ieee_copy_sign_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_16_16, &
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_copy_sign_16_10, &
+#endif
+              _gfortran_ieee_copy_sign_16_8, &
+              _gfortran_ieee_copy_sign_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_10_16, &
+#endif
+              _gfortran_ieee_copy_sign_10_10, &
+              _gfortran_ieee_copy_sign_10_8, &
+              _gfortran_ieee_copy_sign_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_copy_sign_8_10, &
+#endif
+              _gfortran_ieee_copy_sign_8_8, &
+              _gfortran_ieee_copy_sign_8_4, &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_copy_sign_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_copy_sign_4_10, &
+#endif
+              _gfortran_ieee_copy_sign_4_8, &
+              _gfortran_ieee_copy_sign_4_4
   end interface
   public :: IEEE_COPY_SIGN
 
   ! IEEE_UNORDERED
 
+#define UNORDERED_MACRO(A,B) \
+  elemental logical function \
+    _gfortran_ieee_unordered_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental logical function _gfortran_ieee_unordered_4_4 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental logical function _gfortran_ieee_unordered_4_8 (X,Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental logical function _gfortran_ieee_unordered_8_4 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental logical function _gfortran_ieee_unordered_8_8 (X,Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+UNORDERED_MACRO(4,4)
+UNORDERED_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(4,16)
+#endif
+UNORDERED_MACRO(8,4)
+UNORDERED_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(10,4)
+UNORDERED_MACRO(10,8)
+UNORDERED_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(16,4)
+UNORDERED_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(16,10)
+#endif
+UNORDERED_MACRO(16,16)
+#endif
   end interface
 
   interface IEEE_UNORDERED
-    procedure _gfortran_ieee_unordered_4_4, _gfortran_ieee_unordered_4_8, &
-              _gfortran_ieee_unordered_8_4, _gfortran_ieee_unordered_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_16_16, &
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_unordered_16_10, &
+#endif
+              _gfortran_ieee_unordered_16_8, &
+              _gfortran_ieee_unordered_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_10_16, &
+#endif
+              _gfortran_ieee_unordered_10_10, &
+              _gfortran_ieee_unordered_10_8, &
+              _gfortran_ieee_unordered_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_unordered_8_10, &
+#endif
+              _gfortran_ieee_unordered_8_8, &
+              _gfortran_ieee_unordered_8_4, &
+#ifdef HAVE_GFC_REAL_16
+              _gfortran_ieee_unordered_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+              _gfortran_ieee_unordered_4_10, &
+#endif
+              _gfortran_ieee_unordered_4_8, &
+              _gfortran_ieee_unordered_4_4
   end interface
   public :: IEEE_UNORDERED
 
@@ -213,64 +389,190 @@ module IEEE_ARITHMETIC
     elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental real(kind=10) function _gfortran_ieee_logb_10 (X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental real(kind=16) function _gfortran_ieee_logb_16 (X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_LOGB
-    procedure _gfortran_ieee_logb_4, _gfortran_ieee_logb_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_logb_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_logb_10, &
+#endif
+      _gfortran_ieee_logb_8, &
+      _gfortran_ieee_logb_4
   end interface
   public :: IEEE_LOGB
 
   ! IEEE_NEXT_AFTER
 
+#define NEXT_AFTER_MACRO(A,B) \
+  elemental real(kind = A) function \
+    _gfortran_ieee_next_after_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental real(kind=4) function _gfortran_ieee_next_after_4_4 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=4) function _gfortran_ieee_next_after_4_8 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_next_after_8_4 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_next_after_8_8 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+NEXT_AFTER_MACRO(4,4)
+NEXT_AFTER_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(4,16)
+#endif
+NEXT_AFTER_MACRO(8,4)
+NEXT_AFTER_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(10,4)
+NEXT_AFTER_MACRO(10,8)
+NEXT_AFTER_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(16,4)
+NEXT_AFTER_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(16,10)
+#endif
+NEXT_AFTER_MACRO(16,16)
+#endif
   end interface
 
   interface IEEE_NEXT_AFTER
-    procedure _gfortran_ieee_next_after_4_4, _gfortran_ieee_next_after_4_8, &
-              _gfortran_ieee_next_after_8_4, _gfortran_ieee_next_after_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_16_16, &
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_next_after_16_10, &
+#endif
+      _gfortran_ieee_next_after_16_8, &
+      _gfortran_ieee_next_after_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_10_16, &
+#endif
+      _gfortran_ieee_next_after_10_10, &
+      _gfortran_ieee_next_after_10_8, &
+      _gfortran_ieee_next_after_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_next_after_8_10, &
+#endif
+      _gfortran_ieee_next_after_8_8, &
+      _gfortran_ieee_next_after_8_4, &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_next_after_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_next_after_4_10, &
+#endif
+      _gfortran_ieee_next_after_4_8, &
+      _gfortran_ieee_next_after_4_4
   end interface
   public :: IEEE_NEXT_AFTER
 
   ! IEEE_REM
 
+#define REM_MACRO(RES,A,B) \
+  elemental real(kind = RES) function \
+    _gfortran_ieee_rem_/**/A/**/_/**/B (X,Y) ; \
+      real(kind = A), intent(in) :: X ; \
+      real(kind = B), intent(in) :: Y ; \
+  end function
+
   interface
-    elemental real(kind=4) function _gfortran_ieee_rem_4_4 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_rem_4_8 (X, Y)
-      real(kind=4), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_rem_8_4 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=4), intent(in) :: Y
-    end function
-    elemental real(kind=8) function _gfortran_ieee_rem_8_8 (X, Y)
-      real(kind=8), intent(in) :: X
-      real(kind=8), intent(in) :: Y
-    end function
+REM_MACRO(4,4,4)
+REM_MACRO(8,4,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,4,16)
+#endif
+REM_MACRO(8,8,4)
+REM_MACRO(8,8,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,10,4)
+REM_MACRO(10,10,8)
+REM_MACRO(10,10,10)
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,16,4)
+REM_MACRO(16,16,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(16,16,10)
+#endif
+REM_MACRO(16,16,16)
+#endif
   end interface
 
   interface IEEE_REM
-    procedure _gfortran_ieee_rem_4_4, _gfortran_ieee_rem_4_8, &
-              _gfortran_ieee_rem_8_4, _gfortran_ieee_rem_8_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_16_16, &
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rem_16_10, &
+#endif
+      _gfortran_ieee_rem_16_8, &
+      _gfortran_ieee_rem_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_10_16, &
+#endif
+      _gfortran_ieee_rem_10_10, &
+      _gfortran_ieee_rem_10_8, &
+      _gfortran_ieee_rem_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rem_8_10, &
+#endif
+      _gfortran_ieee_rem_8_8, &
+      _gfortran_ieee_rem_8_4, &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rem_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rem_4_10, &
+#endif
+      _gfortran_ieee_rem_4_8, &
+      _gfortran_ieee_rem_4_4
   end interface
   public :: IEEE_REM
 
@@ -283,10 +585,27 @@ module IEEE_ARITHMETIC
     elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
       real(kind=8), intent(in) :: X
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental real(kind=10) function _gfortran_ieee_rint_10 (X)
+      real(kind=10), intent(in) :: X
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental real(kind=16) function _gfortran_ieee_rint_16 (X)
+      real(kind=16), intent(in) :: X
+    end function
+#endif
   end interface
 
   interface IEEE_RINT
-    procedure _gfortran_ieee_rint_4, _gfortran_ieee_rint_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_rint_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_rint_10, &
+#endif
+      _gfortran_ieee_rint_8, _gfortran_ieee_rint_4
   end interface
   public :: IEEE_RINT
 
@@ -301,24 +620,57 @@ module IEEE_ARITHMETIC
       real(kind=8), intent(in) :: X
       integer, intent(in) :: I
     end function
+#ifdef HAVE_GFC_REAL_10
+    elemental real(kind=10) function _gfortran_ieee_scalb_10 (X, I)
+      real(kind=10), intent(in) :: X
+      integer, intent(in) :: I
+    end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+    elemental real(kind=16) function _gfortran_ieee_scalb_16 (X, I)
+      real(kind=16), intent(in) :: X
+      integer, intent(in) :: I
+    end function
+#endif
   end interface
 
   interface IEEE_SCALB
-    procedure _gfortran_ieee_scalb_4, _gfortran_ieee_scalb_8
+    procedure &
+#ifdef HAVE_GFC_REAL_16
+      _gfortran_ieee_scalb_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      _gfortran_ieee_scalb_10, &
+#endif
+      _gfortran_ieee_scalb_8, _gfortran_ieee_scalb_4
   end interface
   public :: IEEE_SCALB
 
   ! IEEE_VALUE
 
   interface IEEE_VALUE
-    module procedure IEEE_VALUE_4, IEEE_VALUE_8
+    module procedure &
+#ifdef HAVE_GFC_REAL_16
+      IEEE_VALUE_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      IEEE_VALUE_10, &
+#endif
+      IEEE_VALUE_8, IEEE_VALUE_4
   end interface
   public :: IEEE_VALUE
 
   ! IEEE_CLASS
 
   interface IEEE_CLASS
-    module procedure IEEE_CLASS_4, IEEE_CLASS_8
+    module procedure &
+#ifdef HAVE_GFC_REAL_16
+      IEEE_CLASS_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+      IEEE_CLASS_10, &
+#endif
+      IEEE_CLASS_8, IEEE_CLASS_4
   end interface
   public :: IEEE_CLASS
 
@@ -424,47 +776,19 @@ contains
     res = (X%hidden /= Y%hidden)
   end function
 
+
   ! IEEE_SELECTED_REAL_KIND
+
   integer function IEEE_SELECTED_REAL_KIND (P, R, RADIX) result(res)
     implicit none
     integer, intent(in), optional :: P, R, RADIX
-    integer :: p2, r2
 
-    p2 = 0 ; r2 = 0
-    if (present(p)) p2 = p
-    if (present(r)) r2 = r
-
-    ! The only IEEE types we support right now are binary
-    if (present(radix)) then
-      if (radix /= 2) then
-        res = -5
-        return
-      endif
-    endif
-
-    ! Does IEEE float fit?
-    if (precision(0.) >= p2 .and. range(0.) >= r2) then
-      res = kind(0.)
-      return
-    endif
-
-    ! Does IEEE double fit?
-    if (precision(0.d0) >= p2 .and. range(0.d0) >= r2) then
-      res = kind(0.d0)
-      return
-    endif
-
-    if (precision(0.d0) < p2 .and. range(0.d0) < r2) then
-      res = -3
-      return
-    endif
-
-    if (precision(0.d0) < p2) then
-      res = -1
-      return
-    endif
+    ! Currently, if IEEE is supported and this module is built, it means
+    ! all our floating-point types conform to IEEE. Hence, we simply call
+    ! SELECTED_REAL_KIND.
+
+    res = SELECTED_REAL_KIND (P, R, RADIX)
 
-   res = -2
   end function
 
 
@@ -498,6 +822,39 @@ contains
     res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
   end function
 
+#ifdef HAVE_GFC_REAL_10
+  elemental function IEEE_CLASS_10 (X) result(res)
+    implicit none
+    real(kind=10), intent(in) :: X
+    type(IEEE_CLASS_TYPE) :: res
+
+    interface
+      pure integer function _gfortrani_ieee_class_helper_10(val)
+        real(kind=10), intent(in) :: val
+      end function
+    end interface
+
+    res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_10(X))
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  elemental function IEEE_CLASS_16 (X) result(res)
+    implicit none
+    real(kind=16), intent(in) :: X
+    type(IEEE_CLASS_TYPE) :: res
+
+    interface
+      pure integer function _gfortrani_ieee_class_helper_16(val)
+        real(kind=16), intent(in) :: val
+      end function
+    end interface
+
+    res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_16(X))
+  end function
+#endif
+
+
   ! IEEE_VALUE
 
   elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
@@ -576,6 +933,86 @@ contains
      end select
   end function
 
+#ifdef HAVE_GFC_REAL_10
+  elemental real(kind=10) function IEEE_VALUE_10(X, C) result(res)
+    implicit none
+    real(kind=10), intent(in) :: X
+    type(IEEE_CLASS_TYPE), intent(in) :: C
+
+    select case (C%hidden)
+      case (1)     ! IEEE_SIGNALING_NAN
+        res = -1
+        res = sqrt(res)
+      case (2)     ! IEEE_QUIET_NAN
+        res = -1
+        res = sqrt(res)
+      case (3)     ! IEEE_NEGATIVE_INF
+        res = huge(res)
+        res = (-res) * res
+      case (4)     ! IEEE_NEGATIVE_NORMAL
+        res = -42
+      case (5)     ! IEEE_NEGATIVE_DENORMAL
+        res = -tiny(res)
+        res = res / 2
+      case (6)     ! IEEE_NEGATIVE_ZERO
+        res = 0
+        res = -res
+      case (7)     ! IEEE_POSITIVE_ZERO
+        res = 0
+      case (8)     ! IEEE_POSITIVE_DENORMAL
+        res = tiny(res)
+        res = res / 2
+      case (9)     ! IEEE_POSITIVE_NORMAL
+        res = 42
+      case (10)    ! IEEE_POSITIVE_INF
+        res = huge(res)
+        res = res * res
+      case default ! IEEE_OTHER_VALUE, should not happen
+        res = 0
+     end select
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  elemental real(kind=16) function IEEE_VALUE_16(X, C) result(res)
+    implicit none
+    real(kind=16), intent(in) :: X
+    type(IEEE_CLASS_TYPE), intent(in) :: C
+
+    select case (C%hidden)
+      case (1)     ! IEEE_SIGNALING_NAN
+        res = -1
+        res = sqrt(res)
+      case (2)     ! IEEE_QUIET_NAN
+        res = -1
+        res = sqrt(res)
+      case (3)     ! IEEE_NEGATIVE_INF
+        res = huge(res)
+        res = (-res) * res
+      case (4)     ! IEEE_NEGATIVE_NORMAL
+        res = -42
+      case (5)     ! IEEE_NEGATIVE_DENORMAL
+        res = -tiny(res)
+        res = res / 2
+      case (6)     ! IEEE_NEGATIVE_ZERO
+        res = 0
+        res = -res
+      case (7)     ! IEEE_POSITIVE_ZERO
+        res = 0
+      case (8)     ! IEEE_POSITIVE_DENORMAL
+        res = tiny(res)
+        res = res / 2
+      case (9)     ! IEEE_POSITIVE_NORMAL
+        res = 42
+      case (10)    ! IEEE_POSITIVE_INF
+        res = huge(res)
+        res = res * res
+      case default ! IEEE_OTHER_VALUE, should not happen
+        res = 0
+     end select
+  end function
+#endif
+
 
   ! IEEE_GET_ROUNDING_MODE
 
@@ -663,7 +1100,7 @@ contains
     implicit none
     real(kind=10), intent(in) :: X
     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
-    res = .false.
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
   end function
 #endif
 
@@ -672,18 +1109,14 @@ contains
     implicit none
     real(kind=16), intent(in) :: X
     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
-    res = .false.
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
   end function
 #endif
 
   pure logical function IEEE_SUPPORT_ROUNDING_NOARG (ROUND_VALUE) result(res)
     implicit none
     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-    res = .false.
-#else
     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
-#endif
   end function
 
 ! IEEE_SUPPORT_UNDERFLOW_CONTROL
@@ -704,7 +1137,7 @@ contains
   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_10 (X) result(res)
     implicit none
     real(kind=10), intent(in) :: X
-    res = .false.
+    res = (support_underflow_control_helper(10) /= 0)
   end function
 #endif
 
@@ -712,18 +1145,21 @@ contains
   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_16 (X) result(res)
     implicit none
     real(kind=16), intent(in) :: X
-    res = .false.
+    res = (support_underflow_control_helper(16) /= 0)
   end function
 #endif
 
   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG () result(res)
     implicit none
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-    res = .false.
-#else
     res = (support_underflow_control_helper(4) /= 0 &
-           .and. support_underflow_control_helper(8) /= 0)
+           .and. support_underflow_control_helper(8) /= 0 &
+#ifdef HAVE_GFC_REAL_10
+           .and. support_underflow_control_helper(10) /= 0 &
+#endif
+#ifdef HAVE_GFC_REAL_16
+           .and. support_underflow_control_helper(16) /= 0 &
 #endif
+          )
   end function
 
 ! IEEE_SUPPORT_* functions
@@ -746,127 +1182,95 @@ contains
 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.true.)
-#endif
 
 ! IEEE_SUPPORT_DENORMAL
 
 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.true.)
-#endif
 
 ! IEEE_SUPPORT_DIVIDE
 
 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.true.)
-#endif
 
 ! IEEE_SUPPORT_INF
 
 SUPPORTMACRO(IEEE_SUPPORT_INF,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_INF,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_INF,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_INF,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.true.)
-#endif
 
 ! IEEE_SUPPORT_IO
 
 SUPPORTMACRO(IEEE_SUPPORT_IO,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_IO,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_IO,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_IO,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.true.)
-#endif
 
 ! IEEE_SUPPORT_NAN
 
 SUPPORTMACRO(IEEE_SUPPORT_NAN,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_NAN,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.true.)
-#endif
 
 ! IEEE_SUPPORT_SQRT
 
 SUPPORTMACRO(IEEE_SUPPORT_SQRT,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_SQRT,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.true.)
-#endif
 
 ! IEEE_SUPPORT_STANDARD
 
 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,4,.true.)
 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,8,.true.)
 #ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.true.)
 #endif
 #ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.true.)
 #endif
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
-SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.false.)
-#else
 SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.true.)
-#endif
 
 end module IEEE_ARITHMETIC
Index: libgfortran/ieee/ieee_exceptions.F90
===================================================================
--- libgfortran/ieee/ieee_exceptions.F90	(revision 226429)
+++ libgfortran/ieee/ieee_exceptions.F90	(working copy)
@@ -57,9 +57,15 @@ module IEEE_EXCEPTIONS
   end type
 
   interface IEEE_SUPPORT_FLAG
-    module procedure IEEE_SUPPORT_FLAG_NOARG, &
-                     IEEE_SUPPORT_FLAG_4, &
-                     IEEE_SUPPORT_FLAG_8
+    module procedure IEEE_SUPPORT_FLAG_4, &
+                     IEEE_SUPPORT_FLAG_8, &
+#ifdef HAVE_GFC_REAL_10
+                     IEEE_SUPPORT_FLAG_10, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+                     IEEE_SUPPORT_FLAG_16, &
+#endif
+                     IEEE_SUPPORT_FLAG_NOARG
   end interface IEEE_SUPPORT_FLAG
 
   public :: IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
@@ -215,4 +221,22 @@ contains
     res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
   end function
 
+#ifdef HAVE_GFC_REAL_10
+  pure logical function IEEE_SUPPORT_FLAG_10 (FLAG, X) result(res)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    real(kind=10), intent(in) :: X
+    res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  pure logical function IEEE_SUPPORT_FLAG_16 (FLAG, X) result(res)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    real(kind=16), intent(in) :: X
+    res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+  end function
+#endif
+
 end module IEEE_EXCEPTIONS
Index: libgfortran/ieee/ieee_helper.c
===================================================================
--- libgfortran/ieee/ieee_helper.c	(revision 226429)
+++ libgfortran/ieee/ieee_helper.c	(working copy)
@@ -33,6 +33,16 @@ internal_proto(ieee_class_helper_4);
 extern int ieee_class_helper_8 (GFC_REAL_8 *);
 internal_proto(ieee_class_helper_8);
 
+#ifdef HAVE_GFC_REAL_10
+extern int ieee_class_helper_10 (GFC_REAL_10 *);
+internal_proto(ieee_class_helper_10);
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+extern int ieee_class_helper_16 (GFC_REAL_16 *);
+internal_proto(ieee_class_helper_16);
+#endif
+
 /* Enumeration of the possible floating-point types. These values
    correspond to the hidden arguments of the IEEE_CLASS_TYPE
    derived-type of IEEE_ARITHMETIC.  */
@@ -74,6 +84,14 @@ enum { IEEE_OTHER_VALUE = 0, IEEE_SIGNAL
 CLASSMACRO(4)
 CLASSMACRO(8)
 
+#ifdef HAVE_GFC_REAL_10
+CLASSMACRO(10)
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+CLASSMACRO(16)
+#endif
+
 
 #define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \
 		     GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \
Index: gcc/testsuite/gfortran.dg/ieee/ieee_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ieee/ieee_7.f90	(revision 226429)
+++ gcc/testsuite/gfortran.dg/ieee/ieee_7.f90	(working copy)
@@ -1,8 +1,14 @@
 ! { dg-do run }
 
   use :: ieee_arithmetic
+  use :: iso_fortran_env, only : real_kinds
   implicit none
 
+  ! This should be 
+  ! integer, parameter :: maxreal = maxval(real_kinds)
+  ! but it works because REAL_KINDS happen to be in increasing order
+  integer, parameter :: maxreal = real_kinds(size(real_kinds))
+
   ! Test IEEE_SELECTED_REAL_KIND in specification expressions
 
   integer(kind=ieee_selected_real_kind()) :: i1
@@ -27,8 +33,8 @@
   end if
 
   if (ieee_selected_real_kind(0,0,3) /= -5) call abort
-  if (ieee_selected_real_kind(precision(0.d0)+1) /= -1) call abort
-  if (ieee_selected_real_kind(0,range(0.d0)+1) /= -2) call abort
-  if (ieee_selected_real_kind(precision(0.d0)+1,range(0.d0)+1) /= -3) call abort
+  if (ieee_selected_real_kind(precision(0._maxreal)+1) /= -1) call abort
+  if (ieee_selected_real_kind(0,range(0._maxreal)+1) /= -2) call abort
+  if (ieee_selected_real_kind(precision(0._maxreal)+1,range(0._maxreal)+1) /= -3) call abort
 
 end
Index: gcc/testsuite/gfortran.dg/ieee/large_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ieee/large_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/ieee/large_1.f90	(working copy)
@@ -0,0 +1,138 @@
+! { dg-do run }
+!
+! Testing IEEE modules on large real kinds
+
+program test
+
+  use ieee_arithmetic
+  implicit none
+
+  ! k1 and k2 will be large real kinds, if supported, and single/double
+  ! otherwise
+  integer, parameter :: k1 = &
+    max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.))
+  integer, parameter :: k2 = &
+    max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0))
+
+  real(kind=k1) :: x1, y1
+  real(kind=k2) :: x2, y2
+
+  ! Checking ieee_is_finite
+
+  if (.not. ieee_is_finite(huge(0._k1))) call abort
+  if (ieee_is_finite(ieee_value(0._k1, ieee_negative_inf))) call abort
+  x1 = -42
+  if (.not. ieee_is_finite(x1)) call abort
+  if (ieee_is_finite(sqrt(x1))) call abort
+
+  if (.not. ieee_is_finite(huge(0._k2))) call abort
+  if (ieee_is_finite(ieee_value(0._k2, ieee_negative_inf))) call abort
+  x2 = -42
+  if (.not. ieee_is_finite(x2)) call abort
+  if (ieee_is_finite(sqrt(x2))) call abort
+
+  ! Other ieee_is intrinsics
+
+  if (ieee_is_nan(huge(0._k1))) call abort
+  if (.not. ieee_is_negative(-huge(0._k1))) call abort
+  if (.not. ieee_is_normal(-huge(0._k1))) call abort
+
+  if (ieee_is_nan(huge(0._k2))) call abort
+  if (.not. ieee_is_negative(-huge(0._k2))) call abort
+  if (.not. ieee_is_normal(-huge(0._k2))) call abort
+
+  ! ieee_support intrinsics
+
+  if (.not. ieee_support_datatype(x1)) call abort
+  if (.not. ieee_support_denormal(x1)) call abort
+  if (.not. ieee_support_divide(x1)) call abort
+  if (.not. ieee_support_inf(x1)) call abort
+  if (.not. ieee_support_io(x1)) call abort
+  if (.not. ieee_support_nan(x1)) call abort
+  if (.not. ieee_support_rounding(ieee_nearest, x1)) call abort
+  if (.not. ieee_support_sqrt(x1)) call abort
+  if (.not. ieee_support_standard(x1)) call abort
+  if (.not. ieee_support_underflow_control(x1)) call abort
+
+  if (.not. ieee_support_datatype(x2)) call abort
+  if (.not. ieee_support_denormal(x2)) call abort
+  if (.not. ieee_support_divide(x2)) call abort
+  if (.not. ieee_support_inf(x2)) call abort
+  if (.not. ieee_support_io(x2)) call abort
+  if (.not. ieee_support_nan(x2)) call abort
+  if (.not. ieee_support_rounding(ieee_nearest, x2)) call abort
+  if (.not. ieee_support_sqrt(x2)) call abort
+  if (.not. ieee_support_standard(x2)) call abort
+  if (.not. ieee_support_underflow_control(x2)) call abort
+
+  ! ieee_value and ieee_class
+
+  if (.not. ieee_is_nan(ieee_value(x1, ieee_quiet_nan))) call abort
+  if (ieee_class(ieee_value(x1, ieee_positive_denormal)) &
+    /= ieee_positive_denormal) call abort
+
+  if (.not. ieee_is_nan(ieee_value(x2, ieee_quiet_nan))) call abort
+  if (ieee_class(ieee_value(x2, ieee_positive_denormal)) &
+    /= ieee_positive_denormal) call abort
+
+  ! ieee_unordered
+
+  if (.not. ieee_unordered(ieee_value(x1, ieee_quiet_nan), 0._k1)) call abort
+  if (ieee_unordered(ieee_value(x1, ieee_negative_inf), 0._k1)) call abort
+
+  if (.not. ieee_unordered(ieee_value(x2, ieee_quiet_nan), 0._k2)) call abort
+  if (ieee_unordered(ieee_value(x2, ieee_negative_inf), 0._k2)) call abort
+
+  ! ieee_copy_sign
+
+  if (.not. ieee_class(ieee_copy_sign(ieee_value(x1, ieee_positive_inf), -1.)) &
+            == ieee_negative_inf) call abort
+  if (.not. ieee_class(ieee_copy_sign(0._k1, -42._k2)) &
+            == ieee_negative_zero) call abort
+
+  if (.not. ieee_class(ieee_copy_sign(ieee_value(x2, ieee_positive_inf), -1.)) &
+            == ieee_negative_inf) call abort
+  if (.not. ieee_class(ieee_copy_sign(0._k2, -42._k1)) &
+            == ieee_negative_zero) call abort
+
+  ! ieee_logb
+
+  if (ieee_logb (42._k1) /= exponent(42._k1) - 1) call abort
+
+  if (ieee_logb (42._k2) /= exponent(42._k2) - 1) call abort
+
+  ! ieee_next_after
+
+  if (ieee_next_after(42._k1, ieee_value(x1, ieee_positive_inf)) &
+      /= 42._k1 + spacing(42._k1)) call abort
+
+  if (ieee_next_after(42._k2, ieee_value(x2, ieee_positive_inf)) &
+      /= 42._k2 + spacing(42._k2)) call abort
+
+  ! ieee_rem
+
+  if (ieee_class(ieee_rem(-42._k1, 2._k1)) /= ieee_negative_zero) &
+    call abort
+
+  if (ieee_class(ieee_rem(-42._k2, 2._k2)) /= ieee_negative_zero) &
+    call abort
+
+  ! ieee_rint
+
+  if (ieee_rint(-1.1_k1) /= -1._k1) call abort
+  if (ieee_rint(huge(x1)) /= huge(x1)) call abort
+
+  if (ieee_rint(-1.1_k2) /= -1._k2) call abort
+  if (ieee_rint(huge(x2)) /= huge(x2)) call abort
+
+  ! ieee_scalb
+
+  x1 = sqrt(42._k1)
+  if (ieee_scalb(x1, 2) /= 4._k1 * x1) call abort
+  if (ieee_scalb(x1, -2) /= x1 / 4._k1) call abort
+
+  x2 = sqrt(42._k2)
+  if (ieee_scalb(x2, 2) /= 4._k2 * x2) call abort
+  if (ieee_scalb(x2, -2) /= x2 / 4._k2) call abort
+
+end program test

Re: [fortran,patch] Extend IEEE support to all real kinds

[Steve Kargl]

On Mon, Aug 03, 2015 at 11:14:41PM +0200, FX wrote:
> 
> So, this enables full IEEE support for all real kinds. Nothing
> changes to the underlying architecture, it???s almost exclusively
> mechanical changes (adding the necessary variants to the interfaces, etc.). 
> 
> Bootstrapped and regtested on x86_64-apple-darwin14 (with associated
> libquadmath patch: https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00124.html).
> OK to commit to trunk?
> 

This is OK to commit.  It's unclear whether I've
sufficient authority to OK the libquadmath path.

> 
> PS: Once this is in, I intend to focus on the next item: allowing
> all standard-mandated IEEE functions in constant expressions.  Then,
> I believe our IEEE support will be entirely bug-free (in the sense
> that there will be no known bugs in it!).
> 

See PR libquadmath/65757.  I'm not sure if it effects 
the IEEE support other than libquadmath has issues.

-- 
Steve

Re: [fortran,patch] Extend IEEE support to all real kinds

[Uros Bizjak]

On Mon, Aug 3, 2015 at 11:14 PM, FX <fxcoudert@gmail.com> wrote:
> The attached patch extends the IEEE modules to all floating-point kinds. Last time, when I added IEEE support, I restricted it to the float and double types (real kinds 4 and 8), to be extra safe. After discussion with Uros Bizjak and some reading, I’ve come to the conclusion that on most hardware where we support IEEE at all, we do support enough IEEE features on extended and quad prec (long double and __float128, on x86_64 hardware) to satisfy the Fortran standard.
>
> So, this enables full IEEE support for all real kinds. Nothing changes to the underlying architecture, it’s almost exclusively mechanical changes (adding the necessary variants to the interfaces, etc.).
>
> Bootstrapped and regtested on x86_64-apple-darwin14 (with associated libquadmath patch: https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00124.html).
> OK to commit to trunk?

Can you please also introduce tests for ieee exceptions for long
double and __float128 types (as is done for real and double in
gfortran.dg/ieee/ieee_1.F90) as well as test for supported rounding
modes as done for real and double in gfortran.dg/ieee/rounding_1.f90 ?

On x86_64, these new tests will exercise exceptions and rounding modes
for __float128 soft-fp library, in addition to x87 long double tests.

Uros.

Re: [fortran,patch] Extend IEEE support to all real kinds

[FX]

> Can you please also introduce tests for ieee exceptions for long
> double and __float128 types (as is done for real and double in
> gfortran.dg/ieee/ieee_1.F90) as well as test for supported rounding
> modes as done for real and double in gfortran.dg/ieee/rounding_1.f90 ?
> 
> On x86_64, these new tests will exercise exceptions and rounding modes
> for __float128 soft-fp library, in addition to x87 long double tests.

I’ve now introduced the tests for rounding (large_2.f90) and exceptions (large_3.F90):

Adding         gfortran.dg/ieee/large_2.f90
Adding         gfortran.dg/ieee/large_3.F90
Transmitting file data ...
Committed revision 226670.

Re: [fortran,patch] Extend IEEE support to all real kinds

[Uros Bizjak]

[-- Attachment #1: Type: text/plain, Size: 1167 bytes --]

On Thu, Aug 6, 2015 at 11:26 AM, FX <fxcoudert@gmail.com> wrote:
>> Can you please also introduce tests for ieee exceptions for long
>> double and __float128 types (as is done for real and double in
>> gfortran.dg/ieee/ieee_1.F90) as well as test for supported rounding
>> modes as done for real and double in gfortran.dg/ieee/rounding_1.f90 ?
>>
>> On x86_64, these new tests will exercise exceptions and rounding modes
>> for __float128 soft-fp library, in addition to x87 long double tests.
>
> I’ve now introduced the tests for rounding (large_2.f90) and exceptions (large_3.F90):

Attached to this message, please find the testcase for underflow
control for large types. I was using this test to check for support of
large types on x86_64 and alpha. I can confirm that neither target
supports underflow control for large types, but nevertheless I think
the test could be used as a negative test for
ieee_support_underflow_control.

2015-08-06  Uros Bizjak  <ubizjak@gmail.com>

    PR fortran/64022
    * gfortran.dg/ieee/large_4.f90: New test.

Tested on x86_64-linux-gnu {,-m32}  and alphaev68-linux-gnu.

OK for mainline?

Uros.

[-- Attachment #2: f.diff.txt --]
[-- Type: text/plain, Size: 1511 bytes --]

Index: gfortran.dg/ieee/large_4.f90
===================================================================
--- gfortran.dg/ieee/large_4.f90	(revision 0)
+++ gfortran.dg/ieee/large_4.f90	(working copy)
@@ -0,0 +1,54 @@
+! { dg-do run }
+
+program test_underflow_control
+  use ieee_arithmetic
+  use iso_fortran_env
+
+  ! kx and ky will be large real kinds, if supported, and single/double
+  ! otherwise
+  integer, parameter :: kx = &
+    max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.))
+  integer, parameter :: ky = &
+    max(ieee_selected_real_kind(precision(0._kx) + 1), kind(0.d0))
+
+  logical l
+  real(kind=kx), volatile :: x
+  real(kind=ky), volatile :: y
+
+  if (ieee_support_underflow_control(x)) then
+
+    x = tiny(x)
+    call ieee_set_underflow_mode(.true.)
+    x = x / 2000._kx
+    if (x == 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (.not. l) call abort
+
+    x = tiny(x)
+    call ieee_set_underflow_mode(.false.)
+    x = x / 2000._kx
+    if (x > 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (l) call abort
+
+  end if
+
+  if (ieee_support_underflow_control(y)) then
+
+    y = tiny(y)
+    call ieee_set_underflow_mode(.true.)
+    y = y / 2000._ky
+    if (y == 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (.not. l) call abort
+
+    y = tiny(y)
+    call ieee_set_underflow_mode(.false.)
+    y = y / 2000._ky
+    if (y > 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (l) call abort
+
+  end if
+
+end program

Re: [fortran,patch] Extend IEEE support to all real kinds

[FX]

> 2015-08-06  Uros Bizjak  <ubizjak@gmail.com>
> 
>    PR fortran/64022
>    * gfortran.dg/ieee/large_4.f90: New test.
> 
> Tested on x86_64-linux-gnu {,-m32}  and alphaev68-linux-gnu.
> OK for mainline?

OK. Thanks for the patch!

FX

Re: [fortran,patch] Extend IEEE support to all real kinds

[Uros Bizjak]

On Mon, Aug 3, 2015 at 11:14 PM, FX <fxcoudert@gmail.com> wrote:
> The attached patch extends the IEEE modules to all floating-point kinds. Last time, when I added IEEE support, I restricted it to the float and double types (real kinds 4 and 8), to be extra safe. After discussion with Uros Bizjak and some reading, I’ve come to the conclusion that on most hardware where we support IEEE at all, we do support enough IEEE features on extended and quad prec (long double and __float128, on x86_64 hardware) to satisfy the Fortran standard.
>
> So, this enables full IEEE support for all real kinds. Nothing changes to the underlying architecture, it’s almost exclusively mechanical changes (adding the necessary variants to the interfaces, etc.).
>
> Bootstrapped and regtested on x86_64-apple-darwin14 (with associated libquadmath patch: https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00124.html).
> OK to commit to trunk?

> Index: libgfortran/config/fpu-387.h
> ===================================================================
> --- libgfortran/config/fpu-387.h (revision 226429)
> +++ libgfortran/config/fpu-387.h (working copy)
> @@ -461,12 +461,12 @@ set_fpu_state (void *state)
>
>
>  int
> -support_fpu_underflow_control (int kind)
> +support_fpu_underflow_control (int kind __attribute__((unused)))
>  {
>    if (!has_sse())
>      return 0;
>
> -  return (kind == 4 || kind == 8) ? 1 : 0;
> +  return 1;
>  }

x86 doesn't support underflow control for long double (x87) and
__float128 types, so the above change is wrong.

> Index: libgfortran/config/fpu-glibc.h
> ===================================================================
> --- libgfortran/config/fpu-glibc.h (revision 226429)
> +++ libgfortran/config/fpu-glibc.h (working copy)
> @@ -439,7 +439,7 @@ int
>  support_fpu_underflow_control (int kind __attribute__((unused)))
>  {
>  #if defined(__alpha__) && defined(FE_MAP_UMZ)
> -  return (kind == 4 || kind == 8) ? 1 : 0;
> +  return 1;
>  #else
>    return 0;
>  #endif

I'm not sure for alpha, if it supports underflow control for extended
types. Let's keep this as is for now, it is trivial to change later.

Uros.

Re: [fortran,patch] Extend IEEE support to all real kinds

[Andreas Schwab]

FAIL: gfortran.dg/ieee/large_1.f90   -O0  (test for excess errors)
Excess errors:
large_1.f90:(.text+0x1792): undefined reference to `logbq'

Andreas.

-- 
Andreas Schwab, SUSE Labs, schwab@suse.de
GPG Key fingerprint = 0196 BAD8 1CE9 1970 F4BE  1748 E4D4 88E3 0EEA B9D7
"And now for something completely different."

Re: [fortran,patch] Extend IEEE support to all real kinds

[FX]

> FAIL: gfortran.dg/ieee/large_1.f90   -O0  (test for excess errors)
> Excess errors:
> large_1.f90:(.text+0x1792): undefined reference to `logbq’

Fixed by the patch there: https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00124.html
Waiting for review.

FX

Re: [fortran,patch] Extend IEEE support to all real kinds

[Rainer Orth]

FX <fxcoudert@gmail.com> writes:

>> FAIL: gfortran.dg/ieee/large_1.f90   -O0  (test for excess errors)
>> Excess errors:
>> large_1.f90:(.text+0x1792): undefined reference to `logbq’
>
> Fixed by the patch there:
> https://gcc.gnu.org/ml/gcc-patches/2015-08/msg00124.html
> Waiting for review.

I think it's a bad idea committing an (approved) patch without the
prerequisite, introducing testsuite failures for everyone and sending us
all hunting what's wrong ;-(

	Rainer

-- 
-----------------------------------------------------------------------------
Rainer Orth, Center for Biotechnology, Bielefeld University

Re: [fortran,patch] Extend IEEE support to all real kinds

[FX]

> I think it's a bad idea committing an (approved) patch without the
> prerequisite, introducing testsuite failures for everyone and sending us
> all hunting what's wrong ;-(

I realize I probably should have XFAIL’ed the testcase, indeed. But I was hoping for a quick review of the simple libquadmath patch :(

Sorry,
FX