* 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
+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.
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);
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;
typedef struct
{
- mpfr_t epsilon, huge, tiny;
+ mpfr_t epsilon, huge, tiny, subnormal;
int kind, radix, digits, min_exponent, max_exponent;
int range, precision;
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
{