gfortran.h (gfc_real_info): Add subnormal struct member.

* gfortran.h (gfc_real_info): Add subnormal struct member.
* arith.c (gfc_arith_init_1): Set it.
  (gfc_check_real_range): Use it.
* simplify.c (gfc_simplify_nearest): Fix nearest(0.,1.).

From-SVN: r98141

gcc/fortran/ChangeLog

+2005-04-14  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.h (gfc_real_info): Add subnormal struct member.
+	* arith.c (gfc_arith_init_1): Set it.
+	(gfc_check_real_range): Use it.
+	* simplify.c (gfc_simplify_nearest): Fix nearest(0.,1.).
+
 2005-04-12  Kazu Hirata  <kazu@cs.umass.edu>
 
 	* simplify.c: Fix a comment typo.

gcc/fortran/arith.c

@@ -259,6 +259,14 @@ gfc_arith_init_1 (void)
       mpfr_init (real_info->tiny);
       mpfr_set (real_info->tiny, b, GFC_RND_MODE);
 
+      /* subnormal (x) = b**(emin - digit + 1) */
+      mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
+      mpfr_pow_si (b, b, real_info->min_exponent - real_info->digits + 1,
+		   GFC_RND_MODE);
+
+      mpfr_init (real_info->subnormal);
+      mpfr_set (real_info->subnormal, b, GFC_RND_MODE);
+
       /* epsilon(x) = b**(1-p) */
       mpfr_set_ui (b, real_info->radix, GFC_RND_MODE);
       mpfr_pow_si (b, b, 1 - real_info->digits, GFC_RND_MODE);
@@ -374,7 +382,7 @@ gfc_check_real_range (mpfr_t p, int kind)
     retval = ARITH_OK;
   else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0)
       retval = ARITH_OVERFLOW;
-  else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
+  else if (mpfr_cmp (q, gfc_real_kinds[i].subnormal) < 0)
     retval = ARITH_UNDERFLOW;
   else
     retval = ARITH_OK;

gcc/fortran/gfortran.h

@@ -1146,7 +1146,7 @@ extern gfc_logical_info gfc_logical_kinds[];
 
 typedef struct
 {
-  mpfr_t epsilon, huge, tiny;
+  mpfr_t epsilon, huge, tiny, subnormal;
   int kind, radix, digits, min_exponent, max_exponent;
   int range, precision;
 

gcc/fortran/simplify.c

@@ -2293,21 +2293,10 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
 
       if (direction > 0)
 	mpfr_add (result->value.real,
-		  x->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
+		  x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE);
       else
 	mpfr_sub (result->value.real,
-		  x->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
-
-#if 0
-      /* FIXME: This gives an arithmetic error because we compare
-	 against tiny when range-checking.  Also, it doesn't give the
-	 right value.  */
-      /* TINY is the smallest model number, we want the smallest
-	 machine representable number.  Therefore we have to shift the
-	 value to the right by the number of digits - 1.  */
-      mpfr_div_2ui (result->value.real, result->value.real,
-		    gfc_real_kinds[k].precision - 1, GFC_RND_MODE);
-#endif
+		  x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE);
     }
   else
     {