diff options
author | Steven G. Kargl <kargls@comcast.net> | 2005-04-09 22:41:35 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2005-04-09 22:41:35 +0000 |
commit | 8e1fa5d622615b8f32fa657b584cd5523e9c0cce (patch) | |
tree | 4fed2a7790843316c3942d5623a1e9f33edb7f93 /gcc/fortran/simplify.c | |
parent | 50dd63a96201720c74d336aad9197a0efa019e4d (diff) | |
download | gcc-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.c | 87 |
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); } |