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

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>
 
 	* 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)
 	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);
 

gcc/fortran/expr.c

@@ -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:

gcc/fortran/gfortran.h

@@ -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

gcc/fortran/module.c

@@ -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:

gcc/fortran/resolve.c

@@ -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:

gcc/fortran/simplify.c

@@ -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

gcc/fortran/target-memory.c

@@ -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;

gcc/fortran/target-memory.h

@@ -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 *);

gcc/fortran/trans-const.c

@@ -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),

gcc/fortran/trans-expr.c

@@ -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;