+2008-05-31 Steven G. Kargl <kargls@comcast.net>
+
+ * 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 <franke.daniel@gmail.com>
PR target/36348
{
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. */
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);
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);
/* 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);
}
}
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);
}
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;
}
}
else
mpfr_set_ui (p, 0, GFC_RND_MODE);
- retval = ARITH_OK;
}
else
retval = ARITH_UNDERFLOW;
mpfr_neg (p, q, GMP_RNDN);
else
mpfr_set (p, q, GMP_RNDN);
-
- retval = ARITH_OK;
}
- else
- retval = ARITH_OK;
mpfr_clear (q);
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:
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:
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);
}
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), \
#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);
}
@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
@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
@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
result->value.logical = x->value.logical && y->value.logical;
return result;
}
-
}
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");
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");
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");
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");
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");
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");
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");
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;
}
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");
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:
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);
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");
}
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");
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");
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
- gfc_set_model_kind (x->ts.kind);
switch (x->ts.type)
{
return &gfc_bad_expr;
}
+ gfc_set_model_kind (x->ts.kind);
mpfr_init (xr);
mpfr_init (xi);
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;
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 "
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)
}
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:
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)
}
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:
return &gfc_bad_expr;
}
- gfc_set_model_kind (x->ts.kind);
result = gfc_copy_expr (x);
/* Save current values of emin and emax. */
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");
}
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);
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");
}
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:
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;
OSDN Git Service
