aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/simplify.c
diff options
context:
space:
mode:
authorSteven G. Kargl <kargls@comcast.net>2005-04-09 22:41:35 +0000
committerSteven G. Kargl <kargl@gcc.gnu.org>2005-04-09 22:41:35 +0000
commit8e1fa5d622615b8f32fa657b584cd5523e9c0cce (patch)
tree4fed2a7790843316c3942d5623a1e9f33edb7f93 /gcc/fortran/simplify.c
parent50dd63a96201720c74d336aad9197a0efa019e4d (diff)
downloadgcc-8e1fa5d622615b8f32fa657b584cd5523e9c0cce.zip
gcc-8e1fa5d622615b8f32fa657b584cd5523e9c0cce.tar.gz
gcc-8e1fa5d622615b8f32fa657b584cd5523e9c0cce.tar.bz2
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
Diffstat (limited to 'gcc/fortran/simplify.c')
-rw-r--r--gcc/fortran/simplify.c87
1 files changed, 9 insertions, 78 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index add391f..e4b8916 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -409,9 +409,8 @@ gfc_simplify_dint (gfc_expr * e)
gfc_expr *
gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
{
- gfc_expr *rtrunc, *result;
- int kind, cmp;
- mpfr_t half;
+ gfc_expr *result;
+ int kind;
kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind);
if (kind == -1)
@@ -422,29 +421,7 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
result = gfc_constant_result (e->ts.type, kind, &e->where);
- rtrunc = gfc_copy_expr (e);
-
- 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);
+ mpfr_round (result->value.real, e->value.real);
return range_check (result, "ANINT");
}
@@ -453,39 +430,14 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
gfc_expr *
gfc_simplify_dnint (gfc_expr * e)
{
- gfc_expr *rtrunc, *result;
- int cmp;
- mpfr_t half;
+ gfc_expr *result;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- result =
- gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
-
- rtrunc = gfc_copy_expr (e);
+ result = gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
- cmp = mpfr_cmp_ui (e->value.real, 0);
-
- 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);
+ mpfr_round (result->value.real, e->value.real);
return range_check (result, "DNINT");
}
@@ -2378,9 +2330,8 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
static gfc_expr *
simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
{
- gfc_expr *rtrunc, *itrunc, *result;
- int kind, cmp;
- mpfr_t half;
+ gfc_expr *itrunc, *result;
+ int kind;
kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
if (kind == -1)
@@ -2391,33 +2342,13 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
result = gfc_constant_result (BT_INTEGER, kind, &e->where);
- rtrunc = gfc_copy_expr (e);
itrunc = gfc_copy_expr (e);
- cmp = mpfr_cmp_ui (e->value.real, 0);
-
- 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);
+ mpfr_round(itrunc->value.real, e->value.real);
gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
gfc_free_expr (itrunc);
- gfc_free_expr (rtrunc);
- mpfr_clear (half);
return range_check (result, name);
}