Skip to content

R
riscv-gcc-1
Commit 03ddaf35 by Tobias Schlüter Committed by Paul Brook
Options

simplify.c (range_check): Remove blank line at beginning of function. 

2004-10-03  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.

From-SVN: r88447
parent 046dcd57
Showing with 70 additions and 152 deletions
gcc/fortran/ChangeLog
2004-10-03 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.
2004-10-03 Feng Wang <fengwang@nudt.edu.cn> 2004-10-03 Feng Wang <fengwang@nudt.edu.cn>
* trans-intrinsic.c: Fix comments on spacing and rrspacing * trans-intrinsic.c: Fix comments on spacing and rrspacing
......
gcc/fortran/simplify.c
...@@ -98,7 +98,6 @@ static int xascii_table[256]; ...@@ -98,7 +98,6 @@ static int xascii_table[256];
static gfc_expr * static gfc_expr *
range_check (gfc_expr * result, const char *name) range_check (gfc_expr * result, const char *name)
{ {
if (gfc_range_check (result) == ARITH_OK) if (gfc_range_check (result) == ARITH_OK)
return result; return result;
...@@ -386,7 +385,6 @@ gfc_simplify_dint (gfc_expr * e) ...@@ -386,7 +385,6 @@ gfc_simplify_dint (gfc_expr * e)
gfc_free_expr (rtrunc); gfc_free_expr (rtrunc);
return range_check (result, "DINT"); return range_check (result, "DINT");
} }
...@@ -951,7 +949,7 @@ gfc_simplify_exp (gfc_expr * x) ...@@ -951,7 +949,7 @@ gfc_simplify_exp (gfc_expr * x)
gfc_expr * gfc_expr *
gfc_simplify_exponent (gfc_expr * x) gfc_simplify_exponent (gfc_expr * x)
{ {
mpfr_t i2, absv, ln2, lnx, zero; mpfr_t tmp;
gfc_expr *result; gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
...@@ -961,38 +959,21 @@ gfc_simplify_exponent (gfc_expr * x) ...@@ -961,38 +959,21 @@ gfc_simplify_exponent (gfc_expr * x)
&x->where); &x->where);
gfc_set_model (x->value.real); 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) if (mpfr_sgn (x->value.real) == 0)
{ {
mpz_set_ui (result->value.integer, 0); mpz_set_ui (result->value.integer, 0);
mpfr_clear (zero);
return result; return result;
} }
mpfr_init (i2); mpfr_init (tmp);
mpfr_init (absv);
mpfr_init (ln2);
mpfr_init (lnx);
mpfr_set_ui (i2, 2, GFC_RND_MODE); mpfr_abs (tmp, x->value.real, GFC_RND_MODE);
mpfr_log2 (tmp, tmp, GFC_RND_MODE);
mpfr_log (ln2, i2, GFC_RND_MODE); gfc_mpfr_to_mpz (result->value.integer, tmp);
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_clear (tmp);
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"); return range_check (result, "EXPONENT");
} }
...@@ -1043,8 +1024,7 @@ gfc_expr * ...@@ -1043,8 +1024,7 @@ gfc_expr *
gfc_simplify_fraction (gfc_expr * x) gfc_simplify_fraction (gfc_expr * x)
{ {
gfc_expr *result; gfc_expr *result;
mpfr_t i2, absv, ln2, lnx, pow2, zero; mpfr_t absv, exp, pow2;
unsigned long exp2;
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
...@@ -1052,43 +1032,30 @@ gfc_simplify_fraction (gfc_expr * x) ...@@ -1052,43 +1032,30 @@ gfc_simplify_fraction (gfc_expr * x)
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind); 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) if (mpfr_sgn (x->value.real) == 0)
{ {
mpfr_set (result->value.real, zero, GFC_RND_MODE); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
mpfr_clear (zero);
return result; return result;
} }
mpfr_init (i2); mpfr_init (exp);
mpfr_init (absv); mpfr_init (absv);
mpfr_init (ln2);
mpfr_init (lnx);
mpfr_init (pow2); 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_abs (absv, x->value.real, GFC_RND_MODE);
mpfr_log (lnx, absv, GFC_RND_MODE); mpfr_log2 (exp, absv, GFC_RND_MODE);
mpfr_div (lnx, lnx, ln2, GFC_RND_MODE); mpfr_trunc (exp, exp);
mpfr_trunc (lnx, lnx); mpfr_add_ui (exp, exp, 1, GFC_RND_MODE);
mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
exp2 = (unsigned long) mpfr_get_d (lnx, GFC_RND_MODE); mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
mpfr_pow_ui (pow2, i2, exp2, GFC_RND_MODE);
mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE); mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE);
mpfr_clear (i2); mpfr_clear (exp);
mpfr_clear (ln2);
mpfr_clear (absv); mpfr_clear (absv);
mpfr_clear (lnx);
mpfr_clear (pow2); mpfr_clear (pow2);
mpfr_clear (zero);
return range_check (result, "FRACTION"); return range_check (result, "FRACTION");
} }
...@@ -1765,7 +1732,7 @@ gfc_simplify_bound (gfc_expr * array, gfc_expr * dim, int upper) ...@@ -1765,7 +1732,7 @@ gfc_simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
int i; int i;
if (array->expr_type != EXPR_VARIABLE) if (array->expr_type != EXPR_VARIABLE)
return NULL; return NULL;
if (dim == NULL) if (dim == NULL)
return NULL; return NULL;
...@@ -1896,7 +1863,7 @@ gfc_expr * ...@@ -1896,7 +1863,7 @@ gfc_expr *
gfc_simplify_log (gfc_expr * x) gfc_simplify_log (gfc_expr * x)
{ {
gfc_expr *result; gfc_expr *result;
mpfr_t xr, xi, zero; mpfr_t xr, xi;
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
...@@ -1904,34 +1871,29 @@ gfc_simplify_log (gfc_expr * x) ...@@ -1904,34 +1871,29 @@ gfc_simplify_log (gfc_expr * x)
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind); gfc_set_model_kind (x->ts.kind);
mpfr_init (zero);
mpfr_set_ui (zero, 0, GFC_RND_MODE);
switch (x->ts.type) switch (x->ts.type)
{ {
case BT_REAL: case BT_REAL:
if (mpfr_cmp (x->value.real, zero) <= 0) if (mpfr_sgn (x->value.real) <= 0)
{ {
gfc_error gfc_error
("Argument of LOG at %L cannot be less than or equal to zero", ("Argument of LOG at %L cannot be less than or equal to zero",
&x->where); &x->where);
gfc_free_expr (result); gfc_free_expr (result);
mpfr_clear (zero);
return &gfc_bad_expr; return &gfc_bad_expr;
} }
mpfr_log(result->value.real, x->value.real, GFC_RND_MODE); mpfr_log(result->value.real, x->value.real, GFC_RND_MODE);
mpfr_clear (zero);
break; break;
case BT_COMPLEX: case BT_COMPLEX:
if ((mpfr_cmp (x->value.complex.r, zero) == 0) if ((mpfr_sgn (x->value.complex.r) == 0)
&& (mpfr_cmp (x->value.complex.i, zero) == 0)) && (mpfr_sgn (x->value.complex.i) == 0))
{ {
gfc_error ("Complex argument of LOG at %L cannot be zero", gfc_error ("Complex argument of LOG at %L cannot be zero",
&x->where); &x->where);
gfc_free_expr (result); gfc_free_expr (result);
mpfr_clear (zero);
return &gfc_bad_expr; return &gfc_bad_expr;
} }
...@@ -1949,7 +1911,6 @@ gfc_simplify_log (gfc_expr * x) ...@@ -1949,7 +1911,6 @@ gfc_simplify_log (gfc_expr * x)
mpfr_clear (xr); mpfr_clear (xr);
mpfr_clear (xi); mpfr_clear (xi);
mpfr_clear (zero);
break; break;
...@@ -1965,28 +1926,23 @@ gfc_expr * ...@@ -1965,28 +1926,23 @@ gfc_expr *
gfc_simplify_log10 (gfc_expr * x) gfc_simplify_log10 (gfc_expr * x)
{ {
gfc_expr *result; gfc_expr *result;
mpfr_t zero;
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
gfc_set_model_kind (x->ts.kind); 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) if (mpfr_sgn (x->value.real) <= 0)
{ {
gfc_error gfc_error
("Argument of LOG10 at %L cannot be less than or equal to zero", ("Argument of LOG10 at %L cannot be less than or equal to zero",
&x->where); &x->where);
mpfr_clear (zero);
return &gfc_bad_expr; return &gfc_bad_expr;
} }
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
mpfr_log10 (result->value.real, x->value.real, GFC_RND_MODE); mpfr_log10 (result->value.real, x->value.real, GFC_RND_MODE);
mpfr_clear (zero);
return range_check (result, "LOG10"); return range_check (result, "LOG10");
} }
...@@ -2096,7 +2052,6 @@ simplify_min_max (gfc_expr * expr, int sign) ...@@ -2096,7 +2052,6 @@ simplify_min_max (gfc_expr * expr, int sign)
gfc_expr * gfc_expr *
gfc_simplify_min (gfc_expr * e) gfc_simplify_min (gfc_expr * e)
{ {
return simplify_min_max (e, -1); return simplify_min_max (e, -1);
} }
...@@ -2104,7 +2059,6 @@ gfc_simplify_min (gfc_expr * e) ...@@ -2104,7 +2059,6 @@ gfc_simplify_min (gfc_expr * e)
gfc_expr * gfc_expr *
gfc_simplify_max (gfc_expr * e) gfc_simplify_max (gfc_expr * e)
{ {
return simplify_min_max (e, 1); return simplify_min_max (e, 1);
} }
...@@ -2331,7 +2285,6 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) ...@@ -2331,7 +2285,6 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
} }
return range_check (result, "NEAREST"); return range_check (result, "NEAREST");
} }
...@@ -2386,7 +2339,6 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k) ...@@ -2386,7 +2339,6 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
gfc_expr * gfc_expr *
gfc_simplify_nint (gfc_expr * e, gfc_expr * k) gfc_simplify_nint (gfc_expr * e, gfc_expr * k)
{ {
return simplify_nint ("NINT", e, k); return simplify_nint ("NINT", e, k);
} }
...@@ -2394,7 +2346,6 @@ gfc_simplify_nint (gfc_expr * e, gfc_expr * k) ...@@ -2394,7 +2346,6 @@ gfc_simplify_nint (gfc_expr * e, gfc_expr * k)
gfc_expr * gfc_expr *
gfc_simplify_idnint (gfc_expr * e) gfc_simplify_idnint (gfc_expr * e)
{ {
return simplify_nint ("IDNINT", e, NULL); return simplify_nint ("IDNINT", e, NULL);
} }
...@@ -2840,8 +2791,7 @@ gfc_expr * ...@@ -2840,8 +2791,7 @@ gfc_expr *
gfc_simplify_rrspacing (gfc_expr * x) gfc_simplify_rrspacing (gfc_expr * x)
{ {
gfc_expr *result; gfc_expr *result;
mpfr_t i2, absv, ln2, lnx, frac, pow2, zero; mpfr_t absv, log2, exp, frac, pow2;
unsigned long exp2;
int i, p; int i, p;
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
...@@ -2854,47 +2804,33 @@ gfc_simplify_rrspacing (gfc_expr * x) ...@@ -2854,47 +2804,33 @@ gfc_simplify_rrspacing (gfc_expr * x)
p = gfc_real_kinds[i].digits; p = gfc_real_kinds[i].digits;
gfc_set_model_kind (x->ts.kind); 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) if (mpfr_sgn (x->value.real) == 0)
{ {
mpfr_ui_div (result->value.real, 1, gfc_real_kinds[i].tiny, GFC_RND_MODE); mpfr_ui_div (result->value.real, 1, gfc_real_kinds[i].tiny, GFC_RND_MODE);
mpfr_clear (zero);
return result; return result;
} }
mpfr_init (i2); mpfr_init (log2);
mpfr_init (ln2);
mpfr_init (absv); mpfr_init (absv);
mpfr_init (lnx);
mpfr_init (frac); mpfr_init (frac);
mpfr_init (pow2); 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_abs (absv, x->value.real, GFC_RND_MODE);
mpfr_log (lnx, absv, GFC_RND_MODE); mpfr_log2 (log2, absv, GFC_RND_MODE);
mpfr_div (lnx, lnx, ln2, GFC_RND_MODE); mpfr_trunc (log2, log2);
mpfr_trunc (lnx, lnx); mpfr_add_ui (exp, log2, 1, GFC_RND_MODE);
mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
exp2 = (unsigned long) mpfr_get_d (lnx, GFC_RND_MODE); mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
mpfr_pow_ui (pow2, i2, exp2, GFC_RND_MODE);
mpfr_div (frac, absv, pow2, GFC_RND_MODE); mpfr_div (frac, absv, pow2, GFC_RND_MODE);
exp2 = (unsigned long) p; mpfr_mul_2exp (result->value.real, frac, (unsigned long)p, GFC_RND_MODE);
mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE);
mpfr_clear (i2); mpfr_clear (log2);
mpfr_clear (ln2);
mpfr_clear (absv); mpfr_clear (absv);
mpfr_clear (lnx);
mpfr_clear (frac); mpfr_clear (frac);
mpfr_clear (pow2); mpfr_clear (pow2);
mpfr_clear (zero);
return range_check (result, "RRSPACING"); return range_check (result, "RRSPACING");
} }
...@@ -3103,7 +3039,7 @@ gfc_expr * ...@@ -3103,7 +3039,7 @@ gfc_expr *
gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i) gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i)
{ {
gfc_expr *result; gfc_expr *result;
mpfr_t i2, ln2, absv, lnx, pow2, frac, zero; mpfr_t exp, absv, log2, pow2, frac;
unsigned long exp2; unsigned long exp2;
if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT)
...@@ -3112,36 +3048,27 @@ gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i) ...@@ -3112,36 +3048,27 @@ gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i)
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind); 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) if (mpfr_sgn (x->value.real) == 0)
{ {
mpfr_set (result->value.real, zero, GFC_RND_MODE); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
mpfr_clear (zero);
return result; return result;
} }
mpfr_init (i2);
mpfr_init (ln2);
mpfr_init (absv); mpfr_init (absv);
mpfr_init (lnx); mpfr_init (log2);
mpfr_init (exp);
mpfr_init (pow2); mpfr_init (pow2);
mpfr_init (frac); 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_abs (absv, x->value.real, GFC_RND_MODE);
mpfr_log (lnx, absv, GFC_RND_MODE); mpfr_log2 (log2, absv, GFC_RND_MODE);
mpfr_div (lnx, lnx, ln2, GFC_RND_MODE); mpfr_trunc (log2, log2);
mpfr_trunc (lnx, lnx); mpfr_add_ui (exp, log2, 1, GFC_RND_MODE);
mpfr_add_ui (lnx, lnx, 1, GFC_RND_MODE);
/* Old exponent value, and fraction. */ /* Old exponent value, and fraction. */
exp2 = (unsigned long) mpfr_get_d (lnx, GFC_RND_MODE); mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
mpfr_pow_ui (pow2, i2, exp2, GFC_RND_MODE);
mpfr_div (frac, absv, pow2, GFC_RND_MODE); mpfr_div (frac, absv, pow2, GFC_RND_MODE);
...@@ -3149,13 +3076,10 @@ gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i) ...@@ -3149,13 +3076,10 @@ gfc_simplify_set_exponent (gfc_expr * x, gfc_expr * i)
exp2 = (unsigned long) mpz_get_d (i->value.integer); exp2 = (unsigned long) mpz_get_d (i->value.integer);
mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE);
mpfr_clear (i2);
mpfr_clear (ln2);
mpfr_clear (absv); mpfr_clear (absv);
mpfr_clear (lnx); mpfr_clear (log2);
mpfr_clear (pow2); mpfr_clear (pow2);
mpfr_clear (frac); mpfr_clear (frac);
mpfr_clear (zero);
return range_check (result, "SET_EXPONENT"); return range_check (result, "SET_EXPONENT");
} }
...@@ -3359,9 +3283,8 @@ gfc_expr * ...@@ -3359,9 +3283,8 @@ gfc_expr *
gfc_simplify_spacing (gfc_expr * x) gfc_simplify_spacing (gfc_expr * x)
{ {
gfc_expr *result; gfc_expr *result;
mpfr_t i1, i2, ln2, absv, lnx, zero; mpfr_t absv, log2;
long diff; long diff;
unsigned long exp2;
int i, p; int i, p;
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
...@@ -3374,52 +3297,32 @@ gfc_simplify_spacing (gfc_expr * x) ...@@ -3374,52 +3297,32 @@ gfc_simplify_spacing (gfc_expr * x)
result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where);
gfc_set_model_kind (x->ts.kind); 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) if (mpfr_sgn (x->value.real) == 0)
{ {
mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE); mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
mpfr_clear (zero);
return result; return result;
} }
mpfr_init (i1); mpfr_init (log2);
mpfr_init (i2);
mpfr_init (ln2);
mpfr_init (absv); 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_abs (absv, x->value.real, GFC_RND_MODE);
mpfr_log (lnx, absv, GFC_RND_MODE); mpfr_log2 (log2, absv, GFC_RND_MODE);
mpfr_trunc (log2, log2);
mpfr_div (lnx, lnx, ln2, GFC_RND_MODE); mpfr_add_ui (log2, log2, 1, 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; /* FIXME: We should be using mpfr_get_si here, but this function is
if (diff >= 0) 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
exp2 = (unsigned) diff; tree. */
mpfr_mul_2exp (result->value.real, i1, exp2, GFC_RND_MODE); diff = (long)mpfr_get_d (log2, GFC_RND_MODE) - (long)p;
} mpfr_set_ui (result->value.real, 1, GFC_RND_MODE);
else mpfr_mul_2si (result->value.real, result->value.real, diff, GFC_RND_MODE);
{
diff = -diff;
exp2 = (unsigned) diff;
mpfr_div_2exp (result->value.real, i1, exp2, GFC_RND_MODE);
}
mpfr_clear (i1); mpfr_clear (log2);
mpfr_clear (i2);
mpfr_clear (ln2);
mpfr_clear (absv); mpfr_clear (absv);
mpfr_clear (lnx);
mpfr_clear (zero);
if (mpfr_cmp (result->value.real, gfc_real_kinds[i].tiny) < 0) 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); mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment