This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH FORTRAN]: Use mpc_t for representing complex numbers
- From: "Kaveh R. GHAZI" <ghazi at caip dot rutgers dot edu>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Wed, 17 Jun 2009 11:31:38 -0400 (EDT)
- Subject: [PATCH FORTRAN]: Use mpc_t for representing complex numbers
As noted here:
http://gcc.gnu.org/ml/fortran/2009-05/msg00382.html
a goal for gfortran would be to convert to using mpc_t to represent
complex numbers instead of a pair of mpfr_t. The patch below does this.
Since we're in the optional phase of MPC, the patch contains a significant
amount of cpp conditionals and uglifies the code. However this is
temporary until we make MPC hard-required. I felt it was better to suffer
the temporary uglification now so that the new code could be better tested
rather than doing this conversion later in the release cycle. Once we
hard-require MPC, a significant amount of code can be removed. I.e. we
can delete all the HAVE_mpc #else clauses, which in some cases are rather
large.
A couple of notes:
1. MPC accesses the real/imag parts of a complex number using accessor
macros mpc_realref/mpc_imagref. I provided a fallback definition for
mpc_realref/mpc_imagref for the non-MPC versions of the code which simply
accesses the mpfr_t pair. This reduced the amount of cpp conditionals.
2. MPC setter functions have single value forms that set the real part to
the supplied value and the imaginary part to zero. So when you see bits
omitted that set the imaginary part to zero, that's where it went.
3. I preserved the current gfortran behavior of divide-by-zero to always
return NaN, see PR40318. If at some point that PR is resolved and
gfortran wants to follow the C99 behavior for these corner cases, it's
very easy to remove my special case code below and purely rely on MPC
which follows C99 for complex divide.
Tested on x86_64-unknown-linux-gnu with and without MPC, no fortran
regressions.
Okay for mainline?
Thanks,
--Kaveh
2009-06-16 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.
diff -rup orig/egcc-SVN20090616/gcc/fortran/gfortran.h egcc-SVN20090616/gcc/fortran/gfortran.h
--- orig/egcc-SVN20090616/gcc/fortran/gfortran.h 2009-06-13 02:02:16.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/gfortran.h 2009-06-17 02:42:33.000000000 +0200
@@ -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
diff -rup orig/egcc-SVN20090616/gcc/fortran/arith.c egcc-SVN20090616/gcc/fortran/arith.c
--- orig/egcc-SVN20090616/gcc/fortran/arith.c 2009-06-13 02:02:16.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/arith.c 2009-06-17 03:00:45.000000000 +0200
@@ -429,8 +429,12 @@ gfc_constant_result (bt type, int kind,
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_exp
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
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
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
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
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,36 @@ gfc_arith_divide (gfc_expr *op1, gfc_exp
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)
+ {
+ /* For 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 +880,8 @@ gfc_arith_divide (gfc_expr *op1, gfc_exp
GFC_RND_MODE);
mpfr_clears (x, y, div, NULL);
+ }
+#endif
break;
default:
@@ -851,9 +900,13 @@ gfc_arith_divide (gfc_expr *op1, gfc_exp
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,9 +920,10 @@ 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
}
-
/* Raise a complex number to positive power (power > 0).
This function will modify the content of power.
@@ -883,7 +937,7 @@ complex_pow (gfc_expr *result, gfc_expr
{
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,21 @@ complex_pow (gfc_expr *result, gfc_expr
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 */
+#ifdef HAVE_mpc
+ mpfr_set (x_r, mpc_realref (base->value.complex), GFC_RND_MODE);
+ mpfr_set (x_i, mpc_imagref (base->value.complex), GFC_RND_MODE);
+#else
mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE);
mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE);
+#endif
/* 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 +973,8 @@ complex_pow (gfc_expr *result, gfc_expr
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))
@@ -931,7 +994,6 @@ complex_pow (gfc_expr *result, gfc_expr
mpfr_clears (x_r, x_i, tmp, re, im, NULL);
}
-
/* Raise a number to a power. */
static arith
@@ -966,8 +1028,12 @@ arith_power (gfc_expr *op1, gfc_expr *op
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 +1155,6 @@ arith_power (gfc_expr *op1, gfc_expr *op
case BT_COMPLEX:
{
- mpfr_t x, y, r, t;
-
if (init_flag)
{
if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
@@ -1099,16 +1163,27 @@ arith_power (gfc_expr *op1, gfc_expr *op
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 +1191,30 @@ arith_power (gfc_expr *op1, gfc_expr *op
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 +1332,12 @@ gfc_compare_expr (gfc_expr *op1, gfc_exp
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 +2206,13 @@ gfc_convert_complex (gfc_expr *real, gfc
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 +2332,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 +2415,20 @@ gfc_real2complex (gfc_expr *src, int kin
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 +2451,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 +2475,11 @@ gfc_complex2real (gfc_expr *src, int kin
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 +2510,20 @@ gfc_complex2complex (gfc_expr *src, int
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 +2532,13 @@ gfc_complex2complex (gfc_expr *src, int
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 +2686,13 @@ gfc_hollerith2complex (gfc_expr *src, in
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;
}
diff -rup orig/egcc-SVN20090616/gcc/fortran/dump-parse-tree.c egcc-SVN20090616/gcc/fortran/dump-parse-tree.c
--- orig/egcc-SVN20090616/gcc/fortran/dump-parse-tree.c 2009-05-15 02:02:23.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/dump-parse-tree.c 2009-06-17 02:51:17.000000000 +0200
@@ -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);
diff -rup orig/egcc-SVN20090616/gcc/fortran/expr.c egcc-SVN20090616/gcc/fortran/expr.c
--- orig/egcc-SVN20090616/gcc/fortran/expr.c 2009-06-12 02:01:45.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/expr.c 2009-06-17 02:50:55.000000000 +0200
@@ -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:
diff -rup orig/egcc-SVN20090616/gcc/fortran/module.c egcc-SVN20090616/gcc/fortran/module.c
--- orig/egcc-SVN20090616/gcc/fortran/module.c 2009-06-04 02:01:57.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/module.c 2009-06-17 02:50:29.000000000 +0200
@@ -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:
diff -rup orig/egcc-SVN20090616/gcc/fortran/resolve.c egcc-SVN20090616/gcc/fortran/resolve.c
--- orig/egcc-SVN20090616/gcc/fortran/resolve.c 2009-06-13 02:02:16.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/resolve.c 2009-06-17 02:50:00.000000000 +0200
@@ -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:
diff -rup orig/egcc-SVN20090616/gcc/fortran/simplify.c egcc-SVN20090616/gcc/fortran/simplify.c
--- orig/egcc-SVN20090616/gcc/fortran/simplify.c 2009-06-12 02:01:45.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/simplify.c 2009-06-17 02:49:23.000000000 +0200
@@ -214,26 +214,6 @@ convert_mpz_to_signed (mpz_t x, int bits
}
}
-/* 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,
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_ex
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_ex
{
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_ex
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_ex
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
diff -rup orig/egcc-SVN20090616/gcc/fortran/target-memory.c egcc-SVN20090616/gcc/fortran/target-memory.c
--- orig/egcc-SVN20090616/gcc/fortran/target-memory.c 2009-03-27 23:23:36.000000000 +0100
+++ egcc-SVN20090616/gcc/fortran/target-memory.c 2009-06-17 02:55:49.000000000 +0200
@@ -266,8 +266,10 @@ gfc_target_encode_expr (gfc_expr *source
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,
+ mpc_realref (source->value.complex),
+ mpc_imagref (source->value.complex),
+ buffer, buffer_size);
case BT_LOGICAL:
return encode_logical (source->ts.kind, source->value.logical, buffer,
buffer_size);
@@ -368,12 +370,28 @@ gfc_interpret_float (int kind, unsigned
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 +538,13 @@ gfc_target_interpret_expr (unsigned char
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 +745,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typ
}
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;
diff -rup orig/egcc-SVN20090616/gcc/fortran/target-memory.h egcc-SVN20090616/gcc/fortran/target-memory.h
--- orig/egcc-SVN20090616/gcc/fortran/target-memory.h 2008-05-19 02:02:28.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/target-memory.h 2009-06-17 02:55:49.000000000 +0200
@@ -39,7 +39,11 @@ int gfc_target_encode_expr (gfc_expr *,
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 *);
diff -rup orig/egcc-SVN20090616/gcc/fortran/trans-const.c egcc-SVN20090616/gcc/fortran/trans-const.c
--- orig/egcc-SVN20090616/gcc/fortran/trans-const.c 2009-04-23 02:02:19.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/trans-const.c 2009-06-17 02:51:49.000000000 +0200
@@ -307,9 +307,9 @@ gfc_conv_constant_to_tree (gfc_expr * ex
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),
diff -rup orig/egcc-SVN20090616/gcc/fortran/trans-expr.c egcc-SVN20090616/gcc/fortran/trans-expr.c
--- orig/egcc-SVN20090616/gcc/fortran/trans-expr.c 2009-06-13 02:02:16.000000000 +0200
+++ egcc-SVN20090616/gcc/fortran/trans-expr.c 2009-06-17 02:48:36.000000000 +0200
@@ -4405,10 +4405,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;