From 463f9a1662769c8e42cfb6b54966ea75fef120cd Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Sat, 31 May 2008 19:19:48 +0000 Subject: [PATCH] 2008-05-31 Steven G. Kargl * arith.c (gfc_arith_init_1): Remove now unused r and c variables. Cleanup numerical inquiry function initialization. (gfc_arith_done_1): Replace multiple mpfr_clear() invocations with a single mpfr_clears(). (gfc_check_real_range): Re-arrange logic to eliminate multiple unnecessary branching and assignments. (gfc_arith_times): Use mpfr_clears() in preference to multiple mpfr_clear(). (gfc_arith_divide): Ditto. (complex_reciprocal): Eliminate now unused variables a, re, im. Cleanup the mpfr abuse. Use mpfr_clears() in preference to multiple mpfr_clear(). (complex_pow): Fix comment whitespace. Use mpfr_clears() in preference to multiple mpfr_clear(). * simplify.c (gfc_simplify_and): Remove blank line. (gfc_simplify_atan2): Move error checking earlier to eliminate a now unnecessay gfc_free_expr(). (gfc_simplify_bessel_j0): Remove unnecessary gfc_set_model_kind(). (gfc_simplify_bessel_j1): Ditto. (gfc_simplify_bessel_jn): Ditto. (gfc_simplify_bessel_y0): Ditto. (gfc_simplify_bessel_y1): Ditto. (gfc_simplify_bessel_yn): Ditto. (only_convert_cmplx_boz): Eliminate unnecessary duplicate code, and combine nested if statement rational expressions. (gfc_simplify_cos): Use mpfr_clears() in preference to multiple mpfr_clear(). (gfc_simplify_exp): Ditto. (gfc_simplify_fraction): Move gfc_set_model_kind() to after the special case of 0. Use mpfr_clears() in preference to multiple mpfr_clear(). (gfc_simplify_gamma): Eliminate unnecessary gfc_set_model_kind(). (gfc_simplify_lgamma): Ditto. (gfc_simplify_log10): Ditto. (gfc_simplify_log): Move gfc_set_model_kind () inside switch statement. Use mpfr_clears() in preference to multiple mpfr_clear(). (gfc_simplify_mod): Eliminate now unused variables quot, iquot, and term. Simplify the mpfr magic. (gfc_simplify_modulo): Ditto. (gfc_simplify_nearest): Eliminate unnecessary gfc_set_model_kind(). (gfc_simplify_scale): Use mpfr_clears() in preference to multiple mpfr_clear(). (gfc_simplify_sin): Ditto (gfc_simplify_sqrt): Ditto (gfc_simplify_set_exponent): Move gfc_set_model_kind() to after the special case of 0. Use mpfr_clears() in preference to multiple mpfr_clear(). git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@136239 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 50 +++++++++++++++ gcc/fortran/arith.c | 153 ++++++++++++++++----------------------------- gcc/fortran/intrinsic.texi | 39 ++++++++++++ gcc/fortran/simplify.c | 124 +++++++++++------------------------- 4 files changed, 179 insertions(+), 187 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5a8eb14..02861b6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,53 @@ +2008-05-31 Steven G. Kargl + + * arith.c (gfc_arith_init_1): Remove now unused r and c variables. + Cleanup numerical inquiry function initialization. + (gfc_arith_done_1): Replace multiple mpfr_clear() invocations with + a single mpfr_clears(). + (gfc_check_real_range): Re-arrange logic to eliminate multiple + unnecessary branching and assignments. + (gfc_arith_times): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_arith_divide): Ditto. + (complex_reciprocal): Eliminate now unused variables a, re, im. + Cleanup the mpfr abuse. Use mpfr_clears() in preference to + multiple mpfr_clear(). + (complex_pow): Fix comment whitespace. Use mpfr_clears() in + preference to multiple mpfr_clear(). + * simplify.c (gfc_simplify_and): Remove blank line. + (gfc_simplify_atan2): Move error checking earlier to eliminate + a now unnecessay gfc_free_expr(). + (gfc_simplify_bessel_j0): Remove unnecessary gfc_set_model_kind(). + (gfc_simplify_bessel_j1): Ditto. + (gfc_simplify_bessel_jn): Ditto. + (gfc_simplify_bessel_y0): Ditto. + (gfc_simplify_bessel_y1): Ditto. + (gfc_simplify_bessel_yn): Ditto. + (only_convert_cmplx_boz): Eliminate unnecessary duplicate code, and + combine nested if statement rational expressions. + (gfc_simplify_cos): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_exp): Ditto. + (gfc_simplify_fraction): Move gfc_set_model_kind() to after the + special case of 0. Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_gamma): Eliminate unnecessary gfc_set_model_kind(). + (gfc_simplify_lgamma): Ditto. + (gfc_simplify_log10): Ditto. + (gfc_simplify_log): Move gfc_set_model_kind () inside switch + statement. Use mpfr_clears() in preference to multiple mpfr_clear(). + (gfc_simplify_mod): Eliminate now unused variables quot, iquot, + and term. Simplify the mpfr magic. + (gfc_simplify_modulo): Ditto. + (gfc_simplify_nearest): Eliminate unnecessary gfc_set_model_kind(). + (gfc_simplify_scale): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_sin): Ditto + (gfc_simplify_sqrt): Ditto + (gfc_simplify_set_exponent): Move gfc_set_model_kind() to after the + special case of 0. Use mpfr_clears() in preference to multiple + mpfr_clear(). + 2008-05-29 Daniel Franke PR target/36348 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 6e09f8a..8e6de30 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -123,24 +123,21 @@ gfc_arith_init_1 (void) { gfc_integer_info *int_info; gfc_real_info *real_info; - mpfr_t a, b, c; - mpz_t r; + mpfr_t a, b; int i; mpfr_set_default_prec (128); mpfr_init (a); - mpz_init (r); /* Convert the minimum and maximum values for each kind into their GNU MP representation. */ for (int_info = gfc_integer_kinds; int_info->kind != 0; int_info++) { /* Huge */ - mpz_set_ui (r, int_info->radix); - mpz_pow_ui (r, r, int_info->digits); - mpz_init (int_info->huge); - mpz_sub_ui (int_info->huge, r, 1); + mpz_set_ui (int_info->huge, int_info->radix); + mpz_pow_ui (int_info->huge, int_info->huge, int_info->digits); + mpz_sub_ui (int_info->huge, int_info->huge, 1); /* These are the numbers that are actually representable by the target. For bases other than two, this needs to be changed. */ @@ -164,8 +161,7 @@ gfc_arith_init_1 (void) mpfr_set_z (a, int_info->huge, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); mpfr_trunc (a, a); - gfc_mpfr_to_mpz (r, a); - int_info->range = mpz_get_si (r); + int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE); } mpfr_clear (a); @@ -176,49 +172,43 @@ gfc_arith_init_1 (void) mpfr_init (a); mpfr_init (b); - mpfr_init (c); /* huge(x) = (1 - b**(-p)) * b**(emax-1) * b */ - /* a = 1 - b**(-p) */ - mpfr_set_ui (a, 1, GFC_RND_MODE); - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, -real_info->digits, GFC_RND_MODE); - mpfr_sub (a, a, b, GFC_RND_MODE); - - /* c = b**(emax-1) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_ui (c, b, real_info->max_exponent - 1, GFC_RND_MODE); + /* 1 - b**(-p) */ + mpfr_init (real_info->huge); + mpfr_set_ui (real_info->huge, 1, GFC_RND_MODE); + mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (a, a, -real_info->digits, GFC_RND_MODE); + mpfr_sub (real_info->huge, real_info->huge, a, GFC_RND_MODE); - /* a = a * c = (1 - b**(-p)) * b**(emax-1) */ - mpfr_mul (a, a, c, GFC_RND_MODE); + /* b**(emax-1) */ + mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); + mpfr_pow_ui (a, a, real_info->max_exponent - 1, GFC_RND_MODE); - /* a = (1 - b**(-p)) * b**(emax-1) * b */ - mpfr_mul_ui (a, a, real_info->radix, GFC_RND_MODE); + /* (1 - b**(-p)) * b**(emax-1) */ + mpfr_mul (real_info->huge, real_info->huge, a, GFC_RND_MODE); - mpfr_init (real_info->huge); - mpfr_set (real_info->huge, a, GFC_RND_MODE); + /* (1 - b**(-p)) * b**(emax-1) * b */ + mpfr_mul_ui (real_info->huge, real_info->huge, real_info->radix, + GFC_RND_MODE); /* tiny(x) = b**(emin-1) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, real_info->min_exponent - 1, GFC_RND_MODE); - mpfr_init (real_info->tiny); - mpfr_set (real_info->tiny, b, GFC_RND_MODE); + mpfr_set_ui (real_info->tiny, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (real_info->tiny, real_info->tiny, + real_info->min_exponent - 1, GFC_RND_MODE); /* subnormal (x) = b**(emin - digit) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, real_info->min_exponent - real_info->digits, - GFC_RND_MODE); - mpfr_init (real_info->subnormal); - mpfr_set (real_info->subnormal, b, GFC_RND_MODE); + mpfr_set_ui (real_info->subnormal, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (real_info->subnormal, real_info->subnormal, + real_info->min_exponent - real_info->digits, GFC_RND_MODE); /* epsilon(x) = b**(1-p) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, 1 - real_info->digits, GFC_RND_MODE); - mpfr_init (real_info->epsilon); - mpfr_set (real_info->epsilon, b, GFC_RND_MODE); + mpfr_set_ui (real_info->epsilon, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (real_info->epsilon, real_info->epsilon, + 1 - real_info->digits, GFC_RND_MODE); /* range(x) = int(min(log10(huge(x)), -log10(tiny)) */ mpfr_log10 (a, real_info->huge, GFC_RND_MODE); @@ -227,31 +217,23 @@ gfc_arith_init_1 (void) /* a = min(a, b) */ mpfr_min (a, a, b, GFC_RND_MODE); - mpfr_trunc (a, a); - gfc_mpfr_to_mpz (r, a); - real_info->range = mpz_get_si (r); + real_info->range = (int) mpfr_get_si (a, GFC_RND_MODE); /* precision(x) = int((p - 1) * log10(b)) + k */ mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); - mpfr_mul_ui (a, a, real_info->digits - 1, GFC_RND_MODE); mpfr_trunc (a, a); - gfc_mpfr_to_mpz (r, a); - real_info->precision = mpz_get_si (r); + real_info->precision = (int) mpfr_get_si (a, GFC_RND_MODE); /* If the radix is an integral power of 10, add one to the precision. */ for (i = 10; i <= real_info->radix; i *= 10) if (i == real_info->radix) real_info->precision++; - mpfr_clear (a); - mpfr_clear (b); - mpfr_clear (c); + mpfr_clears (a, b, NULL); } - - mpz_clear (r); } @@ -271,12 +253,7 @@ gfc_arith_done_1 (void) } for (rp = gfc_real_kinds; rp->kind; rp++) - { - mpfr_clear (rp->epsilon); - mpfr_clear (rp->huge); - mpfr_clear (rp->tiny); - mpfr_clear (rp->subnormal); - } + mpfr_clears (rp->epsilon, rp->huge, rp->tiny, rp->subnormal, NULL); } @@ -345,29 +322,27 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); + retval = ARITH_OK; + if (mpfr_inf_p (p)) { - if (gfc_option.flag_range_check == 0) - retval = ARITH_OK; - else + if (gfc_option.flag_range_check != 0) retval = ARITH_OVERFLOW; } else if (mpfr_nan_p (p)) { - if (gfc_option.flag_range_check == 0) - retval = ARITH_OK; - else + if (gfc_option.flag_range_check != 0) retval = ARITH_NAN; } else if (mpfr_sgn (q) == 0) - retval = ARITH_OK; + { + mpfr_clear (q); + return retval; + } else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) { if (gfc_option.flag_range_check == 0) - { - mpfr_set_inf (p, mpfr_sgn (p)); - retval = ARITH_OK; - } + mpfr_set_inf (p, mpfr_sgn (p)); else retval = ARITH_OVERFLOW; } @@ -383,7 +358,6 @@ gfc_check_real_range (mpfr_t p, int kind) } else mpfr_set_ui (p, 0, GFC_RND_MODE); - retval = ARITH_OK; } else retval = ARITH_UNDERFLOW; @@ -412,11 +386,7 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_neg (p, q, GMP_RNDN); else mpfr_set (p, q, GMP_RNDN); - - retval = ARITH_OK; } - else - retval = ARITH_OK; mpfr_clear (q); @@ -779,8 +749,7 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) mpfr_mul (y, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE); mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE); - mpfr_clear (x); - mpfr_clear (y); + mpfr_clears (x, y, NULL); break; default: @@ -858,9 +827,7 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) mpfr_div (result->value.complex.i, result->value.complex.i, div, GFC_RND_MODE); - mpfr_clear (x); - mpfr_clear (y); - mpfr_clear (div); + mpfr_clears (x, y, div, NULL); break; default: @@ -879,30 +846,22 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) static void complex_reciprocal (gfc_expr *op) { - mpfr_t mod, a, re, im; + mpfr_t mod, tmp; gfc_set_model (op->value.complex.r); mpfr_init (mod); - mpfr_init (a); - mpfr_init (re); - mpfr_init (im); + mpfr_init (tmp); mpfr_mul (mod, op->value.complex.r, op->value.complex.r, GFC_RND_MODE); - mpfr_mul (a, op->value.complex.i, op->value.complex.i, GFC_RND_MODE); - mpfr_add (mod, mod, a, GFC_RND_MODE); + mpfr_mul (tmp, op->value.complex.i, op->value.complex.i, GFC_RND_MODE); + mpfr_add (mod, mod, tmp, GFC_RND_MODE); - mpfr_div (re, op->value.complex.r, mod, GFC_RND_MODE); + mpfr_div (op->value.complex.r, op->value.complex.r, mod, GFC_RND_MODE); - mpfr_neg (im, op->value.complex.i, GFC_RND_MODE); - mpfr_div (im, im, mod, GFC_RND_MODE); + mpfr_neg (op->value.complex.i, op->value.complex.i, GFC_RND_MODE); + mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE); - mpfr_set (op->value.complex.r, re, GFC_RND_MODE); - mpfr_set (op->value.complex.i, im, GFC_RND_MODE); - - mpfr_clear (re); - mpfr_clear (im); - mpfr_clear (mod); - mpfr_clear (a); + mpfr_clears (tmp, mod, NULL); } @@ -934,8 +893,8 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE); mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE); -/* Macro for complex multiplication. We have to take care that - res_r/res_i and a_r/a_i can (and will) be the same variable. */ + /* Macro for complex multiplication. We have to take care that + res_r/res_i and a_r/a_i can (and will) be the same variable. */ #define CMULT(res_r,res_i,a_r,a_i,b_r,b_i) \ mpfr_mul (re, a_r, b_r, GFC_RND_MODE), \ mpfr_mul (tmp, a_i, b_i, GFC_RND_MODE), \ @@ -964,11 +923,7 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) #undef res_i #undef CMULT - mpfr_clear (x_r); - mpfr_clear (x_i); - mpfr_clear (tmp); - mpfr_clear (re); - mpfr_clear (im); + mpfr_clears (x_r, x_i, tmp, re, im, NULL); } diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 6852d64..58c5e4d 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -1005,16 +1005,29 @@ Function @item @emph{Arguments}: @multitable @columnfractions .15 .70 +<<<<<<< .mine +@item @var{I} @tab The type shall be either a scalar @code{INTEGER(*)} +type or a scalar @code{LOGICAL} type. +@item @var{J} @tab The type shall be the same as the type of @var{I}. +======= @item @var{I} @tab The type shall be either a scalar @code{INTEGER} type or a scalar @code{LOGICAL} type. @item @var{J} @tab The type shall be the same as the type of @var{I}. +>>>>>>> .r136053 @end multitable @item @emph{Return value}: +<<<<<<< .mine +The return type is either a scalar @code{INTEGER(*)} or a scalar +@code{LOGICAL}. If the kind type parameters differ, then the +smaller kind type is implicitly converted to larger kind, and the +return has the larger kind. +======= The return type is either a scalar @code{INTEGER} or a scalar @code{LOGICAL}. If the kind type parameters differ, then the smaller kind type is implicitly converted to larger kind, and the return has the larger kind. +>>>>>>> .r136053 @item @emph{Example}: @smallexample @@ -8310,16 +8323,29 @@ Function @item @emph{Arguments}: @multitable @columnfractions .15 .70 +<<<<<<< .mine +@item @var{X} @tab The type shall be either a scalar @code{INTEGER(*)} +type or a scalar @code{LOGICAL} type. +@item @var{Y} @tab The type shall be the same as the type of @var{X}. +======= @item @var{X} @tab The type shall be either a scalar @code{INTEGER} type or a scalar @code{LOGICAL} type. @item @var{Y} @tab The type shall be the same as the type of @var{X}. +>>>>>>> .r136053 @end multitable @item @emph{Return value}: +<<<<<<< .mine +The return type is either a scalar @code{INTEGER(*)} or a scalar +@code{LOGICAL}. If the kind type parameters differ, then the +smaller kind type is implicitly converted to larger kind, and the +return has the larger kind. +======= The return type is either a scalar @code{INTEGER} or a scalar @code{LOGICAL}. If the kind type parameters differ, then the smaller kind type is implicitly converted to larger kind, and the return has the larger kind. +>>>>>>> .r136053 @item @emph{Example}: @smallexample @@ -11055,16 +11081,29 @@ Function @item @emph{Arguments}: @multitable @columnfractions .15 .70 +<<<<<<< .mine +@item @var{X} @tab The type shall be either a scalar @code{INTEGER(*)} +type or a scalar @code{LOGICAL} type. +@item @var{Y} @tab The type shall be the same as the type of @var{I}. +======= @item @var{X} @tab The type shall be either a scalar @code{INTEGER} type or a scalar @code{LOGICAL} type. @item @var{Y} @tab The type shall be the same as the type of @var{I}. +>>>>>>> .r136053 @end multitable @item @emph{Return value}: +<<<<<<< .mine +The return type is either a scalar @code{INTEGER(*)} or a scalar +@code{LOGICAL}. If the kind type parameters differ, then the +smaller kind type is implicitly converted to larger kind, and the +return has the larger kind. +======= The return type is either a scalar @code{INTEGER} or a scalar @code{LOGICAL}. If the kind type parameters differ, then the smaller kind type is implicitly converted to larger kind, and the return has the larger kind. +>>>>>>> .r136053 @item @emph{Example}: @smallexample diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 59b425f..058a9f2 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -543,7 +543,6 @@ gfc_simplify_and (gfc_expr *x, gfc_expr *y) result->value.logical = x->value.logical && y->value.logical; return result; } - } @@ -651,16 +650,15 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x) if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - if (mpfr_sgn (y->value.real) == 0 && mpfr_sgn (x->value.real) == 0) { gfc_error ("If first argument of ATAN2 %L is zero, then the " "second argument must not be zero", &x->where); - gfc_free_expr (result); return &gfc_bad_expr; } + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "ATAN2"); @@ -677,7 +675,6 @@ gfc_simplify_bessel_j0 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_j0 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_J0"); @@ -697,7 +694,6 @@ gfc_simplify_bessel_j1 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_j1 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_J1"); @@ -720,7 +716,6 @@ gfc_simplify_bessel_jn (gfc_expr *order ATTRIBUTE_UNUSED, n = mpz_get_si (order->value.integer); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_jn (result->value.real, n, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_JN"); @@ -740,7 +735,6 @@ gfc_simplify_bessel_y0 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_y0 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_Y0"); @@ -760,7 +754,6 @@ gfc_simplify_bessel_y1 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_y1 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_Y1"); @@ -783,7 +776,6 @@ gfc_simplify_bessel_yn (gfc_expr *order ATTRIBUTE_UNUSED, n = mpz_get_si (order->value.integer); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_yn (result->value.real, n, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_YN"); @@ -937,25 +929,16 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) static gfc_expr * only_convert_cmplx_boz (gfc_expr *x, gfc_expr *y, int kind) { - if (x->is_boz) - { - gfc_typespec ts; - gfc_clear_ts (&ts); - ts.type = BT_REAL; - ts.kind = kind; - if (!gfc_convert_boz (x, &ts)) - return &gfc_bad_expr; - } + gfc_typespec ts; + gfc_clear_ts (&ts); + ts.type = BT_REAL; + ts.kind = kind; - if (y && y->is_boz) - { - gfc_typespec ts; - gfc_clear_ts (&ts); - ts.type = BT_REAL; - ts.kind = kind; - if (!gfc_convert_boz (y, &ts)) - return &gfc_bad_expr; - } + if (x->is_boz && !gfc_convert_boz (x, &ts)) + return &gfc_bad_expr; + + if (y && y->is_boz && !gfc_convert_boz (y, &ts)) + return &gfc_bad_expr; return NULL; } @@ -1051,8 +1034,7 @@ gfc_simplify_cos (gfc_expr *x) mpfr_mul (xp, xp, xq, GFC_RND_MODE); mpfr_neg (result->value.complex.i, xp, GFC_RND_MODE ); - mpfr_clear (xp); - mpfr_clear (xq); + mpfr_clears (xp, xq, NULL); break; default: gfc_internal_error ("in gfc_simplify_cos(): Bad type"); @@ -1296,8 +1278,7 @@ gfc_simplify_exp (gfc_expr *x) mpfr_mul (result->value.complex.r, xq, xp, GFC_RND_MODE); mpfr_sin (xp, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xq, xp, GFC_RND_MODE); - mpfr_clear (xp); - mpfr_clear (xq); + mpfr_clears (xp, xq, NULL); break; default: @@ -1402,14 +1383,13 @@ gfc_simplify_fraction (gfc_expr *x) 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; } + gfc_set_model_kind (x->ts.kind); mpfr_init (exp); mpfr_init (absv); mpfr_init (pow2); @@ -1424,9 +1404,7 @@ gfc_simplify_fraction (gfc_expr *x) mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE); - mpfr_clear (exp); - mpfr_clear (absv); - mpfr_clear (pow2); + mpfr_clears (exp, absv, pow2, NULL); return range_check (result, "FRACTION"); } @@ -1442,8 +1420,6 @@ gfc_simplify_gamma (gfc_expr *x) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - mpfr_gamma (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "GAMMA"); @@ -2491,8 +2467,6 @@ gfc_simplify_lgamma (gfc_expr *x ATTRIBUTE_UNUSED) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - mpfr_lgamma (result->value.real, &sg, x->value.real, GFC_RND_MODE); return range_check (result, "LGAMMA"); @@ -2554,7 +2528,6 @@ gfc_simplify_log (gfc_expr *x) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); switch (x->ts.type) { @@ -2580,6 +2553,7 @@ gfc_simplify_log (gfc_expr *x) return &gfc_bad_expr; } + gfc_set_model_kind (x->ts.kind); mpfr_init (xr); mpfr_init (xi); @@ -2592,8 +2566,7 @@ gfc_simplify_log (gfc_expr *x) mpfr_sqrt (xr, xr, GFC_RND_MODE); mpfr_log (result->value.complex.r, xr, GFC_RND_MODE); - mpfr_clear (xr); - mpfr_clear (xi); + mpfr_clears (xr, xi, NULL); break; @@ -2613,8 +2586,6 @@ gfc_simplify_log10 (gfc_expr *x) 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 " @@ -2812,7 +2783,7 @@ gfc_expr * gfc_simplify_mod (gfc_expr *a, gfc_expr *p) { gfc_expr *result; - mpfr_t quot, iquot, term; + mpfr_t tmp; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) @@ -2844,18 +2815,12 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) } gfc_set_model_kind (kind); - mpfr_init (quot); - mpfr_init (iquot); - mpfr_init (term); - - mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE); - mpfr_trunc (iquot, quot); - mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE); - mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE); - - mpfr_clear (quot); - mpfr_clear (iquot); - mpfr_clear (term); + mpfr_init (tmp); + mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE); + mpfr_trunc (tmp, tmp); + mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE); + mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE); + mpfr_clear (tmp); break; default: @@ -2870,7 +2835,7 @@ gfc_expr * gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) { gfc_expr *result; - mpfr_t quot, iquot, term; + mpfr_t tmp; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) @@ -2904,18 +2869,12 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) } gfc_set_model_kind (kind); - mpfr_init (quot); - mpfr_init (iquot); - mpfr_init (term); - - mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE); - mpfr_floor (iquot, quot); - mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE); - mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE); - - mpfr_clear (quot); - mpfr_clear (iquot); - mpfr_clear (term); + mpfr_init (tmp); + mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE); + mpfr_floor (tmp, tmp); + mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE); + mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE); + mpfr_clear (tmp); break; default: @@ -2955,7 +2914,6 @@ gfc_simplify_nearest (gfc_expr *x, gfc_expr *s) return &gfc_bad_expr; } - gfc_set_model_kind (x->ts.kind); result = gfc_copy_expr (x); /* Save current values of emin and emax. */ @@ -3715,8 +3673,7 @@ gfc_simplify_scale (gfc_expr *x, gfc_expr *i) else mpfr_mul (result->value.real, x->value.real, scale, GFC_RND_MODE); - mpfr_clear (scale); - mpfr_clear (radix); + mpfr_clears (scale, radix, NULL); return range_check (result, "SCALE"); } @@ -3944,14 +3901,13 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) 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; } + gfc_set_model_kind (x->ts.kind); mpfr_init (absv); mpfr_init (log2); mpfr_init (exp); @@ -3973,10 +3929,7 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) 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); + mpfr_clears (absv, log2, pow2, frac, NULL); return range_check (result, "SET_EXPONENT"); } @@ -4137,8 +4090,7 @@ gfc_simplify_sin (gfc_expr *x) mpfr_sinh (xq, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xp, xq, GFC_RND_MODE); - mpfr_clear (xp); - mpfr_clear (xq); + mpfr_clears (xp, xq, NULL); break; default: @@ -4314,11 +4266,7 @@ gfc_simplify_sqrt (gfc_expr *e) gfc_internal_error ("invalid complex argument of SQRT at %L", &e->where); - mpfr_clear (s); - mpfr_clear (t); - mpfr_clear (ac); - mpfr_clear (ad); - mpfr_clear (w); + mpfr_clears (s, t, ac, ad, w, NULL); break; -- 2.7.4