Commit 8e1fa5d6 by Steven G. Kargl Committed by Steven G. Kargl

simplify.c (gfc_simplify_anint): Use mpfr_round()

* simplify.c (gfc_simplify_anint): Use mpfr_round()
(gfc_simplify_dnint): ditto.
(gfc_simplify_nint): ditto.

From-SVN: r97930
parent 50dd63a9
2005-04-09 Steven G. Kargl <kargls@comcast.net>
* simplify.c (gfc_simplify_anint): Use mpfr_round()
(gfc_simplify_dnint): ditto.
(gfc_simplify_nint): ditto.
2005-04-09 Andrew Pinski <pinskia@physics.uc.edu> 2005-04-09 Andrew Pinski <pinskia@physics.uc.edu>
PR fortran/13257 PR fortran/13257
......
...@@ -409,9 +409,8 @@ gfc_simplify_dint (gfc_expr * e) ...@@ -409,9 +409,8 @@ gfc_simplify_dint (gfc_expr * e)
gfc_expr * gfc_expr *
gfc_simplify_anint (gfc_expr * e, gfc_expr * k) gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
{ {
gfc_expr *rtrunc, *result; gfc_expr *result;
int kind, cmp; int kind;
mpfr_t half;
kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind); kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind);
if (kind == -1) if (kind == -1)
...@@ -422,29 +421,7 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k) ...@@ -422,29 +421,7 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
result = gfc_constant_result (e->ts.type, kind, &e->where); result = gfc_constant_result (e->ts.type, kind, &e->where);
rtrunc = gfc_copy_expr (e); mpfr_round (result->value.real, e->value.real);
cmp = mpfr_cmp_ui (e->value.real, 0);
gfc_set_model_kind (kind);
mpfr_init (half);
mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
if (cmp > 0)
{
mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
mpfr_trunc (result->value.real, rtrunc->value.real);
}
else if (cmp < 0)
{
mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
mpfr_trunc (result->value.real, rtrunc->value.real);
}
else
mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
gfc_free_expr (rtrunc);
mpfr_clear (half);
return range_check (result, "ANINT"); return range_check (result, "ANINT");
} }
...@@ -453,39 +430,14 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k) ...@@ -453,39 +430,14 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
gfc_expr * gfc_expr *
gfc_simplify_dnint (gfc_expr * e) gfc_simplify_dnint (gfc_expr * e)
{ {
gfc_expr *rtrunc, *result; gfc_expr *result;
int cmp;
mpfr_t half;
if (e->expr_type != EXPR_CONSTANT) if (e->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = result = gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
rtrunc = gfc_copy_expr (e);
cmp = mpfr_cmp_ui (e->value.real, 0); mpfr_round (result->value.real, e->value.real);
gfc_set_model_kind (gfc_default_double_kind);
mpfr_init (half);
mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
if (cmp > 0)
{
mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
mpfr_trunc (result->value.real, rtrunc->value.real);
}
else if (cmp < 0)
{
mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
mpfr_trunc (result->value.real, rtrunc->value.real);
}
else
mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
gfc_free_expr (rtrunc);
mpfr_clear (half);
return range_check (result, "DNINT"); return range_check (result, "DNINT");
} }
...@@ -2378,9 +2330,8 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s) ...@@ -2378,9 +2330,8 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
static gfc_expr * static gfc_expr *
simplify_nint (const char *name, gfc_expr * e, gfc_expr * k) simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
{ {
gfc_expr *rtrunc, *itrunc, *result; gfc_expr *itrunc, *result;
int kind, cmp; int kind;
mpfr_t half;
kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind); kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
if (kind == -1) if (kind == -1)
...@@ -2391,33 +2342,13 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k) ...@@ -2391,33 +2342,13 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
result = gfc_constant_result (BT_INTEGER, kind, &e->where); result = gfc_constant_result (BT_INTEGER, kind, &e->where);
rtrunc = gfc_copy_expr (e);
itrunc = gfc_copy_expr (e); itrunc = gfc_copy_expr (e);
cmp = mpfr_cmp_ui (e->value.real, 0); mpfr_round(itrunc->value.real, e->value.real);
gfc_set_model (e->value.real);
mpfr_init (half);
mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
if (cmp > 0)
{
mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
mpfr_trunc (itrunc->value.real, rtrunc->value.real);
}
else if (cmp < 0)
{
mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
mpfr_trunc (itrunc->value.real, rtrunc->value.real);
}
else
mpfr_set_ui (itrunc->value.real, 0, GFC_RND_MODE);
gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real); gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
gfc_free_expr (itrunc); gfc_free_expr (itrunc);
gfc_free_expr (rtrunc);
mpfr_clear (half);
return range_check (result, name); return range_check (result, name);
} }
......
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