libgfortran.h (support_fpu_underflow_control, [...]): New prototypes.

	* libgfortran.h (support_fpu_underflow_control,
        get_fpu_underflow_mode, set_fpu_underflow_mode): New prototypes.
	* config/fpu-*.h (support_fpu_underflow_control,
	get_fpu_underflow_mode, set_fpu_underflow_mode):
	New functions.
	* ieee/ieee_arithmetic.F90: Support underflow control.

	* gfortran.dg/ieee/underflow_1.f90: New file.

From-SVN: r212407

5 files changed, 160 insertions, 1 deletions

diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h
index 2c5a5fc..201173e 100644
--- a/libgfortran/config/fpu-387.h
+++ b/libgfortran/config/fpu-387.h
@@ -62,6 +62,11 @@ has_sse (void)
 
 #define _FPU_RC_MASK    0x3
 
+/* Enable flush to zero mode.  */
+
+#define MXCSR_FTZ (1 << 15)
+
+
 /* This structure corresponds to the layout of the block
    written by FSTENV.  */
 typedef struct
@@ -82,7 +87,6 @@ typedef struct
 }
 my_fenv_t;
 
-
 /* Check we can actually store the FPU state in the allocated size.  */
 _Static_assert (sizeof(my_fenv_t) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE,
 		"GFC_FPE_STATE_BUFFER_SIZE is too small");
@@ -455,3 +459,47 @@ set_fpu_state (void *state)
     __asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (envp->__mxcsr));
 }
 
+
+int
+support_fpu_underflow_control (int kind)
+{
+  if (!has_sse())
+    return 0;
+
+  return (kind == 4 || kind == 8) ? 1 : 0;
+}
+
+
+int
+get_fpu_underflow_mode (void)
+{
+  unsigned int cw_sse;
+
+  if (!has_sse())
+    return 1;
+
+  __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
+
+  /* Return 0 for abrupt underflow (flush to zero), 1 for gradual underflow.  */
+  return (cw_sse & MXCSR_FTZ) ? 0 : 1;
+}
+
+
+void
+set_fpu_underflow_mode (int gradual)
+{
+  unsigned int cw_sse;
+
+  if (!has_sse())
+    return;
+
+  __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
+
+  if (gradual)
+    cw_sse &= ~MXCSR_FTZ;
+  else
+    cw_sse |= MXCSR_FTZ;
+
+  __asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (cw_sse));
+}
+
diff --git a/libgfortran/config/fpu-aix.h b/libgfortran/config/fpu-aix.h
index c297045..aec7756 100644
--- a/libgfortran/config/fpu-aix.h
+++ b/libgfortran/config/fpu-aix.h
@@ -417,3 +417,23 @@ set_fpu_state (void *state)
   fesetenv (state);
 }
 
+
+int
+support_fpu_underflow_control (int kind __attribute__((unused)))
+{
+  return 0;
+}
+
+
+int
+get_fpu_underflow_mode (void)
+{
+  return 0;
+}
+
+
+void
+set_fpu_underflow_mode (int gradual __attribute__((unused)))
+{
+}
+
diff --git a/libgfortran/config/fpu-generic.h b/libgfortran/config/fpu-generic.h
index bbad875..e739cd7 100644
--- a/libgfortran/config/fpu-generic.h
+++ b/libgfortran/config/fpu-generic.h
@@ -75,3 +75,24 @@ void
 set_fpu_rounding_mode (int round __attribute__((unused)))
 {
 }
+
+
+int
+support_fpu_underflow_control (int kind __attribute__((unused)))
+{
+  return 0;
+}
+
+
+int
+get_fpu_underflow_mode (void)
+{
+  return 0;
+}
+
+
+void
+set_fpu_underflow_mode (int gradual __attribute__((unused)))
+{
+}
+
diff --git a/libgfortran/config/fpu-glibc.h b/libgfortran/config/fpu-glibc.h
index b6ea120..149e8a3 100644
--- a/libgfortran/config/fpu-glibc.h
+++ b/libgfortran/config/fpu-glibc.h
@@ -429,3 +429,53 @@ set_fpu_state (void *state)
   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
+}
+
diff --git a/libgfortran/config/fpu-sysv.h b/libgfortran/config/fpu-sysv.h
index 559e3f3..225f591 100644
--- a/libgfortran/config/fpu-sysv.h
+++ b/libgfortran/config/fpu-sysv.h
@@ -425,3 +425,23 @@ set_fpu_state (void *s)
   fpsetround (state->round);
 }
 
+
+int
+support_fpu_underflow_control (int kind __attribute__((unused)))
+{
+  return 0;
+}
+
+
+int
+get_fpu_underflow_mode (void)
+{
+  return 0;
+}
+
+
+void
+set_fpu_underflow_mode (int gradual __attribute__((unused)))
+{
+}
+