* 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.).

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@98141 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bbb7b77..e1b1097 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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.
 2005-04-12  Kazu Hirata  <kazu@cs.umass.edu>
 
        * simplify.c: Fix a comment typo.

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 50e2d06..ef19217 100644 (file)
--- a/gcc/fortran/arith.c
+++ b/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);
 
       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);
       /* 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;
     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;
     retval = ARITH_UNDERFLOW;
   else
     retval = ARITH_OK;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 60a3040..330ceda 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1146,7 +1146,7 @@ extern gfc_logical_info gfc_logical_kinds[];
 
 typedef struct
 {
 
 typedef struct
 {

-  mpfr_t epsilon, huge, tiny;
+  mpfr_t epsilon, huge, tiny, subnormal;

   int kind, radix, digits, min_exponent, max_exponent;
   int range, precision;
 
   int kind, radix, digits, min_exponent, max_exponent;
   int range, precision;
 

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8f9f9e4..fa6c2c6 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/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,
 
       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,
       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
     {
     }
   else
     {