gfortran.h (gfc_expr): Use mpc_t to represent complex numbers.
* gfortran.h (gfc_expr): Use mpc_t to represent complex numbers. * arith.c, dump-parse-tree.c, expr.c, module.c, resolve.c, simplify.c, target-memory.c, target-memory.h, trans-const.c, trans-expr.c: Convert to mpc_t throughout. From-SVN: r148711
This commit is contained in:
Kaveh R. Ghazi
Kaveh Ghazi
parent
642324bb16
commit
eb6f9a86c5
|
|
@ -1,3 +1,11 @@
|
|||
2009-06-19 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
|
||||
|
||||
* gfortran.h (gfc_expr): Use mpc_t to represent complex numbers.
|
||||
|
||||
* arith.c, dump-parse-tree.c, expr.c, module.c, resolve.c,
|
||||
simplify.c, target-memory.c, target-memory.h, trans-const.c,
|
||||
trans-expr.c: Convert to mpc_t throughout.
|
||||
|
||||
2009-06-19 Ian Lance Taylor <iant@google.com>
|
||||
|
||||
* cpp.c (struct gfc_cpp_option_data): Give this struct, used for
|
||||
|
|
|
|||
|
|
@ -429,8 +429,12 @@ gfc_constant_result (bt type, int kind, locus *where)
|
|||
|
||||
case BT_COMPLEX:
|
||||
gfc_set_model_kind (kind);
|
||||
#ifdef HAVE_mpc
|
||||
mpc_init2 (result->value.complex, mpfr_get_default_prec());
|
||||
#else
|
||||
mpfr_init (result->value.complex.r);
|
||||
mpfr_init (result->value.complex.i);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -543,21 +547,23 @@ gfc_range_check (gfc_expr *e)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
rc = gfc_check_real_range (e->value.complex.r, e->ts.kind);
|
||||
rc = gfc_check_real_range (mpc_realref (e->value.complex), e->ts.kind);
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
mpfr_set_ui (e->value.complex.r, 0, GFC_RND_MODE);
|
||||
mpfr_set_ui (mpc_realref (e->value.complex), 0, GFC_RND_MODE);
|
||||
if (rc == ARITH_OVERFLOW)
|
||||
mpfr_set_inf (e->value.complex.r, mpfr_sgn (e->value.complex.r));
|
||||
mpfr_set_inf (mpc_realref (e->value.complex),
|
||||
mpfr_sgn (mpc_realref (e->value.complex)));
|
||||
if (rc == ARITH_NAN)
|
||||
mpfr_set_nan (e->value.complex.r);
|
||||
mpfr_set_nan (mpc_realref (e->value.complex));
|
||||
|
||||
rc2 = gfc_check_real_range (e->value.complex.i, e->ts.kind);
|
||||
rc2 = gfc_check_real_range (mpc_imagref (e->value.complex), e->ts.kind);
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
mpfr_set_ui (e->value.complex.i, 0, GFC_RND_MODE);
|
||||
mpfr_set_ui (mpc_imagref (e->value.complex), 0, GFC_RND_MODE);
|
||||
if (rc == ARITH_OVERFLOW)
|
||||
mpfr_set_inf (e->value.complex.i, mpfr_sgn (e->value.complex.i));
|
||||
mpfr_set_inf (mpc_imagref (e->value.complex),
|
||||
mpfr_sgn (mpc_imagref (e->value.complex)));
|
||||
if (rc == ARITH_NAN)
|
||||
mpfr_set_nan (e->value.complex.i);
|
||||
mpfr_set_nan (mpc_imagref (e->value.complex));
|
||||
|
||||
if (rc == ARITH_OK)
|
||||
rc = rc2;
|
||||
|
|
@ -633,8 +639,12 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_neg (result->value.complex, op1->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_neg (result->value.complex.r, op1->value.complex.r, GFC_RND_MODE);
|
||||
mpfr_neg (result->value.complex.i, op1->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -667,11 +677,16 @@ gfc_arith_plus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_add (result->value.complex, op1->value.complex, op2->value.complex,
|
||||
GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_add (result->value.complex.r, op1->value.complex.r,
|
||||
op2->value.complex.r, GFC_RND_MODE);
|
||||
|
||||
mpfr_add (result->value.complex.i, op1->value.complex.i,
|
||||
op2->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -704,11 +719,16 @@ gfc_arith_minus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_sub (result->value.complex, op1->value.complex,
|
||||
op2->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_sub (result->value.complex.r, op1->value.complex.r,
|
||||
op2->value.complex.r, GFC_RND_MODE);
|
||||
|
||||
mpfr_sub (result->value.complex.i, op1->value.complex.i,
|
||||
op2->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -725,7 +745,6 @@ static arith
|
|||
gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
||||
{
|
||||
gfc_expr *result;
|
||||
mpfr_t x, y;
|
||||
arith rc;
|
||||
|
||||
result = gfc_constant_result (op1->ts.type, op1->ts.kind, &op1->where);
|
||||
|
|
@ -742,7 +761,13 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
gfc_set_model (op1->value.complex.r);
|
||||
gfc_set_model (mpc_realref (op1->value.complex));
|
||||
#ifdef HAVE_mpc
|
||||
mpc_mul (result->value.complex, op1->value.complex, op2->value.complex,
|
||||
GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t x, y;
|
||||
mpfr_init (x);
|
||||
mpfr_init (y);
|
||||
|
||||
|
|
@ -755,6 +780,8 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE);
|
||||
|
||||
mpfr_clears (x, y, NULL);
|
||||
}
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -771,7 +798,6 @@ static arith
|
|||
gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
||||
{
|
||||
gfc_expr *result;
|
||||
mpfr_t x, y, div;
|
||||
arith rc;
|
||||
|
||||
rc = ARITH_OK;
|
||||
|
|
@ -803,15 +829,35 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
if (mpfr_sgn (op2->value.complex.r) == 0
|
||||
if (
|
||||
#ifdef HAVE_mpc
|
||||
mpc_cmp_si_si (op2->value.complex, 0, 0) == 0
|
||||
#else
|
||||
mpfr_sgn (op2->value.complex.r) == 0
|
||||
&& mpfr_sgn (op2->value.complex.i) == 0
|
||||
#endif
|
||||
&& gfc_option.flag_range_check == 1)
|
||||
{
|
||||
rc = ARITH_DIV0;
|
||||
break;
|
||||
}
|
||||
|
||||
gfc_set_model (op1->value.complex.r);
|
||||
gfc_set_model (mpc_realref (op1->value.complex));
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0)
|
||||
{
|
||||
/* In Fortran, return (NaN + NaN I) for any zero divisor. See
|
||||
PR 40318. */
|
||||
mpfr_set_nan (mpc_realref (result->value.complex));
|
||||
mpfr_set_nan (mpc_imagref (result->value.complex));
|
||||
}
|
||||
else
|
||||
mpc_div (result->value.complex, op1->value.complex, op2->value.complex,
|
||||
GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t x, y, div;
|
||||
mpfr_init (x);
|
||||
mpfr_init (y);
|
||||
mpfr_init (div);
|
||||
|
|
@ -833,6 +879,8 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
GFC_RND_MODE);
|
||||
|
||||
mpfr_clears (x, y, div, NULL);
|
||||
}
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -851,9 +899,13 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
static void
|
||||
complex_reciprocal (gfc_expr *op)
|
||||
{
|
||||
gfc_set_model (mpc_realref (op->value.complex));
|
||||
#ifdef HAVE_mpc
|
||||
mpc_ui_div (op->value.complex, 1, op->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t mod, tmp;
|
||||
|
||||
gfc_set_model (op->value.complex.r);
|
||||
mpfr_init (mod);
|
||||
mpfr_init (tmp);
|
||||
|
||||
|
|
@ -867,6 +919,8 @@ complex_reciprocal (gfc_expr *op)
|
|||
mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE);
|
||||
|
||||
mpfr_clears (tmp, mod, NULL);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -883,7 +937,7 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power)
|
|||
{
|
||||
mpfr_t x_r, x_i, tmp, re, im;
|
||||
|
||||
gfc_set_model (base->value.complex.r);
|
||||
gfc_set_model (mpc_realref (base->value.complex));
|
||||
mpfr_init (x_r);
|
||||
mpfr_init (x_i);
|
||||
mpfr_init (tmp);
|
||||
|
|
@ -891,12 +945,16 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power)
|
|||
mpfr_init (im);
|
||||
|
||||
/* res = 1 */
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_ui (result->value.complex, 1, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_ui (result->value.complex.r, 1, GFC_RND_MODE);
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
/* x = base */
|
||||
mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE);
|
||||
mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE);
|
||||
mpfr_set (x_r, mpc_realref (base->value.complex), GFC_RND_MODE);
|
||||
mpfr_set (x_i, mpc_imagref (base->value.complex), 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. */
|
||||
|
|
@ -910,8 +968,8 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power)
|
|||
mpfr_add (res_i, im, tmp, GFC_RND_MODE), \
|
||||
mpfr_set (res_r, re, GFC_RND_MODE)
|
||||
|
||||
#define res_r result->value.complex.r
|
||||
#define res_i result->value.complex.i
|
||||
#define res_r mpc_realref (result->value.complex)
|
||||
#define res_i mpc_imagref (result->value.complex)
|
||||
|
||||
/* for (; power > 0; x *= x) */
|
||||
for (; mpz_cmp_si (power, 0) > 0; CMULT(x_r,x_i,x_r,x_i,x_r,x_i))
|
||||
|
|
@ -966,8 +1024,12 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_ui (result->value.complex, 1, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_ui (result->value.complex.r, 1, GFC_RND_MODE);
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -1089,8 +1151,6 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
|
||||
case BT_COMPLEX:
|
||||
{
|
||||
mpfr_t x, y, r, t;
|
||||
|
||||
if (init_flag)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
|
||||
|
|
@ -1099,16 +1159,27 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
return ARITH_PROHIBIT;
|
||||
}
|
||||
|
||||
gfc_set_model (op1->value.complex.r);
|
||||
{
|
||||
mpfr_t x, y, r, t;
|
||||
|
||||
gfc_set_model (mpc_realref (op1->value.complex));
|
||||
|
||||
mpfr_init (r);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_abs (r, op1->value.complex, GFC_RND_MODE);
|
||||
#else
|
||||
mpfr_hypot (r, op1->value.complex.r, op1->value.complex.i,
|
||||
GFC_RND_MODE);
|
||||
#endif
|
||||
if (mpfr_cmp_si (r, 0) == 0)
|
||||
{
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_ui (result->value.complex, 0, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
mpfr_clear (r);
|
||||
break;
|
||||
}
|
||||
|
|
@ -1116,25 +1187,30 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
|||
|
||||
mpfr_init (t);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_arg (t, op1->value.complex, GFC_RND_MODE);
|
||||
#else
|
||||
mpfr_atan2 (t, op1->value.complex.i, op1->value.complex.r,
|
||||
GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
mpfr_init (x);
|
||||
mpfr_init (y);
|
||||
|
||||
mpfr_mul (x, op2->value.complex.r, r, GFC_RND_MODE);
|
||||
mpfr_mul (y, op2->value.complex.i, t, GFC_RND_MODE);
|
||||
mpfr_mul (x, mpc_realref (op2->value.complex), r, GFC_RND_MODE);
|
||||
mpfr_mul (y, mpc_imagref (op2->value.complex), t, GFC_RND_MODE);
|
||||
mpfr_sub (x, x, y, GFC_RND_MODE);
|
||||
mpfr_exp (x, x, GFC_RND_MODE);
|
||||
|
||||
mpfr_mul (y, op2->value.complex.r, t, GFC_RND_MODE);
|
||||
mpfr_mul (t, op2->value.complex.i, r, GFC_RND_MODE);
|
||||
mpfr_mul (y, mpc_realref (op2->value.complex), t, GFC_RND_MODE);
|
||||
mpfr_mul (t, mpc_imagref (op2->value.complex), r, GFC_RND_MODE);
|
||||
mpfr_add (y, y, t, GFC_RND_MODE);
|
||||
mpfr_cos (t, y, GFC_RND_MODE);
|
||||
mpfr_sin (y, y, GFC_RND_MODE);
|
||||
mpfr_mul (result->value.complex.r, x, t, GFC_RND_MODE);
|
||||
mpfr_mul (result->value.complex.i, x, y, GFC_RND_MODE);
|
||||
mpfr_mul (mpc_realref (result->value.complex), x, t, GFC_RND_MODE);
|
||||
mpfr_mul (mpc_imagref (result->value.complex), x, y, GFC_RND_MODE);
|
||||
mpfr_clears (r, t, x, y, NULL);
|
||||
}
|
||||
}
|
||||
break;
|
||||
default:
|
||||
|
|
@ -1252,8 +1328,12 @@ gfc_compare_expr (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
|
|||
static int
|
||||
compare_complex (gfc_expr *op1, gfc_expr *op2)
|
||||
{
|
||||
#ifdef HAVE_mpc
|
||||
return mpc_cmp (op1->value.complex, op2->value.complex) == 0;
|
||||
#else
|
||||
return (mpfr_equal_p (op1->value.complex.r, op2->value.complex.r)
|
||||
&& mpfr_equal_p (op1->value.complex.i, op2->value.complex.i));
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -2122,8 +2202,13 @@ gfc_convert_complex (gfc_expr *real, gfc_expr *imag, int kind)
|
|||
gfc_expr *e;
|
||||
|
||||
e = gfc_constant_result (BT_COMPLEX, kind, &real->where);
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real,
|
||||
GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (e->value.complex.r, real->value.real, GFC_RND_MODE);
|
||||
mpfr_set (e->value.complex.i, imag->value.real, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
return e;
|
||||
}
|
||||
|
|
@ -2243,10 +2328,15 @@ gfc_int2complex (gfc_expr *src, int kind)
|
|||
|
||||
result = gfc_constant_result (BT_COMPLEX, kind, &src->where);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_z (result->value.complex.r, src->value.integer, GFC_RND_MODE);
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
if ((rc = gfc_check_real_range (result->value.complex.r, kind)) != ARITH_OK)
|
||||
if ((rc = gfc_check_real_range (mpc_realref (result->value.complex), kind))
|
||||
!= ARITH_OK)
|
||||
{
|
||||
arith_error (rc, &src->ts, &result->ts, &src->where);
|
||||
gfc_free_expr (result);
|
||||
|
|
@ -2321,16 +2411,20 @@ gfc_real2complex (gfc_expr *src, int kind)
|
|||
|
||||
result = gfc_constant_result (BT_COMPLEX, kind, &src->where);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_fr (result->value.complex, src->value.real, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (result->value.complex.r, src->value.real, GFC_RND_MODE);
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
rc = gfc_check_real_range (result->value.complex.r, kind);
|
||||
rc = gfc_check_real_range (mpc_realref (result->value.complex), kind);
|
||||
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
{
|
||||
if (gfc_option.warn_underflow)
|
||||
gfc_warning (gfc_arith_error (rc), &src->where);
|
||||
mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
|
||||
mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE);
|
||||
}
|
||||
else if (rc != ARITH_OK)
|
||||
{
|
||||
|
|
@ -2353,7 +2447,8 @@ gfc_complex2int (gfc_expr *src, int kind)
|
|||
|
||||
result = gfc_constant_result (BT_INTEGER, kind, &src->where);
|
||||
|
||||
gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r, &src->where);
|
||||
gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
|
||||
&src->where);
|
||||
|
||||
if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK)
|
||||
{
|
||||
|
|
@ -2376,7 +2471,11 @@ gfc_complex2real (gfc_expr *src, int kind)
|
|||
|
||||
result = gfc_constant_result (BT_REAL, kind, &src->where);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_real (result->value.real, src->value.complex, GFC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (result->value.real, src->value.complex.r, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
rc = gfc_check_real_range (result->value.real, kind);
|
||||
|
||||
|
|
@ -2407,16 +2506,20 @@ gfc_complex2complex (gfc_expr *src, int kind)
|
|||
|
||||
result = gfc_constant_result (BT_COMPLEX, kind, &src->where);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set (result->value.complex, src->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (result->value.complex.r, src->value.complex.r, GFC_RND_MODE);
|
||||
mpfr_set (result->value.complex.i, src->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
rc = gfc_check_real_range (result->value.complex.r, kind);
|
||||
rc = gfc_check_real_range (mpc_realref (result->value.complex), kind);
|
||||
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
{
|
||||
if (gfc_option.warn_underflow)
|
||||
gfc_warning (gfc_arith_error (rc), &src->where);
|
||||
mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
|
||||
mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE);
|
||||
}
|
||||
else if (rc != ARITH_OK)
|
||||
{
|
||||
|
|
@ -2425,13 +2528,13 @@ gfc_complex2complex (gfc_expr *src, int kind)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
rc = gfc_check_real_range (result->value.complex.i, kind);
|
||||
rc = gfc_check_real_range (mpc_imagref (result->value.complex), kind);
|
||||
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
{
|
||||
if (gfc_option.warn_underflow)
|
||||
gfc_warning (gfc_arith_error (rc), &src->where);
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
mpfr_set_ui (mpc_imagref (result->value.complex), 0, GFC_RND_MODE);
|
||||
}
|
||||
else if (rc != ARITH_OK)
|
||||
{
|
||||
|
|
@ -2579,8 +2682,13 @@ gfc_hollerith2complex (gfc_expr *src, int kind)
|
|||
|
||||
hollerith2representation (result, src);
|
||||
gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
|
||||
result->representation.length, result->value.complex.r,
|
||||
result->value.complex.i);
|
||||
result->representation.length,
|
||||
#ifdef HAVE_mpc
|
||||
result->value.complex
|
||||
#else
|
||||
result->value.complex.r, result->value.complex.i
|
||||
#endif
|
||||
);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -402,13 +402,15 @@ show_expr (gfc_expr *p)
|
|||
case BT_COMPLEX:
|
||||
fputs ("(complex ", dumpfile);
|
||||
|
||||
mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE);
|
||||
mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
|
||||
GFC_RND_MODE);
|
||||
if (p->ts.kind != gfc_default_complex_kind)
|
||||
fprintf (dumpfile, "_%d", p->ts.kind);
|
||||
|
||||
fputc (' ', dumpfile);
|
||||
|
||||
mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE);
|
||||
mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
|
||||
GFC_RND_MODE);
|
||||
if (p->ts.kind != gfc_default_complex_kind)
|
||||
fprintf (dumpfile, "_%d", p->ts.kind);
|
||||
|
||||
|
|
|
|||
|
|
@ -156,8 +156,12 @@ free_expr0 (gfc_expr *e)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_clear (e->value.complex);
|
||||
#else
|
||||
mpfr_clear (e->value.complex.r);
|
||||
mpfr_clear (e->value.complex.i);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -439,10 +443,15 @@ gfc_copy_expr (gfc_expr *p)
|
|||
|
||||
case BT_COMPLEX:
|
||||
gfc_set_model_kind (q->ts.kind);
|
||||
#ifdef HAVE_mpc
|
||||
mpc_init2 (q->value.complex, mpfr_get_default_prec());
|
||||
mpc_set (q->value.complex, p->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_init (q->value.complex.r);
|
||||
mpfr_init (q->value.complex.i);
|
||||
mpfr_set (q->value.complex.r, p->value.complex.r, GFC_RND_MODE);
|
||||
mpfr_set (q->value.complex.i, p->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
case BT_CHARACTER:
|
||||
|
|
|
|||
|
|
@ -1555,6 +1555,12 @@ gfc_intrinsic_sym;
|
|||
|
||||
#include <gmp.h>
|
||||
#include <mpfr.h>
|
||||
#ifdef HAVE_mpc
|
||||
#include <mpc.h>
|
||||
#else
|
||||
#define mpc_realref(X) ((X).r)
|
||||
#define mpc_imagref(X) ((X).i)
|
||||
#endif
|
||||
#define GFC_RND_MODE GMP_RNDN
|
||||
#define GFC_MPC_RND_MODE MPC_RNDNN
|
||||
|
||||
|
|
@ -1613,10 +1619,14 @@ typedef struct gfc_expr
|
|||
|
||||
mpfr_t real;
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_t
|
||||
#else
|
||||
struct
|
||||
{
|
||||
mpfr_t r, i;
|
||||
}
|
||||
#endif
|
||||
complex;
|
||||
|
||||
struct
|
||||
|
|
|
|||
|
|
@ -3027,8 +3027,8 @@ mio_expr (gfc_expr **ep)
|
|||
|
||||
case BT_COMPLEX:
|
||||
gfc_set_model_kind (e->ts.kind);
|
||||
mio_gmp_real (&e->value.complex.r);
|
||||
mio_gmp_real (&e->value.complex.i);
|
||||
mio_gmp_real (&mpc_realref (e->value.complex));
|
||||
mio_gmp_real (&mpc_imagref (e->value.complex));
|
||||
break;
|
||||
|
||||
case BT_LOGICAL:
|
||||
|
|
|
|||
|
|
@ -7610,31 +7610,39 @@ build_default_init_expr (gfc_symbol *sym)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_init2 (init_expr->value.complex, mpfr_get_default_prec());
|
||||
#else
|
||||
mpfr_init (init_expr->value.complex.r);
|
||||
mpfr_init (init_expr->value.complex.i);
|
||||
#endif
|
||||
switch (gfc_option.flag_init_real)
|
||||
{
|
||||
case GFC_INIT_REAL_SNAN:
|
||||
init_expr->is_snan = 1;
|
||||
/* Fall through. */
|
||||
case GFC_INIT_REAL_NAN:
|
||||
mpfr_set_nan (init_expr->value.complex.r);
|
||||
mpfr_set_nan (init_expr->value.complex.i);
|
||||
mpfr_set_nan (mpc_realref (init_expr->value.complex));
|
||||
mpfr_set_nan (mpc_imagref (init_expr->value.complex));
|
||||
break;
|
||||
|
||||
case GFC_INIT_REAL_INF:
|
||||
mpfr_set_inf (init_expr->value.complex.r, 1);
|
||||
mpfr_set_inf (init_expr->value.complex.i, 1);
|
||||
mpfr_set_inf (mpc_realref (init_expr->value.complex), 1);
|
||||
mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1);
|
||||
break;
|
||||
|
||||
case GFC_INIT_REAL_NEG_INF:
|
||||
mpfr_set_inf (init_expr->value.complex.r, -1);
|
||||
mpfr_set_inf (init_expr->value.complex.i, -1);
|
||||
mpfr_set_inf (mpc_realref (init_expr->value.complex), -1);
|
||||
mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1);
|
||||
break;
|
||||
|
||||
case GFC_INIT_REAL_ZERO:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_ui (init_expr->value.complex.r, 0.0, GFC_RND_MODE);
|
||||
mpfr_set_ui (init_expr->value.complex.i, 0.0, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
|
|||
|
|
@ -214,26 +214,6 @@ convert_mpz_to_signed (mpz_t x, int bitsize)
|
|||
}
|
||||
}
|
||||
|
||||
/* Helper function to convert to/from mpfr_t & mpc_t and call the
|
||||
supplied mpc function on the respective values. */
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
static void
|
||||
call_mpc_func (mpfr_ptr result_re, mpfr_ptr result_im,
|
||||
mpfr_srcptr input_re, mpfr_srcptr input_im,
|
||||
int (*func)(mpc_ptr, mpc_srcptr, mpc_rnd_t))
|
||||
{
|
||||
mpc_t c;
|
||||
mpc_init2 (c, mpfr_get_default_prec());
|
||||
mpc_set_fr_fr (c, input_re, input_im, GFC_MPC_RND_MODE);
|
||||
func (c, c, GFC_MPC_RND_MODE);
|
||||
mpfr_set (result_re, mpc_realref (c), GFC_RND_MODE);
|
||||
mpfr_set (result_im, mpc_imagref (c), GFC_RND_MODE);
|
||||
mpc_clear (c);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/* Test that the expression is an constant array. */
|
||||
|
||||
static bool
|
||||
|
|
@ -303,8 +283,12 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_si (e->value.complex, init, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_si (e->value.complex.r, init, GFC_RND_MODE);
|
||||
mpfr_set_si (e->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
case BT_CHARACTER:
|
||||
|
|
@ -660,8 +644,12 @@ gfc_simplify_abs (gfc_expr *e)
|
|||
|
||||
gfc_set_model_kind (e->ts.kind);
|
||||
|
||||
#ifdef HAVE_mpc
|
||||
mpc_abs (result->value.real, e->value.complex, GFC_RND_MODE);
|
||||
#else
|
||||
mpfr_hypot (result->value.real, e->value.complex.r,
|
||||
e->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
result = range_check (result, "CABS");
|
||||
break;
|
||||
|
||||
|
|
@ -867,7 +855,7 @@ gfc_simplify_aimag (gfc_expr *e)
|
|||
return NULL;
|
||||
|
||||
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where);
|
||||
mpfr_set (result->value.real, e->value.complex.i, GFC_RND_MODE);
|
||||
mpfr_set (result->value.real, mpc_imagref (e->value.complex), GFC_RND_MODE);
|
||||
|
||||
return range_check (result, "AIMAG");
|
||||
}
|
||||
|
|
@ -1286,22 +1274,36 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
|
|||
|
||||
result = gfc_constant_result (BT_COMPLEX, kind, &x->where);
|
||||
|
||||
#ifndef HAVE_mpc
|
||||
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
switch (x->ts.type)
|
||||
{
|
||||
case BT_INTEGER:
|
||||
if (!x->is_boz)
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_z (result->value.complex, x->value.integer, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
case BT_REAL:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set_fr (result->value.complex, x->value.real, GFC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
#ifdef HAVE_mpc
|
||||
mpc_set (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (result->value.complex.r, x->value.complex.r, GFC_RND_MODE);
|
||||
mpfr_set (result->value.complex.i, x->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -1314,12 +1316,13 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
|
|||
{
|
||||
case BT_INTEGER:
|
||||
if (!y->is_boz)
|
||||
mpfr_set_z (result->value.complex.i, y->value.integer,
|
||||
GFC_RND_MODE);
|
||||
mpfr_set_z (mpc_imagref (result->value.complex),
|
||||
y->value.integer, GFC_RND_MODE);
|
||||
break;
|
||||
|
||||
case BT_REAL:
|
||||
mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
|
||||
mpfr_set (mpc_imagref (result->value.complex),
|
||||
y->value.real, GFC_RND_MODE);
|
||||
break;
|
||||
|
||||
default:
|
||||
|
|
@ -1336,7 +1339,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
|
|||
ts.type = BT_REAL;
|
||||
if (!gfc_convert_boz (x, &ts))
|
||||
return &gfc_bad_expr;
|
||||
mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
|
||||
mpfr_set (mpc_realref (result->value.complex),
|
||||
x->value.real, GFC_RND_MODE);
|
||||
}
|
||||
|
||||
if (y && y->is_boz)
|
||||
|
|
@ -1347,7 +1351,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
|
|||
ts.type = BT_REAL;
|
||||
if (!gfc_convert_boz (y, &ts))
|
||||
return &gfc_bad_expr;
|
||||
mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
|
||||
mpfr_set (mpc_imagref (result->value.complex),
|
||||
y->value.real, GFC_RND_MODE);
|
||||
}
|
||||
|
||||
return range_check (result, name);
|
||||
|
|
@ -1429,7 +1434,11 @@ gfc_simplify_conjg (gfc_expr *e)
|
|||
return NULL;
|
||||
|
||||
result = gfc_copy_expr (e);
|
||||
#ifdef HAVE_mpc
|
||||
mpc_conj (result->value.complex, result->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
mpfr_neg (result->value.complex.i, result->value.complex.i, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
return range_check (result, "CONJG");
|
||||
}
|
||||
|
|
@ -1453,8 +1462,7 @@ gfc_simplify_cos (gfc_expr *x)
|
|||
case BT_COMPLEX:
|
||||
gfc_set_model_kind (x->ts.kind);
|
||||
#ifdef HAVE_mpc
|
||||
call_mpc_func (result->value.complex.r, result->value.complex.i,
|
||||
x->value.complex.r, x->value.complex.i, mpc_cos);
|
||||
mpc_cos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t xp, xq;
|
||||
|
|
@ -1898,8 +1906,7 @@ gfc_simplify_exp (gfc_expr *x)
|
|||
case BT_COMPLEX:
|
||||
gfc_set_model_kind (x->ts.kind);
|
||||
#ifdef HAVE_mpc
|
||||
call_mpc_func (result->value.complex.r, result->value.complex.i,
|
||||
x->value.complex.r, x->value.complex.i, mpc_exp);
|
||||
mpc_exp (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t xp, xq;
|
||||
|
|
@ -3281,8 +3288,8 @@ gfc_simplify_log (gfc_expr *x)
|
|||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
if ((mpfr_sgn (x->value.complex.r) == 0)
|
||||
&& (mpfr_sgn (x->value.complex.i) == 0))
|
||||
if ((mpfr_sgn (mpc_realref (x->value.complex)) == 0)
|
||||
&& (mpfr_sgn (mpc_imagref (x->value.complex)) == 0))
|
||||
{
|
||||
gfc_error ("Complex argument of LOG at %L cannot be zero",
|
||||
&x->where);
|
||||
|
|
@ -3292,8 +3299,7 @@ gfc_simplify_log (gfc_expr *x)
|
|||
|
||||
gfc_set_model_kind (x->ts.kind);
|
||||
#ifdef HAVE_mpc
|
||||
call_mpc_func (result->value.complex.r, result->value.complex.i,
|
||||
x->value.complex.r, x->value.complex.i, mpc_log);
|
||||
mpc_log (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t xr, xi;
|
||||
|
|
@ -4204,7 +4210,11 @@ gfc_simplify_realpart (gfc_expr *e)
|
|||
return NULL;
|
||||
|
||||
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where);
|
||||
#ifdef HAVE_mpc
|
||||
mpc_real (result->value.real, e->value.complex, GFC_RND_MODE);
|
||||
#else
|
||||
mpfr_set (result->value.real, e->value.complex.r, GFC_RND_MODE);
|
||||
#endif
|
||||
|
||||
return range_check (result, "REALPART");
|
||||
}
|
||||
|
|
@ -4986,8 +4996,7 @@ gfc_simplify_sin (gfc_expr *x)
|
|||
case BT_COMPLEX:
|
||||
gfc_set_model (x->value.real);
|
||||
#ifdef HAVE_mpc
|
||||
call_mpc_func (result->value.complex.r, result->value.complex.i,
|
||||
x->value.complex.r, x->value.complex.i, mpc_sin);
|
||||
mpc_sin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
mpfr_t xp, xq;
|
||||
|
|
@ -5200,8 +5209,7 @@ gfc_simplify_sqrt (gfc_expr *e)
|
|||
case BT_COMPLEX:
|
||||
gfc_set_model (e->value.real);
|
||||
#ifdef HAVE_mpc
|
||||
call_mpc_func (result->value.complex.r, result->value.complex.i,
|
||||
e->value.complex.r, e->value.complex.i, mpc_sqrt);
|
||||
mpc_sqrt (result->value.complex, e->value.complex, GFC_MPC_RND_MODE);
|
||||
#else
|
||||
{
|
||||
/* Formula taken from Numerical Recipes to avoid over- and
|
||||
|
|
|
|||
|
|
@ -164,12 +164,29 @@ encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
|
|||
|
||||
|
||||
static int
|
||||
encode_complex (int kind, mpfr_t real, mpfr_t imaginary, unsigned char *buffer,
|
||||
size_t buffer_size)
|
||||
encode_complex (int kind,
|
||||
#ifdef HAVE_mpc
|
||||
mpc_t cmplx,
|
||||
#else
|
||||
mpfr_t real, mpfr_t imaginary,
|
||||
#endif
|
||||
unsigned char *buffer, size_t buffer_size)
|
||||
{
|
||||
int size;
|
||||
size = encode_float (kind, real, &buffer[0], buffer_size);
|
||||
size += encode_float (kind, imaginary, &buffer[size], buffer_size - size);
|
||||
size = encode_float (kind,
|
||||
#ifdef HAVE_mpc
|
||||
mpc_realref (cmplx),
|
||||
#else
|
||||
real,
|
||||
#endif
|
||||
&buffer[0], buffer_size);
|
||||
size += encode_float (kind,
|
||||
#ifdef HAVE_mpc
|
||||
mpc_imagref (cmplx),
|
||||
#else
|
||||
imaginary,
|
||||
#endif
|
||||
&buffer[size], buffer_size - size);
|
||||
return size;
|
||||
}
|
||||
|
||||
|
|
@ -266,8 +283,14 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
|
|||
return encode_float (source->ts.kind, source->value.real, buffer,
|
||||
buffer_size);
|
||||
case BT_COMPLEX:
|
||||
return encode_complex (source->ts.kind, source->value.complex.r,
|
||||
source->value.complex.i, buffer, buffer_size);
|
||||
return encode_complex (source->ts.kind,
|
||||
#ifdef HAVE_mpc
|
||||
source->value.complex,
|
||||
#else
|
||||
source->value.complex.r,
|
||||
source->value.complex.i,
|
||||
#endif
|
||||
buffer, buffer_size);
|
||||
case BT_LOGICAL:
|
||||
return encode_logical (source->ts.kind, source->value.logical, buffer,
|
||||
buffer_size);
|
||||
|
|
@ -368,12 +391,28 @@ gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
|
|||
|
||||
int
|
||||
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
|
||||
mpfr_t real, mpfr_t imaginary)
|
||||
#ifdef HAVE_mpc
|
||||
mpc_t complex
|
||||
#else
|
||||
mpfr_t real, mpfr_t imaginary
|
||||
#endif
|
||||
)
|
||||
{
|
||||
int size;
|
||||
size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
|
||||
size = gfc_interpret_float (kind, &buffer[0], buffer_size,
|
||||
#ifdef HAVE_mpc
|
||||
mpc_realref (complex)
|
||||
#else
|
||||
real
|
||||
#endif
|
||||
);
|
||||
size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
|
||||
imaginary);
|
||||
#ifdef HAVE_mpc
|
||||
mpc_imagref (complex)
|
||||
#else
|
||||
imaginary
|
||||
#endif
|
||||
);
|
||||
return size;
|
||||
}
|
||||
|
||||
|
|
@ -520,8 +559,13 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
|
|||
case BT_COMPLEX:
|
||||
result->representation.length =
|
||||
gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
|
||||
#ifdef HAVE_mpc
|
||||
result->value.complex
|
||||
#else
|
||||
result->value.complex.r,
|
||||
result->value.complex.i);
|
||||
result->value.complex.i
|
||||
#endif
|
||||
);
|
||||
break;
|
||||
|
||||
case BT_LOGICAL:
|
||||
|
|
@ -722,10 +766,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
|
|||
}
|
||||
else
|
||||
{
|
||||
#ifdef HAVE_mpc
|
||||
mpc_init2 (expr->value.complex, mpfr_get_default_prec());
|
||||
#else
|
||||
mpfr_init (expr->value.complex.r);
|
||||
mpfr_init (expr->value.complex.i);
|
||||
#endif
|
||||
gfc_interpret_complex (ts->kind, buffer, buffer_size,
|
||||
expr->value.complex.r, expr->value.complex.i);
|
||||
#ifdef HAVE_mpc
|
||||
expr->value.complex
|
||||
#else
|
||||
expr->value.complex.r, expr->value.complex.i
|
||||
#endif
|
||||
);
|
||||
}
|
||||
expr->is_boz = 0;
|
||||
expr->ts.type = ts->type;
|
||||
|
|
|
|||
|
|
@ -39,7 +39,11 @@ int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t);
|
|||
|
||||
int gfc_interpret_integer (int, unsigned char *, size_t, mpz_t);
|
||||
int gfc_interpret_float (int, unsigned char *, size_t, mpfr_t);
|
||||
#ifdef HAVE_mpc
|
||||
int gfc_interpret_complex (int, unsigned char *, size_t, mpc_t);
|
||||
#else
|
||||
int gfc_interpret_complex (int, unsigned char *, size_t, mpfr_t, mpfr_t);
|
||||
#endif
|
||||
int gfc_interpret_logical (int, unsigned char *, size_t, int *);
|
||||
int gfc_interpret_character (unsigned char *, size_t, gfc_expr *);
|
||||
int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
|
||||
|
|
|
|||
|
|
@ -307,9 +307,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
|
|||
expr->representation.string));
|
||||
else
|
||||
{
|
||||
tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r,
|
||||
tree real = gfc_conv_mpfr_to_tree (mpc_realref (expr->value.complex),
|
||||
expr->ts.kind, expr->is_snan);
|
||||
tree imag = gfc_conv_mpfr_to_tree (expr->value.complex.i,
|
||||
tree imag = gfc_conv_mpfr_to_tree (mpc_imagref (expr->value.complex),
|
||||
expr->ts.kind, expr->is_snan);
|
||||
|
||||
return build_complex (gfc_typenode_for_spec (&expr->ts),
|
||||
|
|
|
|||
|
|
@ -4407,10 +4407,10 @@ is_zero_initializer_p (gfc_expr * expr)
|
|||
return expr->value.logical == 0;
|
||||
|
||||
case BT_COMPLEX:
|
||||
return mpfr_zero_p (expr->value.complex.r)
|
||||
&& MPFR_SIGN (expr->value.complex.r) >= 0
|
||||
&& mpfr_zero_p (expr->value.complex.i)
|
||||
&& MPFR_SIGN (expr->value.complex.i) >= 0;
|
||||
return mpfr_zero_p (mpc_realref (expr->value.complex))
|
||||
&& MPFR_SIGN (mpc_realref (expr->value.complex)) >= 0
|
||||
&& mpfr_zero_p (mpc_imagref (expr->value.complex))
|
||||
&& MPFR_SIGN (mpc_imagref (expr->value.complex)) >= 0;
|
||||
|
||||
default:
|
||||
break;
|
||||
|
|
|
|||
Loading…
Reference in New Issue