Skip to content

R
riscv-gcc-1
Commit eb6f9a86 by Kaveh R. Ghazi Committed by Kaveh Ghazi
Options

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
parent 642324bb
Showing with 167 additions and 65 deletions
gcc/fortran/ChangeLog
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> 2009-06-19 Ian Lance Taylor <iant@google.com>
* cpp.c (struct gfc_cpp_option_data): Give this struct, used for * cpp.c (struct gfc_cpp_option_data): Give this struct, used for
......
gcc/fortran/dump-parse-tree.c
...@@ -402,13 +402,15 @@ show_expr (gfc_expr *p) ...@@ -402,13 +402,15 @@ show_expr (gfc_expr *p)
case BT_COMPLEX: case BT_COMPLEX:
fputs ("(complex ", dumpfile); 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) if (p->ts.kind != gfc_default_complex_kind)
fprintf (dumpfile, "_%d", p->ts.kind); fprintf (dumpfile, "_%d", p->ts.kind);
fputc (' ', dumpfile); 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) if (p->ts.kind != gfc_default_complex_kind)
fprintf (dumpfile, "_%d", p->ts.kind); fprintf (dumpfile, "_%d", p->ts.kind);
......
gcc/fortran/expr.c
...@@ -156,8 +156,12 @@ free_expr0 (gfc_expr *e) ...@@ -156,8 +156,12 @@ free_expr0 (gfc_expr *e)
break; break;
case BT_COMPLEX: case BT_COMPLEX:
#ifdef HAVE_mpc
mpc_clear (e->value.complex);
#else
mpfr_clear (e->value.complex.r); mpfr_clear (e->value.complex.r);
mpfr_clear (e->value.complex.i); mpfr_clear (e->value.complex.i);
#endif
break; break;
default: default:
...@@ -439,10 +443,15 @@ gfc_copy_expr (gfc_expr *p) ...@@ -439,10 +443,15 @@ gfc_copy_expr (gfc_expr *p)
case BT_COMPLEX: case BT_COMPLEX:
gfc_set_model_kind (q->ts.kind); 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.r);
mpfr_init (q->value.complex.i); mpfr_init (q->value.complex.i);
mpfr_set (q->value.complex.r, p->value.complex.r, GFC_RND_MODE); 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); mpfr_set (q->value.complex.i, p->value.complex.i, GFC_RND_MODE);
#endif
break; break;
case BT_CHARACTER: case BT_CHARACTER:
......
gcc/fortran/gfortran.h
...@@ -1555,6 +1555,12 @@ gfc_intrinsic_sym; ...@@ -1555,6 +1555,12 @@ gfc_intrinsic_sym;
#include <gmp.h> #include <gmp.h>
#include <mpfr.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_RND_MODE GMP_RNDN
#define GFC_MPC_RND_MODE MPC_RNDNN #define GFC_MPC_RND_MODE MPC_RNDNN
...@@ -1613,10 +1619,14 @@ typedef struct gfc_expr ...@@ -1613,10 +1619,14 @@ typedef struct gfc_expr
mpfr_t real; mpfr_t real;
#ifdef HAVE_mpc
mpc_t
#else
struct struct
{ {
mpfr_t r, i; mpfr_t r, i;
} }
#endif
complex; complex;
struct struct
......
gcc/fortran/module.c
...@@ -3027,8 +3027,8 @@ mio_expr (gfc_expr **ep) ...@@ -3027,8 +3027,8 @@ mio_expr (gfc_expr **ep)
case BT_COMPLEX: case BT_COMPLEX:
gfc_set_model_kind (e->ts.kind); gfc_set_model_kind (e->ts.kind);
mio_gmp_real (&e->value.complex.r); mio_gmp_real (&mpc_realref (e->value.complex));
mio_gmp_real (&e->value.complex.i); mio_gmp_real (&mpc_imagref (e->value.complex));
break; break;
case BT_LOGICAL: case BT_LOGICAL:
......
gcc/fortran/resolve.c
...@@ -7610,31 +7610,39 @@ build_default_init_expr (gfc_symbol *sym) ...@@ -7610,31 +7610,39 @@ build_default_init_expr (gfc_symbol *sym)
break; break;
case BT_COMPLEX: 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.r);
mpfr_init (init_expr->value.complex.i); mpfr_init (init_expr->value.complex.i);
#endif
switch (gfc_option.flag_init_real) switch (gfc_option.flag_init_real)
{ {
case GFC_INIT_REAL_SNAN: case GFC_INIT_REAL_SNAN:
init_expr->is_snan = 1; init_expr->is_snan = 1;
/* Fall through. */ /* Fall through. */
case GFC_INIT_REAL_NAN: case GFC_INIT_REAL_NAN:
mpfr_set_nan (init_expr->value.complex.r); mpfr_set_nan (mpc_realref (init_expr->value.complex));
mpfr_set_nan (init_expr->value.complex.i); mpfr_set_nan (mpc_imagref (init_expr->value.complex));
break; break;
case GFC_INIT_REAL_INF: case GFC_INIT_REAL_INF:
mpfr_set_inf (init_expr->value.complex.r, 1); mpfr_set_inf (mpc_realref (init_expr->value.complex), 1);
mpfr_set_inf (init_expr->value.complex.i, 1); mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1);
break; break;
case GFC_INIT_REAL_NEG_INF: case GFC_INIT_REAL_NEG_INF:
mpfr_set_inf (init_expr->value.complex.r, -1); mpfr_set_inf (mpc_realref (init_expr->value.complex), -1);
mpfr_set_inf (init_expr->value.complex.i, -1); mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1);
break; break;
case GFC_INIT_REAL_ZERO: 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.r, 0.0, GFC_RND_MODE);
mpfr_set_ui (init_expr->value.complex.i, 0.0, GFC_RND_MODE); mpfr_set_ui (init_expr->value.complex.i, 0.0, GFC_RND_MODE);
#endif
break; break;
default: default:
......
gcc/fortran/simplify.c
...@@ -214,26 +214,6 @@ convert_mpz_to_signed (mpz_t x, int bitsize) ...@@ -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. */ /* Test that the expression is an constant array. */
static bool static bool
...@@ -303,8 +283,12 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array) ...@@ -303,8 +283,12 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array)
break; break;
case BT_COMPLEX: 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.r, init, GFC_RND_MODE);
mpfr_set_si (e->value.complex.i, 0, GFC_RND_MODE); mpfr_set_si (e->value.complex.i, 0, GFC_RND_MODE);
#endif
break; break;
case BT_CHARACTER: case BT_CHARACTER:
...@@ -660,8 +644,12 @@ gfc_simplify_abs (gfc_expr *e) ...@@ -660,8 +644,12 @@ gfc_simplify_abs (gfc_expr *e)
gfc_set_model_kind (e->ts.kind); 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, mpfr_hypot (result->value.real, e->value.complex.r,
e->value.complex.i, GFC_RND_MODE); e->value.complex.i, GFC_RND_MODE);
#endif
result = range_check (result, "CABS"); result = range_check (result, "CABS");
break; break;
...@@ -867,7 +855,7 @@ gfc_simplify_aimag (gfc_expr *e) ...@@ -867,7 +855,7 @@ gfc_simplify_aimag (gfc_expr *e)
return NULL; return NULL;
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); 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"); return range_check (result, "AIMAG");
} }
...@@ -1286,22 +1274,36 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ...@@ -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); result = gfc_constant_result (BT_COMPLEX, kind, &x->where);
#ifndef HAVE_mpc
mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE); mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
#endif
switch (x->ts.type) switch (x->ts.type)
{ {
case BT_INTEGER: case BT_INTEGER:
if (!x->is_boz) 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); mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
#endif
break; break;
case BT_REAL: 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); mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
#endif
break; break;
case BT_COMPLEX: 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.r, x->value.complex.r, GFC_RND_MODE);
mpfr_set (result->value.complex.i, x->value.complex.i, GFC_RND_MODE); mpfr_set (result->value.complex.i, x->value.complex.i, GFC_RND_MODE);
#endif
break; break;
default: default:
...@@ -1314,12 +1316,13 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ...@@ -1314,12 +1316,13 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
{ {
case BT_INTEGER: case BT_INTEGER:
if (!y->is_boz) if (!y->is_boz)
mpfr_set_z (result->value.complex.i, y->value.integer, mpfr_set_z (mpc_imagref (result->value.complex),
GFC_RND_MODE); y->value.integer, GFC_RND_MODE);
break; break;
case BT_REAL: 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; break;
default: default:
...@@ -1336,7 +1339,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ...@@ -1336,7 +1339,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
ts.type = BT_REAL; ts.type = BT_REAL;
if (!gfc_convert_boz (x, &ts)) if (!gfc_convert_boz (x, &ts))
return &gfc_bad_expr; 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) if (y && y->is_boz)
...@@ -1347,7 +1351,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ...@@ -1347,7 +1351,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
ts.type = BT_REAL; ts.type = BT_REAL;
if (!gfc_convert_boz (y, &ts)) if (!gfc_convert_boz (y, &ts))
return &gfc_bad_expr; 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); return range_check (result, name);
...@@ -1429,7 +1434,11 @@ gfc_simplify_conjg (gfc_expr *e) ...@@ -1429,7 +1434,11 @@ gfc_simplify_conjg (gfc_expr *e)
return NULL; return NULL;
result = gfc_copy_expr (e); 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); mpfr_neg (result->value.complex.i, result->value.complex.i, GFC_RND_MODE);
#endif
return range_check (result, "CONJG"); return range_check (result, "CONJG");
} }
...@@ -1453,8 +1462,7 @@ gfc_simplify_cos (gfc_expr *x) ...@@ -1453,8 +1462,7 @@ gfc_simplify_cos (gfc_expr *x)
case BT_COMPLEX: case BT_COMPLEX:
gfc_set_model_kind (x->ts.kind); gfc_set_model_kind (x->ts.kind);
#ifdef HAVE_mpc #ifdef HAVE_mpc
call_mpc_func (result->value.complex.r, result->value.complex.i, mpc_cos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
x->value.complex.r, x->value.complex.i, mpc_cos);
#else #else
{ {
mpfr_t xp, xq; mpfr_t xp, xq;
...@@ -1898,8 +1906,7 @@ gfc_simplify_exp (gfc_expr *x) ...@@ -1898,8 +1906,7 @@ gfc_simplify_exp (gfc_expr *x)
case BT_COMPLEX: case BT_COMPLEX:
gfc_set_model_kind (x->ts.kind); gfc_set_model_kind (x->ts.kind);
#ifdef HAVE_mpc #ifdef HAVE_mpc
call_mpc_func (result->value.complex.r, result->value.complex.i, mpc_exp (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
x->value.complex.r, x->value.complex.i, mpc_exp);
#else #else
{ {
mpfr_t xp, xq; mpfr_t xp, xq;
...@@ -3281,8 +3288,8 @@ gfc_simplify_log (gfc_expr *x) ...@@ -3281,8 +3288,8 @@ gfc_simplify_log (gfc_expr *x)
break; break;
case BT_COMPLEX: case BT_COMPLEX:
if ((mpfr_sgn (x->value.complex.r) == 0) if ((mpfr_sgn (mpc_realref (x->value.complex)) == 0)
&& (mpfr_sgn (x->value.complex.i) == 0)) && (mpfr_sgn (mpc_imagref (x->value.complex)) == 0))
{ {
gfc_error ("Complex argument of LOG at %L cannot be zero", gfc_error ("Complex argument of LOG at %L cannot be zero",
&x->where); &x->where);
...@@ -3292,8 +3299,7 @@ gfc_simplify_log (gfc_expr *x) ...@@ -3292,8 +3299,7 @@ gfc_simplify_log (gfc_expr *x)
gfc_set_model_kind (x->ts.kind); gfc_set_model_kind (x->ts.kind);
#ifdef HAVE_mpc #ifdef HAVE_mpc
call_mpc_func (result->value.complex.r, result->value.complex.i, mpc_log (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
x->value.complex.r, x->value.complex.i, mpc_log);
#else #else
{ {
mpfr_t xr, xi; mpfr_t xr, xi;
...@@ -4204,7 +4210,11 @@ gfc_simplify_realpart (gfc_expr *e) ...@@ -4204,7 +4210,11 @@ gfc_simplify_realpart (gfc_expr *e)
return NULL; return NULL;
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where); 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); mpfr_set (result->value.real, e->value.complex.r, GFC_RND_MODE);
#endif
return range_check (result, "REALPART"); return range_check (result, "REALPART");
} }
...@@ -4986,8 +4996,7 @@ gfc_simplify_sin (gfc_expr *x) ...@@ -4986,8 +4996,7 @@ gfc_simplify_sin (gfc_expr *x)
case BT_COMPLEX: case BT_COMPLEX:
gfc_set_model (x->value.real); gfc_set_model (x->value.real);
#ifdef HAVE_mpc #ifdef HAVE_mpc
call_mpc_func (result->value.complex.r, result->value.complex.i, mpc_sin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
x->value.complex.r, x->value.complex.i, mpc_sin);
#else #else
{ {
mpfr_t xp, xq; mpfr_t xp, xq;
...@@ -5200,8 +5209,7 @@ gfc_simplify_sqrt (gfc_expr *e) ...@@ -5200,8 +5209,7 @@ gfc_simplify_sqrt (gfc_expr *e)
case BT_COMPLEX: case BT_COMPLEX:
gfc_set_model (e->value.real); gfc_set_model (e->value.real);
#ifdef HAVE_mpc #ifdef HAVE_mpc
call_mpc_func (result->value.complex.r, result->value.complex.i, mpc_sqrt (result->value.complex, e->value.complex, GFC_MPC_RND_MODE);
e->value.complex.r, e->value.complex.i, mpc_sqrt);
#else #else
{ {
/* Formula taken from Numerical Recipes to avoid over- and /* Formula taken from Numerical Recipes to avoid over- and
......
gcc/fortran/target-memory.c
...@@ -164,12 +164,29 @@ encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size) ...@@ -164,12 +164,29 @@ encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
static int static int
encode_complex (int kind, mpfr_t real, mpfr_t imaginary, unsigned char *buffer, encode_complex (int kind,
size_t buffer_size) #ifdef HAVE_mpc
mpc_t cmplx,
#else
mpfr_t real, mpfr_t imaginary,
#endif
unsigned char *buffer, size_t buffer_size)
{ {
int size; int size;
size = encode_float (kind, real, &buffer[0], buffer_size); size = encode_float (kind,
size += encode_float (kind, imaginary, &buffer[size], buffer_size - size); #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; return size;
} }
...@@ -266,8 +283,14 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, ...@@ -266,8 +283,14 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
return encode_float (source->ts.kind, source->value.real, buffer, return encode_float (source->ts.kind, source->value.real, buffer,
buffer_size); buffer_size);
case BT_COMPLEX: case BT_COMPLEX:
return encode_complex (source->ts.kind, source->value.complex.r, return encode_complex (source->ts.kind,
source->value.complex.i, buffer, buffer_size); #ifdef HAVE_mpc
source->value.complex,
#else
source->value.complex.r,
source->value.complex.i,
#endif
buffer, buffer_size);
case BT_LOGICAL: case BT_LOGICAL:
return encode_logical (source->ts.kind, source->value.logical, buffer, return encode_logical (source->ts.kind, source->value.logical, buffer,
buffer_size); buffer_size);
...@@ -368,12 +391,28 @@ gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size, ...@@ -368,12 +391,28 @@ gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
int int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size, 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; 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, size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
imaginary); #ifdef HAVE_mpc
mpc_imagref (complex)
#else
imaginary
#endif
);
return size; return size;
} }
...@@ -520,8 +559,13 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, ...@@ -520,8 +559,13 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
case BT_COMPLEX: case BT_COMPLEX:
result->representation.length = result->representation.length =
gfc_interpret_complex (result->ts.kind, buffer, buffer_size, gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
#ifdef HAVE_mpc
result->value.complex
#else
result->value.complex.r, result->value.complex.r,
result->value.complex.i); result->value.complex.i
#endif
);
break; break;
case BT_LOGICAL: case BT_LOGICAL:
...@@ -722,10 +766,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts) ...@@ -722,10 +766,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
} }
else 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.r);
mpfr_init (expr->value.complex.i); mpfr_init (expr->value.complex.i);
#endif
gfc_interpret_complex (ts->kind, buffer, buffer_size, 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->is_boz = 0;
expr->ts.type = ts->type; expr->ts.type = ts->type;
......
gcc/fortran/target-memory.h
...@@ -39,7 +39,11 @@ int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t); ...@@ -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_integer (int, unsigned char *, size_t, mpz_t);
int gfc_interpret_float (int, unsigned char *, size_t, mpfr_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); 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_logical (int, unsigned char *, size_t, int *);
int gfc_interpret_character (unsigned char *, size_t, gfc_expr *); int gfc_interpret_character (unsigned char *, size_t, gfc_expr *);
int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *); int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
......
gcc/fortran/trans-const.c
...@@ -307,9 +307,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr) ...@@ -307,9 +307,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
expr->representation.string)); expr->representation.string));
else 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); 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); expr->ts.kind, expr->is_snan);
return build_complex (gfc_typenode_for_spec (&expr->ts), return build_complex (gfc_typenode_for_spec (&expr->ts),
......
gcc/fortran/trans-expr.c
...@@ -4407,10 +4407,10 @@ is_zero_initializer_p (gfc_expr * expr) ...@@ -4407,10 +4407,10 @@ is_zero_initializer_p (gfc_expr * expr)
return expr->value.logical == 0; return expr->value.logical == 0;
case BT_COMPLEX: case BT_COMPLEX:
return mpfr_zero_p (expr->value.complex.r) return mpfr_zero_p (mpc_realref (expr->value.complex))
&& MPFR_SIGN (expr->value.complex.r) >= 0 && MPFR_SIGN (mpc_realref (expr->value.complex)) >= 0
&& mpfr_zero_p (expr->value.complex.i) && mpfr_zero_p (mpc_imagref (expr->value.complex))
&& MPFR_SIGN (expr->value.complex.i) >= 0; && MPFR_SIGN (mpc_imagref (expr->value.complex)) >= 0;
default: default:
break; break;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment