This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch] simplify calculations in simplify.c
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: Patrick Pelissier <Patrick dot Pelissier at loria dot fr>
- Cc: fortran at gcc dot gnu dot org, patch <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 17 Sep 2004 19:01:24 +0200
- Subject: [patch] simplify calculations in simplify.c
- References: <20040907120842.GB26605@latour.loria.fr>
I have implemented Patrick's suggestion for simplifications in simplify.c.
Patrick Pelissier wrote:
> I have seen you use quite often this kind of code in simplify.c:
>
> mpfr_set_ui (i2, 2, GFC_RND_MODE);
> mpfr_log (ln2, i2, GFC_RND_MODE); /* log(2) */
> mpfr_abs (absv, x->value.real, GFC_RND_MODE); /* |x| */
> mpfr_log (lnx, absv, GFC_RND_MODE); /* ln(|x|) */
> mpfr_div (lnx, lnx, ln2, GFC_RND_MODE); /* ln(|x|)/ln(2) */
>
> It may be a good idea to use instead:
>
> mpfr_abs (lnx, x->value.real, GFC_RND_MODE);
> mpfr_log2 (lnx, lnx, GFC_RND_MODE);
>
> It should be faster and more precise to compute the log in base 2 of |x|.
>
When I asked him in private mail if he could verify that I had done this
correctly, he was kind enough to point out a bunch of other possible
simplifications, which I have also included in the patch appended below. While
I was looking through this file I also fixed a few formatting issues.
Compiled and tested with no new regressions. Unfortunately something seems to
be broken in the tree there are about 40 failures, but none related to this
patch. I would appreciate if someone who has a codebase which needs a lot of
constant folding could test this patch.
Thanks Patrick.
- Tobi
2004-09-17 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
*simplify.c (range_check): Remove blank line at beginning of function.
(gfc_simplify_dint): Same at end of function.
(gfc_simplify_exponent, gfc_simplify_fraction): Simplify calculations.
(gfc_simplify_bound): Fix indentation.
(gfc_simplify_log10): Simplify calculation.
(gfc_simplify_min, gfc_simplify_max): Remove blank line at beginning
of function.
(gfc_simplify_nearest): Same at end of function.
(gfc_simplify_nint, gfc_simplify_idnint): Same at beginning of
function.
(gfc_simplify_rrspacing, gfc_simplify_set_exponent,
gfc_simplify_spacing): Simplify calulations.
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.10
diff -c -3 -p -r1.10 simplify.c
*** simplify.c 8 Sep 2004 14:33:02 -0000 1.10
--- simplify.c 17 Sep 2004 15:50:05 -0000
*************** static int xascii_table[256];
*** 98,104 ****
static gfc_expr *
range_check (gfc_expr * result, const char *name)
{
-
if (gfc_range_check (result) == ARITH_OK)
return result;
--- 98,103 ----
*************** gfc_simplify_dint (gfc_expr * e)
*** 386,392 ****
gfc_free_expr (rtrunc);
return range_check (result, "DINT");
-
}
--- 385,390 ----
*************** gfc_simplify_exp (gfc_expr * x)
*** 951,957 ****
gfc_expr *
gfc_simplify_exponent (gfc_expr * x)
{
! mpfr_t i2, absv, ln2, lnx, zero;
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT)
--- 949,955 ----
gfc_expr *
gfc_simplify_exponent (gfc_expr * x)
{
! mpfr_t tmp;
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT)
*************** gfc_simplify_exponent (gfc_expr * x)
*** 961,998 ****
&x->where);
gfc_set_model (x->value.real);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
! if (mpfr_cmp (x->value.real, zero) == 0)
{
mpz_set_ui (result->value.integer, 0);
- mpfr_clear (zero);
return result;
}
! mpfr_init (i2);
! mpfr_init (absv);
! mpfr_init (ln2);
! mpfr_init (lnx);
! mpfr_set_ui (i2, 2, GFC_RND_MODE);
! mpfr_log (ln2, i2, GFC_RND_MODE);
! mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! mpfr_log (lnx, absv, GFC_RND_MODE);
! mpfr_div (lnx, lnx, ln2, GFC_RND_MODE);
! mpfr_trunc (lnx, lnx);
! mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
!
! gfc_mpfr_to_mpz (result->value.integer, lnx);
!
! mpfr_clear (i2);
! mpfr_clear (ln2);
! mpfr_clear (lnx);
! mpfr_clear (absv);
! mpfr_clear (zero);
return range_check (result, "EXPONENT");
}
--- 959,979 ----
&x->where);
gfc_set_model (x->value.real);
! if (mpfr_sgn (x->value.real) == 0)
{
mpz_set_ui (result->value.integer, 0);
return result;
}
! 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);
! mpfr_clear (tmp);
return range_check (result, "EXPONENT");
}
*************** gfc_expr *
*** 1043,1050 ****
gfc_simplify_fraction (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t i2, absv, ln2, lnx, pow2, zero;
! unsigned long exp2;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
--- 1024,1030 ----
gfc_simplify_fraction (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t absv, exp, pow2;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
*************** gfc_simplify_fraction (gfc_expr * x)
*** 1052,1094 ****
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
! if (mpfr_cmp (x->value.real, zero) == 0)
{
! mpfr_set (result->value.real, zero, GFC_RND_MODE);
! mpfr_clear (zero);
return result;
}
! mpfr_init (i2);
mpfr_init (absv);
- mpfr_init (ln2);
- mpfr_init (lnx);
mpfr_init (pow2);
- mpfr_set_ui (i2, 2, GFC_RND_MODE);
-
- mpfr_log (ln2, i2, GFC_RND_MODE);
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! mpfr_log (lnx, absv, GFC_RND_MODE);
! mpfr_div (lnx, lnx, ln2, GFC_RND_MODE);
! mpfr_trunc (lnx, lnx);
! mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
! exp2 = (unsigned long) mpfr_get_d (lnx, GFC_RND_MODE);
! mpfr_pow_ui (pow2, i2, exp2, GFC_RND_MODE);
mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE);
! mpfr_clear (i2);
! mpfr_clear (ln2);
mpfr_clear (absv);
- mpfr_clear (lnx);
mpfr_clear (pow2);
- mpfr_clear (zero);
return range_check (result, "FRACTION");
}
--- 1032,1061 ----
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
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 (exp);
mpfr_init (absv);
mpfr_init (pow2);
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! mpfr_log2 (exp, absv, GFC_RND_MODE);
! mpfr_trunc (exp, exp);
! mpfr_add_ui (exp, exp, 1, GFC_RND_MODE);
! mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE);
! mpfr_clear (exp);
mpfr_clear (absv);
mpfr_clear (pow2);
return range_check (result, "FRACTION");
}
*************** gfc_simplify_bound (gfc_expr * array, gf
*** 1765,1771 ****
int i;
if (array->expr_type != EXPR_VARIABLE)
! return NULL;
if (dim == NULL)
return NULL;
--- 1732,1738 ----
int i;
if (array->expr_type != EXPR_VARIABLE)
! return NULL;
if (dim == NULL)
return NULL;
*************** gfc_expr *
*** 1896,1902 ****
gfc_simplify_log (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t xr, xi, zero;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
--- 1863,1869 ----
gfc_simplify_log (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t xr, xi;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
*************** gfc_simplify_log (gfc_expr * x)
*** 1904,1937 ****
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
switch (x->ts.type)
{
case BT_REAL:
! if (mpfr_cmp (x->value.real, zero) <= 0)
{
gfc_error
("Argument of LOG at %L cannot be less than or equal to zero",
&x->where);
gfc_free_expr (result);
- mpfr_clear (zero);
return &gfc_bad_expr;
}
mpfr_log(result->value.real, x->value.real, GFC_RND_MODE);
- mpfr_clear (zero);
break;
case BT_COMPLEX:
! if ((mpfr_cmp (x->value.complex.r, zero) == 0)
! && (mpfr_cmp (x->value.complex.i, zero) == 0))
{
gfc_error ("Complex argument of LOG at %L cannot be zero",
&x->where);
gfc_free_expr (result);
- mpfr_clear (zero);
return &gfc_bad_expr;
}
--- 1871,1899 ----
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind);
switch (x->ts.type)
{
case BT_REAL:
! if (mpfr_sgn (x->value.real) <= 0)
{
gfc_error
("Argument of LOG at %L cannot be less than or equal to zero",
&x->where);
gfc_free_expr (result);
return &gfc_bad_expr;
}
mpfr_log(result->value.real, x->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
! if ((mpfr_sgn (x->value.complex.r) == 0)
! && (mpfr_sgn (x->value.complex.i) == 0))
{
gfc_error ("Complex argument of LOG at %L cannot be zero",
&x->where);
gfc_free_expr (result);
return &gfc_bad_expr;
}
*************** gfc_simplify_log (gfc_expr * x)
*** 1949,1955 ****
mpfr_clear (xr);
mpfr_clear (xi);
- mpfr_clear (zero);
break;
--- 1911,1916 ----
*************** gfc_expr *
*** 1965,1992 ****
gfc_simplify_log10 (gfc_expr * x)
{
gfc_expr *result;
- mpfr_t zero;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
gfc_set_model_kind (x->ts.kind);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
! if (mpfr_cmp (x->value.real, zero) <= 0)
{
gfc_error
("Argument of LOG10 at %L cannot be less than or equal to zero",
&x->where);
- mpfr_clear (zero);
return &gfc_bad_expr;
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_log10 (result->value.real, x->value.real, GFC_RND_MODE);
- mpfr_clear (zero);
return range_check (result, "LOG10");
}
--- 1926,1948 ----
gfc_simplify_log10 (gfc_expr * x)
{
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
gfc_set_model_kind (x->ts.kind);
! if (mpfr_sgn (x->value.real) <= 0)
{
gfc_error
("Argument of LOG10 at %L cannot be less than or equal to zero",
&x->where);
return &gfc_bad_expr;
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_log10 (result->value.real, x->value.real, GFC_RND_MODE);
return range_check (result, "LOG10");
}
*************** simplify_min_max (gfc_expr * expr, int s
*** 2096,2102 ****
gfc_expr *
gfc_simplify_min (gfc_expr * e)
{
-
return simplify_min_max (e, -1);
}
--- 2052,2057 ----
*************** gfc_simplify_min (gfc_expr * e)
*** 2104,2110 ****
gfc_expr *
gfc_simplify_max (gfc_expr * e)
{
-
return simplify_min_max (e, 1);
}
--- 2059,2064 ----
*************** gfc_simplify_nearest (gfc_expr * x, gfc_
*** 2331,2337 ****
}
return range_check (result, "NEAREST");
-
}
--- 2285,2290 ----
*************** simplify_nint (const char *name, gfc_exp
*** 2386,2392 ****
gfc_expr *
gfc_simplify_nint (gfc_expr * e, gfc_expr * k)
{
-
return simplify_nint ("NINT", e, k);
}
--- 2339,2344 ----
*************** gfc_simplify_nint (gfc_expr * e, gfc_exp
*** 2394,2400 ****
gfc_expr *
gfc_simplify_idnint (gfc_expr * e)
{
-
return simplify_nint ("IDNINT", e, NULL);
}
--- 2346,2351 ----
*************** gfc_expr *
*** 2840,2847 ****
gfc_simplify_rrspacing (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t i2, absv, ln2, lnx, frac, pow2, zero;
! unsigned long exp2;
int i, p;
if (x->expr_type != EXPR_CONSTANT)
--- 2791,2797 ----
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)
*************** gfc_simplify_rrspacing (gfc_expr * x)
*** 2854,2900 ****
p = gfc_real_kinds[i].digits;
gfc_set_model_kind (x->ts.kind);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
! if (mpfr_cmp (x->value.real, zero) == 0)
{
mpfr_ui_div (result->value.real, 1, gfc_real_kinds[i].tiny, GFC_RND_MODE);
- mpfr_clear (zero);
return result;
}
! mpfr_init (i2);
! mpfr_init (ln2);
mpfr_init (absv);
- mpfr_init (lnx);
mpfr_init (frac);
mpfr_init (pow2);
- mpfr_set_ui (i2, 2, GFC_RND_MODE);
-
- mpfr_log (ln2, i2, GFC_RND_MODE);
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! mpfr_log (lnx, absv, GFC_RND_MODE);
! mpfr_div (lnx, lnx, ln2, GFC_RND_MODE);
! mpfr_trunc (lnx, lnx);
! mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
! exp2 = (unsigned long) mpfr_get_d (lnx, GFC_RND_MODE);
! mpfr_pow_ui (pow2, i2, exp2, GFC_RND_MODE);
mpfr_div (frac, absv, pow2, GFC_RND_MODE);
! exp2 = (unsigned long) p;
! mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE);
! mpfr_clear (i2);
! mpfr_clear (ln2);
mpfr_clear (absv);
- mpfr_clear (lnx);
mpfr_clear (frac);
mpfr_clear (pow2);
- mpfr_clear (zero);
return range_check (result, "RRSPACING");
}
--- 2804,2836 ----
p = gfc_real_kinds[i].digits;
gfc_set_model_kind (x->ts.kind);
! if (mpfr_sgn (x->value.real) == 0)
{
mpfr_ui_div (result->value.real, 1, gfc_real_kinds[i].tiny, GFC_RND_MODE);
return result;
}
! mpfr_init (log2);
mpfr_init (absv);
mpfr_init (frac);
mpfr_init (pow2);
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);
return range_check (result, "RRSPACING");
}
*************** gfc_expr *
*** 3103,3109 ****
gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i)
{
gfc_expr *result;
! mpfr_t i2, ln2, absv, lnx, pow2, frac, zero;
unsigned long exp2;
if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT)
--- 3039,3045 ----
gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i)
{
gfc_expr *result;
! mpfr_t exp, absv, log2, pow2, frac;
unsigned long exp2;
if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT)
*************** gfc_simplify_set_exponent (gfc_expr * x,
*** 3112,3147 ****
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
! if (mpfr_cmp (x->value.real, zero) == 0)
{
! mpfr_set (result->value.real, zero, GFC_RND_MODE);
! mpfr_clear (zero);
return result;
}
- mpfr_init (i2);
- mpfr_init (ln2);
mpfr_init (absv);
! mpfr_init (lnx);
mpfr_init (pow2);
mpfr_init (frac);
- mpfr_set_ui (i2, 2, GFC_RND_MODE);
- mpfr_log (ln2, i2, GFC_RND_MODE);
-
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! mpfr_log (lnx, absv, GFC_RND_MODE);
! mpfr_div (lnx, lnx, ln2, GFC_RND_MODE);
! mpfr_trunc (lnx, lnx);
! mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
/* Old exponent value, and fraction. */
! exp2 = (unsigned long) mpfr_get_d (lnx, GFC_RND_MODE);
! mpfr_pow_ui (pow2, i2, exp2, GFC_RND_MODE);
mpfr_div (frac, absv, pow2, GFC_RND_MODE);
--- 3048,3074 ----
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
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 (absv);
! mpfr_init (log2);
! mpfr_init (exp);
mpfr_init (pow2);
mpfr_init (frac);
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);
/* Old exponent value, and fraction. */
! mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
mpfr_div (frac, absv, pow2, GFC_RND_MODE);
*************** gfc_simplify_set_exponent (gfc_expr * x,
*** 3149,3161 ****
exp2 = (unsigned long) mpz_get_d (i->value.integer);
mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE);
- mpfr_clear (i2);
- mpfr_clear (ln2);
mpfr_clear (absv);
! mpfr_clear (lnx);
mpfr_clear (pow2);
mpfr_clear (frac);
- mpfr_clear (zero);
return range_check (result, "SET_EXPONENT");
}
--- 3076,3085 ----
exp2 = (unsigned long) mpz_get_d (i->value.integer);
mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE);
mpfr_clear (absv);
! mpfr_clear (log2);
mpfr_clear (pow2);
mpfr_clear (frac);
return range_check (result, "SET_EXPONENT");
}
*************** gfc_expr *
*** 3359,3367 ****
gfc_simplify_spacing (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t i1, i2, ln2, absv, lnx, zero;
long diff;
- unsigned long exp2;
int i, p;
if (x->expr_type != EXPR_CONSTANT)
--- 3283,3290 ----
gfc_simplify_spacing (gfc_expr * x)
{
gfc_expr *result;
! mpfr_t absv, log2;
long diff;
int i, p;
if (x->expr_type != EXPR_CONSTANT)
*************** gfc_simplify_spacing (gfc_expr * x)
*** 3374,3425 ****
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind);
- mpfr_init (zero);
- mpfr_set_ui (zero, 0, GFC_RND_MODE);
! if (mpfr_cmp (x->value.real, zero) == 0)
{
mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
- mpfr_clear (zero);
return result;
}
! mpfr_init (i1);
! mpfr_init (i2);
! mpfr_init (ln2);
mpfr_init (absv);
- mpfr_init (lnx);
- mpfr_set_ui (i1, 1, GFC_RND_MODE);
- mpfr_set_ui (i2, 2, GFC_RND_MODE);
-
- mpfr_log (ln2, i2, GFC_RND_MODE);
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! mpfr_log (lnx, absv, GFC_RND_MODE);
! mpfr_div (lnx, lnx, ln2, GFC_RND_MODE);
! mpfr_trunc (lnx, lnx);
! mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
! diff = (long) mpfr_get_d (lnx, GFC_RND_MODE) - (long) p;
! if (diff >= 0)
! {
! exp2 = (unsigned) diff;
! mpfr_mul_2exp (result->value.real, i1, exp2, GFC_RND_MODE);
! }
! else
! {
! diff = -diff;
! exp2 = (unsigned) diff;
! mpfr_div_2exp (result->value.real, i1, exp2, GFC_RND_MODE);
! }
! mpfr_clear (i1);
! mpfr_clear (i2);
! mpfr_clear (ln2);
mpfr_clear (absv);
- mpfr_clear (lnx);
- mpfr_clear (zero);
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);
--- 3297,3328 ----
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind);
! if (mpfr_sgn (x->value.real) == 0)
{
mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
return result;
}
! mpfr_init (log2);
mpfr_init (absv);
mpfr_abs (absv, x->value.real, GFC_RND_MODE);
! 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);