From b814a64ea1fd82823841ba0ac5d2ec6248429828 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 28 Oct 2006 23:31:22 +0000 Subject: gfortran.h: Remove GFC_MPFR_TOO_OLD. 2006-10-27 Steven G. Kargl * gfortran.h: Remove GFC_MPFR_TOO_OLD. * arith.c (arctangent2): Remove function (gfc_check_real_range): Remove subnormal kludge. * arith.h: Remove arctangent2 prototype. * simplify.c: (gfc_simplify_atan2): Remove use of arctangent2. (gfc_simplify_exponent, gfc_simplify_log, gfc_simplify_nearest, gfc_simplify_rrspacing, gfc_simplify_spacing): Remove mpfr kludges. From-SVN: r118120 --- gcc/fortran/ChangeLog | 9 +++ gcc/fortran/arith.c | 77 -------------------- gcc/fortran/arith.h | 6 +- gcc/fortran/gfortran.h | 4 -- gcc/fortran/simplify.c | 190 +------------------------------------------------ 5 files changed, 13 insertions(+), 273 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e5540e0..a4b4014 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2006-10-27 Steven G. Kargl + * gfortran.h: Remove GFC_MPFR_TOO_OLD. + * arith.c (arctangent2): Remove function + (gfc_check_real_range): Remove subnormal kludge. + * arith.h: Remove arctangent2 prototype. + * simplify.c: (gfc_simplify_atan2): Remove use of arctangent2. + (gfc_simplify_exponent, gfc_simplify_log, gfc_simplify_nearest, + gfc_simplify_rrspacing, gfc_simplify_spacing): Remove mpfr kludges. + 2006-10-28 Tobias Burnus PR fortran/28224 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index d4c527f..f130344 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -75,57 +75,6 @@ gfc_set_model (mpfr_t x) mpfr_set_default_prec (mpfr_get_prec (x)); } -#if defined(GFC_MPFR_TOO_OLD) -/* Calculate atan2 (y, x) - -atan2(y, x) = atan(y/x) if x > 0, - sign(y)*(pi - atan(|y/x|)) if x < 0, - 0 if x = 0 && y == 0, - sign(y)*pi/2 if x = 0 && y != 0. -*/ - -void -arctangent2 (mpfr_t y, mpfr_t x, mpfr_t result) -{ - int i; - mpfr_t t; - - gfc_set_model (y); - mpfr_init (t); - - i = mpfr_sgn (x); - - if (i > 0) - { - mpfr_div (t, y, x, GFC_RND_MODE); - mpfr_atan (result, t, GFC_RND_MODE); - } - else if (i < 0) - { - mpfr_const_pi (result, GFC_RND_MODE); - mpfr_div (t, y, x, GFC_RND_MODE); - mpfr_abs (t, t, GFC_RND_MODE); - mpfr_atan (t, t, GFC_RND_MODE); - mpfr_sub (result, result, t, GFC_RND_MODE); - if (mpfr_sgn (y) < 0) - mpfr_neg (result, result, GFC_RND_MODE); - } - else - { - if (mpfr_sgn (y) == 0) - mpfr_set_ui (result, 0, GFC_RND_MODE); - else - { - mpfr_const_pi (result, GFC_RND_MODE); - mpfr_div_ui (result, result, 2, GFC_RND_MODE); - if (mpfr_sgn (y) < 0) - mpfr_neg (result, result, GFC_RND_MODE); - } - } - - mpfr_clear (t); -} -#endif /* Given an arithmetic error code, return a pointer to a string that explains the error. */ @@ -412,31 +361,6 @@ gfc_check_real_range (mpfr_t p, int kind) } else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0) { -#if defined(GFC_MPFR_TOO_OLD) - /* MPFR operates on a number with a given precision and enormous - exponential range. To represent subnormal numbers, the exponent is - allowed to become smaller than emin, but always retains the full - precision. This code resets unused bits to 0 to alleviate - rounding problems. Note, a future version of MPFR will have a - mpfr_subnormalize() function, which handles this truncation in a - more efficient and robust way. */ - - int j, k; - char *bin, *s; - mp_exp_t e; - - bin = mpfr_get_str (NULL, &e, gfc_real_kinds[i].radix, 0, q, GMP_RNDN); - k = gfc_real_kinds[i].digits - (gfc_real_kinds[i].min_exponent - e); - for (j = k; j < gfc_real_kinds[i].digits; j++) - bin[j] = '0'; - /* Need space for '0.', bin, 'E', and e */ - s = (char *) gfc_getmem (strlen(bin) + 10); - sprintf (s, "0.%sE%d", bin, (int) e); - mpfr_set_str (q, s, gfc_real_kinds[i].radix, GMP_RNDN); - - gfc_free (s); - gfc_free (bin); -#else mp_exp_t emin, emax; int en; @@ -453,7 +377,6 @@ gfc_check_real_range (mpfr_t p, int kind) /* Reset emin and emax. */ mpfr_set_emin (emin); mpfr_set_emax (emax); -#endif /* Copy sign if needed. */ if (mpfr_sgn (p) < 0) diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h index b674165..60fd2e0 100644 --- a/gcc/fortran/arith.h +++ b/gcc/fortran/arith.h @@ -25,11 +25,9 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "gfortran.h" -/* MPFR does not have mpfr_atan2(), which needs to return the principle - value of atan2(). MPFR also does not have the conversion of a mpfr_t - to a mpz_t, so declare a function for this as well. */ +/* MPFR also does not have the conversion of a mpfr_t to a mpz_t, so declare + a function for this as well. */ -void arctangent2 (mpfr_t, mpfr_t, mpfr_t); void gfc_mpfr_to_mpz (mpz_t, mpfr_t); void gfc_set_model_kind (int); void gfc_set_model (mpfr_t); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b34d1c2..89d8e2ff 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1224,10 +1224,6 @@ gfc_intrinsic_sym; #include #include #define GFC_RND_MODE GMP_RNDN -#undef GFC_MPFR_TOO_OLD -#if MPFR_VERSION_MAJOR < 2 || (MPFR_VERSION_MAJOR == 2 && MPFR_VERSION_MINOR < 2) -#define GFC_MPFR_TOO_OLD 1 -#endif typedef struct gfc_expr { diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 1b04e6e..75e4c3c 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -607,11 +607,7 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_expr * x) return &gfc_bad_expr; } -#if defined(GFC_MPFR_TOO_OLD) - arctangent2 (y->value.real, x->value.real, result->value.real); -#else mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); -#endif return range_check (result, "ATAN2"); } @@ -1060,10 +1056,6 @@ gfc_simplify_exponent (gfc_expr * x) int i; gfc_expr *result; -#if defined(GFC_MPFR_TOO_OLD) - mpfr_t tmp; -#endif - if (x->expr_type != EXPR_CONSTANT) return NULL; @@ -1078,27 +1070,8 @@ gfc_simplify_exponent (gfc_expr * x) return result; } -#if defined(GFC_MPFR_TOO_OLD) - /* PR fortran/28276 suffers from a buggy MPFR, and this block of code - does not function correctly. */ - mpfr_init (tmp); - - mpfr_abs (tmp, x->value.real, GFC_RND_MODE); - mpfr_log2 (tmp, tmp, GFC_RND_MODE); - - gfc_mpfr_to_mpz (result->value.integer, tmp); - - /* The model number for tiny(x) is b**(emin - 1) where b is the base and emin - is the smallest exponent value. So, we need to add 1 if x is tiny(x). */ - i = gfc_validate_kind (x->ts.type, x->ts.kind, false); - if (mpfr_cmp (x->value.real, gfc_real_kinds[i].tiny) == 0) - mpz_add_ui (result->value.integer,result->value.integer, 1); - - mpfr_clear (tmp); -#else i = (int) mpfr_get_exp (x->value.real); mpz_set_si (result->value.integer, i); -#endif return range_check (result, "EXPONENT"); } @@ -2160,13 +2133,8 @@ gfc_simplify_log (gfc_expr * x) mpfr_init (xr); mpfr_init (xi); -#if defined(GFC_MPFR_TOO_OLD) - arctangent2 (x->value.complex.i, x->value.complex.r, result->value.complex.i); -#else mpfr_atan2 (result->value.complex.i, x->value.complex.i, x->value.complex.r, GFC_RND_MODE); -#endif - mpfr_mul (xr, x->value.complex.r, x->value.complex.r, GFC_RND_MODE); mpfr_mul (xi, x->value.complex.i, x->value.complex.i, GFC_RND_MODE); @@ -2494,9 +2462,6 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) gfc_expr *result; mpfr_t tmp; int sgn; -#if defined(GFC_MPFR_TOO_OLD) - int direction; -#endif if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT) return NULL; @@ -2510,60 +2475,11 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) gfc_set_model_kind (x->ts.kind); result = gfc_copy_expr (x); -#if defined(GFC_MPFR_TOO_OLD) - - direction = mpfr_sgn (s->value.real); - sgn = mpfr_sgn (x->value.real); - - if (sgn == 0) - { - int k = gfc_validate_kind (BT_REAL, x->ts.kind, 0); - - if (direction > 0) - mpfr_add (result->value.real, - x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE); - else - mpfr_sub (result->value.real, - x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE); - } - else - { - if (sgn < 0) - { - direction = -direction; - mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE); - } - - if (direction > 0) - mpfr_add_one_ulp (result->value.real, GFC_RND_MODE); - else - { - /* In this case the exponent can shrink, which makes us skip - over one number because we subtract one ulp with the - larger exponent. Thus we need to compensate for this. */ - mpfr_init_set (tmp, result->value.real, GFC_RND_MODE); - - mpfr_sub_one_ulp (result->value.real, GFC_RND_MODE); - mpfr_add_one_ulp (result->value.real, GFC_RND_MODE); - - /* If we're back to where we started, the spacing is one - ulp, and we get the correct result by subtracting. */ - if (mpfr_cmp (tmp, result->value.real) == 0) - mpfr_sub_one_ulp (result->value.real, GFC_RND_MODE); - - mpfr_clear (tmp); - } - - if (sgn < 0) - mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE); - } -#else sgn = mpfr_sgn (s->value.real); mpfr_init (tmp); mpfr_set_inf (tmp, sgn); mpfr_nexttoward (result->value.real, tmp); mpfr_clear(tmp); -#endif return range_check (result, "NEAREST"); } @@ -3112,57 +3028,6 @@ bad_reshape: } -#if defined(GFC_MPFR_TOO_OLD) -gfc_expr * -gfc_simplify_rrspacing (gfc_expr * x) -{ - gfc_expr *result; - mpfr_t absv, log2, exp, frac, pow2; - int i, p; - - if (x->expr_type != EXPR_CONSTANT) - return NULL; - - i = gfc_validate_kind (x->ts.type, x->ts.kind, false); - - result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); - - p = gfc_real_kinds[i].digits; - - gfc_set_model_kind (x->ts.kind); - - if (mpfr_sgn (x->value.real) == 0) - { - mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); - return result; - } - - mpfr_init (log2); - mpfr_init (absv); - mpfr_init (frac); - mpfr_init (pow2); - mpfr_init (exp); - - mpfr_abs (absv, x->value.real, GFC_RND_MODE); - mpfr_log2 (log2, absv, GFC_RND_MODE); - - mpfr_trunc (log2, log2); - mpfr_add_ui (exp, log2, 1, GFC_RND_MODE); - - mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE); - mpfr_div (frac, absv, pow2, GFC_RND_MODE); - - mpfr_mul_2exp (result->value.real, frac, (unsigned long)p, GFC_RND_MODE); - - mpfr_clear (log2); - mpfr_clear (absv); - mpfr_clear (frac); - mpfr_clear (pow2); - mpfr_clear (exp); - - return range_check (result, "RRSPACING"); -} -#else gfc_expr * gfc_simplify_rrspacing (gfc_expr * x) { @@ -3195,7 +3060,7 @@ gfc_simplify_rrspacing (gfc_expr * x) return range_check (result, "RRSPACING"); } -#endif + gfc_expr * gfc_simplify_scale (gfc_expr * x, gfc_expr * i) @@ -3639,58 +3504,7 @@ gfc_simplify_sngl (gfc_expr * a) return range_check (result, "SNGL"); } -#if defined(GFC_MPFR_TOO_OLD) -gfc_expr * -gfc_simplify_spacing (gfc_expr * x) -{ - gfc_expr *result; - mpfr_t absv, log2; - long diff; - int i, p; - - if (x->expr_type != EXPR_CONSTANT) - return NULL; - - i = gfc_validate_kind (x->ts.type, x->ts.kind, false); - p = gfc_real_kinds[i].digits; - - result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); - - gfc_set_model_kind (x->ts.kind); - - /* Special case x = 0 and -0. */ - mpfr_init (absv); - mpfr_abs (absv, x->value.real, GFC_RND_MODE); - if (mpfr_sgn (absv) == 0) - { - mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE); - return result; - } - - mpfr_init (log2); - mpfr_log2 (log2, absv, GFC_RND_MODE); - mpfr_trunc (log2, log2); - - mpfr_add_ui (log2, log2, 1, GFC_RND_MODE); - - /* FIXME: We should be using mpfr_get_si here, but this function is - not available with the version of mpfr distributed with gmp (as of - 2004-09-17). Replace once mpfr has been imported into the gcc cvs - tree. */ - diff = (long)mpfr_get_d (log2, GFC_RND_MODE) - (long)p; - mpfr_set_ui (result->value.real, 1, GFC_RND_MODE); - mpfr_mul_2si (result->value.real, result->value.real, diff, GFC_RND_MODE); - - mpfr_clear (log2); - mpfr_clear (absv); - - if (mpfr_cmp (result->value.real, gfc_real_kinds[i].tiny) < 0) - mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE); - - return range_check (result, "SPACING"); -} -#else gfc_expr * gfc_simplify_spacing (gfc_expr * x) { @@ -3727,7 +3541,7 @@ gfc_simplify_spacing (gfc_expr * x) return range_check (result, "SPACING"); } -#endif + gfc_expr * gfc_simplify_sqrt (gfc_expr * e) -- cgit v1.1