re PR other/40302 (GCC must hard-require MPC before release)

	PR other/40302
	* arith.c: Remove HAVE_mpc* checks throughout.
	* expr.c: Likewise.
	* gfortran.h: Likewise.
	* resolve.c: Likewise.
	* simplify.c: Likewise.
	* target-memory.c: Likewise.
	* target-memory.h: Likewise.

From-SVN: r155043

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f8d45a4d731c1a5f83002462619d46e7fc0d2908..9d0506e1d53e109a948e671cf8c06c3fed0698c7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2009-12-07  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+       PR other/40302
+       * arith.c: Remove HAVE_mpc* checks throughout.
+       * expr.c: Likewise.
+       * gfortran.h: Likewise.
+       * resolve.c: Likewise.
+       * simplify.c: Likewise.
+       * target-memory.c: Likewise.
+       * target-memory.h: Likewise.
+
 2009-12-06  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/40904

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index bd0ca6122cf5fd61f6a7430629db5aa7cc80e9fc..d119d1231f9e65e64ca75cb41fe5d7b37da9efd0 100644 (file)
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -429,12 +429,7 @@ 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:
@@ -639,12 +634,7 @@ 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:
@@ -677,16 +667,8 @@ 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:
@@ -719,16 +701,8 @@ 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:
@@ -762,26 +736,8 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 
     case BT_COMPLEX:
       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);
-
-      mpfr_mul (x, op1->value.complex.r, op2->value.complex.r, GFC_RND_MODE);
-      mpfr_mul (y, op1->value.complex.i, op2->value.complex.i, GFC_RND_MODE);
-      mpfr_sub (result->value.complex.r, x, y, GFC_RND_MODE);
-
-      mpfr_mul (x, op1->value.complex.r, op2->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (y, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE);
-      mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE);
-
-      mpfr_clears (x, y, NULL);
-    }
-#endif
       break;
 
     default:
@@ -829,13 +785,7 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
       break;
 
     case BT_COMPLEX:
-      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
+      if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0
          && gfc_option.flag_range_check == 1)
        {
          rc = ARITH_DIV0;
@@ -843,8 +793,6 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
        }
 
       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
@@ -855,32 +803,6 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
       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);
-
-      mpfr_mul (x, op2->value.complex.r, op2->value.complex.r, GFC_RND_MODE);
-      mpfr_mul (y, op2->value.complex.i, op2->value.complex.i, GFC_RND_MODE);
-      mpfr_add (div, x, y, GFC_RND_MODE);
-
-      mpfr_mul (x, op1->value.complex.r, op2->value.complex.r, GFC_RND_MODE);
-      mpfr_mul (y, op1->value.complex.i, op2->value.complex.i, GFC_RND_MODE);
-      mpfr_add (result->value.complex.r, x, y, GFC_RND_MODE);
-      mpfr_div (result->value.complex.r, result->value.complex.r, div,
-               GFC_RND_MODE);
-
-      mpfr_mul (x, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE);
-      mpfr_mul (y, op1->value.complex.r, op2->value.complex.i, GFC_RND_MODE);
-      mpfr_sub (result->value.complex.i, x, y, GFC_RND_MODE);
-      mpfr_div (result->value.complex.i, result->value.complex.i, div,
-               GFC_RND_MODE);
-
-      mpfr_clears (x, y, div, NULL);
-    }
-#endif
       break;
 
     default:
@@ -893,107 +815,6 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   return check_result (rc, op1, result, resultp);
 }
 
-
-/* Compute the reciprocal of a complex number (guaranteed nonzero).  */
-
-#if ! defined(HAVE_mpc_pow)
-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;
-
-  mpfr_init (mod);
-  mpfr_init (tmp);
-
-  mpfr_mul (mod, op->value.complex.r, op->value.complex.r, GFC_RND_MODE);
-  mpfr_mul (tmp, op->value.complex.i, op->value.complex.i, GFC_RND_MODE);
-  mpfr_add (mod, mod, tmp, GFC_RND_MODE);
-
-  mpfr_div (op->value.complex.r, op->value.complex.r, mod, GFC_RND_MODE);
-
-  mpfr_neg (op->value.complex.i, op->value.complex.i, GFC_RND_MODE);
-  mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE);
-
-  mpfr_clears (tmp, mod, NULL);
-  }
-#endif
-}
-#endif /* ! HAVE_mpc_pow */
-
-
-/* Raise a complex number to positive power (power > 0).
-   This function will modify the content of power.
-
-   Use Binary Method, which is not an optimal but a simple and reasonable
-   arithmetic. See section 4.6.3, "Evaluation of Powers" of Donald E. Knuth,
-   "Seminumerical Algorithms", Vol. 2, "The Art of Computer Programming",
-   3rd Edition, 1998.  */
-
-#if ! defined(HAVE_mpc_pow)
-static void
-complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power)
-{
-  mpfr_t x_r, x_i, tmp, re, im;
-
-  gfc_set_model (mpc_realref (base->value.complex));
-  mpfr_init (x_r);
-  mpfr_init (x_i);
-  mpfr_init (tmp);
-  mpfr_init (re);
-  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, 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.  */
-#define CMULT(res_r,res_i,a_r,a_i,b_r,b_i) \
-    mpfr_mul (re, a_r, b_r, GFC_RND_MODE), \
-    mpfr_mul (tmp, a_i, b_i, GFC_RND_MODE), \
-    mpfr_sub (re, re, tmp, GFC_RND_MODE), \
-    \
-    mpfr_mul (im, a_r, b_i, GFC_RND_MODE), \
-    mpfr_mul (tmp, a_i, b_r, GFC_RND_MODE), \
-    mpfr_add (res_i, im, tmp, GFC_RND_MODE), \
-    mpfr_set (res_r, re, GFC_RND_MODE)
-  
-#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))
-    {
-      /* if (power & 1) res = res * x; */
-      if (mpz_congruent_ui_p (power, 1, 2))
-       CMULT(res_r,res_i,res_r,res_i,x_r,x_i);
-
-      /* power /= 2; */
-      mpz_fdiv_q_ui (power, power, 2);
-    }
-
-#undef res_r
-#undef res_i
-#undef CMULT
-
-  mpfr_clears (x_r, x_i, tmp, re, im, NULL);
-}
-#endif /* ! HAVE_mpc_pow */
-
-
 /* Raise a number to a power.  */
 
 static arith
@@ -1028,12 +849,7 @@ 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:
@@ -1110,32 +926,8 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
              break;
 
            case BT_COMPLEX:
-             {
-#ifdef HAVE_mpc_pow_z
-               mpc_pow_z (result->value.complex, op1->value.complex,
-                          op2->value.integer, GFC_MPC_RND_MODE);
-#elif defined(HAVE_mpc_pow)
-               mpc_t apower;
-               gfc_set_model (mpc_realref (op1->value.complex));
-               mpc_init2 (apower, mpfr_get_default_prec());
-               mpc_set_z (apower, op2->value.integer, GFC_MPC_RND_MODE);
-               mpc_pow(result->value.complex, op1->value.complex, apower,
-                       GFC_MPC_RND_MODE);
-               mpc_clear (apower);
-#else
-               mpz_t apower;
-
-               /* Compute op1**abs(op2)  */
-               mpz_init (apower);
-               mpz_abs (apower, op2->value.integer);
-               complex_pow (result, op1, apower);
-               mpz_clear (apower);
-
-               /* If (op2 < 0), compute the inverse.  */
-               if (power_sign < 0)
-                 complex_reciprocal (result);
-#endif /* HAVE_mpc_pow */
-             }
+             mpc_pow_z (result->value.complex, op1->value.complex,
+                        op2->value.integer, GFC_MPC_RND_MODE);
              break;
 
            default:
@@ -1176,63 +968,8 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
              return ARITH_PROHIBIT;
          }
 
-#ifdef HAVE_mpc_pow
        mpc_pow (result->value.complex, op1->value.complex,
                 op2->value.complex, GFC_MPC_RND_MODE);
-#else
-       {
-       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;
-         }
-       mpfr_log (r, r, GFC_RND_MODE);
-
-       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, 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, 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 (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);
-       }
-#endif /* HAVE_mpc_pow */
       }
       break;
     default:
@@ -1350,12 +1087,7 @@ 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
 }
 
 
@@ -2224,13 +1956,8 @@ 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;
 }
@@ -2350,12 +2077,7 @@ 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 (mpc_realref (result->value.complex), kind))
       != ARITH_OK)
@@ -2433,12 +2155,7 @@ 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 (mpc_realref (result->value.complex), kind);
 
@@ -2493,11 +2210,7 @@ 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);
 
@@ -2528,12 +2241,7 @@ 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 (mpc_realref (result->value.complex), kind);
 
@@ -2698,13 +2406,7 @@ gfc_hollerith2complex (gfc_expr *src, int kind)
 
   hollerith2representation (result, src);
   gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
-                        result->representation.length,
-#ifdef HAVE_mpc
-                        result->value.complex
-#else
-                        result->value.complex.r, result->value.complex.i
-#endif
-                        );
+                        result->representation.length, result->value.complex);
 
   return result;
 }

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index cbd3172b454793fea349503037f2cab83439141a..c693773ebf20a97d9d84d8eecaac1a7eca7cee0f 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -156,12 +156,7 @@ 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:
@@ -473,15 +468,8 @@ 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 --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e552203cb915849119bcda83fac2c0575ff81766..3a13cfe4b2693727f893de276f030022f694f56c 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1624,19 +1624,7 @@ gfc_class_esym_list;
 
 #include <gmp.h>
 #include <mpfr.h>
-#ifdef HAVE_mpc
 #include <mpc.h>
-# if MPC_VERSION >= MPC_VERSION_NUM(0,6,1)
-#  define HAVE_mpc_pow
-# endif
-# if MPC_VERSION >= MPC_VERSION_NUM(0,7,1)
-#  define HAVE_mpc_arc
-#  define HAVE_mpc_pow_z
-# endif
-#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
 
@@ -1695,15 +1683,7 @@ typedef struct gfc_expr
 
     mpfr_t real;
 
-#ifdef HAVE_mpc
-    mpc_t
-#else
-    struct
-    {
-      mpfr_t r, i;
-    }
-#endif
-    complex;
+    mpc_t complex;
 
     struct
     {

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index bf705c6a09a9253e5739f0eb75bb98f81f98f7f2..6f6cb7816061cc029d3c1c2ccc3de2981e785419 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8649,12 +8649,7 @@ 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:
@@ -8676,12 +8671,7 @@ build_default_init_expr (gfc_symbol *sym)
          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 --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 9856b2eabbd967e736e439f7273b914e0ad916b0..8768cb64de2894b6e0900da3fa781447b5eeaf75 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -283,12 +283,7 @@ 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:
@@ -644,12 +639,7 @@ 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;
 
@@ -749,13 +739,9 @@ gfc_simplify_acos (gfc_expr *x)
        mpfr_acos (result->value.real, x->value.real, GFC_RND_MODE);
        break;
       case BT_COMPLEX:
-#ifdef HAVE_mpc_arc
        result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
        mpc_acos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
        break;
-#else
-       return NULL;
-#endif
       default:
        gfc_internal_error ("in gfc_simplify_acos(): Bad type");
     }
@@ -786,13 +772,9 @@ gfc_simplify_acosh (gfc_expr *x)
        mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
        break;
       case BT_COMPLEX:
-#ifdef HAVE_mpc_arc
        result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
        mpc_acosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
        break;
-#else
-       return NULL;
-#endif
       default:
        gfc_internal_error ("in gfc_simplify_acosh(): Bad type");
     }
@@ -1054,13 +1036,9 @@ gfc_simplify_asin (gfc_expr *x)
        mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
        break;
       case BT_COMPLEX:
-#ifdef HAVE_mpc_arc
        result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
        mpc_asin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
        break;
-#else
-       return NULL;
-#endif
       default:
        gfc_internal_error ("in gfc_simplify_asin(): Bad type");
     }
@@ -1084,13 +1062,9 @@ gfc_simplify_asinh (gfc_expr *x)
        mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
        break;
       case BT_COMPLEX:
-#ifdef HAVE_mpc_arc
        result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
        mpc_asinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
        break;
-#else
-       return NULL;
-#endif
       default:
        gfc_internal_error ("in gfc_simplify_asinh(): Bad type");
     }
@@ -1114,13 +1088,9 @@ gfc_simplify_atan (gfc_expr *x)
        mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
        break;
       case BT_COMPLEX:
-#ifdef HAVE_mpc_arc
        result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
        mpc_atan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
        break;
-#else
-       return NULL;
-#endif
       default:
        gfc_internal_error ("in gfc_simplify_atan(): Bad type");
     }
@@ -1152,13 +1122,9 @@ gfc_simplify_atanh (gfc_expr *x)
        mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
        break;
       case BT_COMPLEX:
-#ifdef HAVE_mpc_arc
        result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
        mpc_atanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
        break;
-#else
-       return NULL;
-#endif
       default:
        gfc_internal_error ("in gfc_simplify_atanh(): Bad type");
     }
@@ -1357,36 +1323,19 @@ 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:
@@ -1517,12 +1466,7 @@ 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");
 }
 
@@ -1544,26 +1488,7 @@ gfc_simplify_cos (gfc_expr *x)
       break;
     case BT_COMPLEX:
       gfc_set_model_kind (x->ts.kind);
-#ifdef HAVE_mpc
       mpc_cos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-    {
-      mpfr_t xp, xq;
-      mpfr_init (xp);
-      mpfr_init (xq);
-
-      mpfr_cos  (xp, x->value.complex.r, GFC_RND_MODE);
-      mpfr_cosh (xq, x->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (result->value.complex.r, xp, xq, GFC_RND_MODE);
-
-      mpfr_sin  (xp, x->value.complex.r, GFC_RND_MODE);
-      mpfr_sinh (xq, x->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (xp, xp, xq, GFC_RND_MODE);
-      mpfr_neg (result->value.complex.i, xp, GFC_RND_MODE );
-
-      mpfr_clears (xp, xq, NULL);
-    }
-#endif
       break;
     default:
       gfc_internal_error ("in gfc_simplify_cos(): Bad type");
@@ -1587,14 +1512,7 @@ gfc_simplify_cosh (gfc_expr *x)
   if (x->ts.type == BT_REAL)
     mpfr_cosh (result->value.real, x->value.real, GFC_RND_MODE);
   else if (x->ts.type == BT_COMPLEX)
-    {
-#if HAVE_mpc
-      mpc_cosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-      gfc_free_expr (result);
-      return NULL;
-#endif
-    }
+    mpc_cosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
   else
     gcc_unreachable ();
 
@@ -2000,21 +1918,7 @@ gfc_simplify_exp (gfc_expr *x)
 
     case BT_COMPLEX:
       gfc_set_model_kind (x->ts.kind);
-#ifdef HAVE_mpc
       mpc_exp (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-    {
-      mpfr_t xp, xq;
-      mpfr_init (xp);
-      mpfr_init (xq);
-      mpfr_exp (xq, x->value.complex.r, GFC_RND_MODE);
-      mpfr_cos (xp, x->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (result->value.complex.r, xq, xp, GFC_RND_MODE);
-      mpfr_sin (xp, x->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (result->value.complex.i, xq, xp, GFC_RND_MODE);
-      mpfr_clears (xp, xq, NULL);
-    }
-#endif
       break;
 
     default:
@@ -3393,26 +3297,7 @@ gfc_simplify_log (gfc_expr *x)
        }
 
       gfc_set_model_kind (x->ts.kind);
-#ifdef HAVE_mpc
       mpc_log (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-    {
-      mpfr_t xr, xi;
-      mpfr_init (xr);
-      mpfr_init (xi);
-
-      mpfr_atan2 (result->value.complex.i, x->value.complex.i,
-                 x->value.complex.r, GFC_RND_MODE);
-
-      mpfr_mul (xr, x->value.complex.r, x->value.complex.r, GFC_RND_MODE);
-      mpfr_mul (xi, x->value.complex.i, x->value.complex.i, GFC_RND_MODE);
-      mpfr_add (xr, xr, xi, GFC_RND_MODE);
-      mpfr_sqrt (xr, xr, GFC_RND_MODE);
-      mpfr_log (result->value.complex.r, xr, GFC_RND_MODE);
-
-      mpfr_clears (xr, xi, NULL);
-    }
-#endif
       break;
 
     default:
@@ -4305,12 +4190,7 @@ 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");
 }
 
@@ -5089,25 +4969,7 @@ gfc_simplify_sin (gfc_expr *x)
 
     case BT_COMPLEX:
       gfc_set_model (x->value.real);
-#ifdef HAVE_mpc
       mpc_sin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-    {
-      mpfr_t xp, xq;
-      mpfr_init (xp);
-      mpfr_init (xq);
-
-      mpfr_sin  (xp, x->value.complex.r, GFC_RND_MODE);
-      mpfr_cosh (xq, x->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (result->value.complex.r, xp, xq, GFC_RND_MODE);
-
-      mpfr_cos  (xp, x->value.complex.r, GFC_RND_MODE);
-      mpfr_sinh (xq, x->value.complex.i, GFC_RND_MODE);
-      mpfr_mul (result->value.complex.i, xp, xq, GFC_RND_MODE);
-
-      mpfr_clears (xp, xq, NULL);
-    }
-#endif
       break;
 
     default:
@@ -5131,14 +4993,7 @@ gfc_simplify_sinh (gfc_expr *x)
   if (x->ts.type == BT_REAL)
     mpfr_sinh (result->value.real, x->value.real, GFC_RND_MODE);
   else if (x->ts.type == BT_COMPLEX)
-    {
-#if HAVE_mpc
-      mpc_sinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-      gfc_free_expr (result);
-      return NULL;
-#endif
-    }
+    mpc_sinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
   else
     gcc_unreachable ();
 
@@ -5329,87 +5184,7 @@ gfc_simplify_sqrt (gfc_expr *e)
 
     case BT_COMPLEX:
       gfc_set_model (e->value.real);
-#ifdef HAVE_mpc
       mpc_sqrt (result->value.complex, e->value.complex, GFC_MPC_RND_MODE);
-#else
-    {
-      /* Formula taken from Numerical Recipes to avoid over- and
-        underflow.  */
-
-      mpfr_t ac, ad, s, t, w;
-      mpfr_init (ac);
-      mpfr_init (ad);
-      mpfr_init (s);
-      mpfr_init (t);
-      mpfr_init (w);
-
-      if (mpfr_cmp_ui (e->value.complex.r, 0) == 0
-         && mpfr_cmp_ui (e->value.complex.i, 0) == 0)
-       {
-         mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
-         mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
-         break;
-       }
-
-      mpfr_abs (ac, e->value.complex.r, GFC_RND_MODE);
-      mpfr_abs (ad, e->value.complex.i, GFC_RND_MODE);
-
-      if (mpfr_cmp (ac, ad) >= 0)
-       {
-         mpfr_div (t, e->value.complex.i, e->value.complex.r, GFC_RND_MODE);
-         mpfr_mul (t, t, t, GFC_RND_MODE);
-         mpfr_add_ui (t, t, 1, GFC_RND_MODE);
-         mpfr_sqrt (t, t, GFC_RND_MODE);
-         mpfr_add_ui (t, t, 1, GFC_RND_MODE);
-         mpfr_div_ui (t, t, 2, GFC_RND_MODE);
-         mpfr_sqrt (t, t, GFC_RND_MODE);
-         mpfr_sqrt (s, ac, GFC_RND_MODE);
-         mpfr_mul (w, s, t, GFC_RND_MODE);
-       }
-      else
-       {
-         mpfr_div (s, e->value.complex.r, e->value.complex.i, GFC_RND_MODE);
-         mpfr_mul (t, s, s, GFC_RND_MODE);
-         mpfr_add_ui (t, t, 1, GFC_RND_MODE);
-         mpfr_sqrt (t, t, GFC_RND_MODE);
-         mpfr_abs (s, s, GFC_RND_MODE);
-         mpfr_add (t, t, s, GFC_RND_MODE);
-         mpfr_div_ui (t, t, 2, GFC_RND_MODE);
-         mpfr_sqrt (t, t, GFC_RND_MODE);
-         mpfr_sqrt (s, ad, GFC_RND_MODE);
-         mpfr_mul (w, s, t, GFC_RND_MODE);
-       }
-
-      if (mpfr_cmp_ui (w, 0) != 0 && mpfr_cmp_ui (e->value.complex.r, 0) >= 0)
-       {
-         mpfr_mul_ui (t, w, 2, GFC_RND_MODE);
-         mpfr_div (result->value.complex.i, e->value.complex.i, t, GFC_RND_MODE);
-         mpfr_set (result->value.complex.r, w, GFC_RND_MODE);
-       }
-      else if (mpfr_cmp_ui (w, 0) != 0
-              && mpfr_cmp_ui (e->value.complex.r, 0) < 0
-              && mpfr_cmp_ui (e->value.complex.i, 0) >= 0)
-       {
-         mpfr_mul_ui (t, w, 2, GFC_RND_MODE);
-         mpfr_div (result->value.complex.r, e->value.complex.i, t, GFC_RND_MODE);
-         mpfr_set (result->value.complex.i, w, GFC_RND_MODE);
-       }
-      else if (mpfr_cmp_ui (w, 0) != 0
-              && mpfr_cmp_ui (e->value.complex.r, 0) < 0
-              && mpfr_cmp_ui (e->value.complex.i, 0) < 0)
-       {
-         mpfr_mul_ui (t, w, 2, GFC_RND_MODE);
-         mpfr_div (result->value.complex.r, ad, t, GFC_RND_MODE);
-         mpfr_neg (w, w, GFC_RND_MODE);
-         mpfr_set (result->value.complex.i, w, GFC_RND_MODE);
-       }
-      else
-       gfc_internal_error ("invalid complex argument of SQRT at %L",
-                           &e->where);
-
-      mpfr_clears (s, t, ac, ad, w, NULL);
-    }
-#endif
       break;
 
     default:
@@ -5462,14 +5237,7 @@ gfc_simplify_tan (gfc_expr *x)
   if (x->ts.type == BT_REAL)
     mpfr_tan (result->value.real, x->value.real, GFC_RND_MODE);
   else if (x->ts.type == BT_COMPLEX)
-    {
-#if HAVE_mpc
-      mpc_tan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-      gfc_free_expr (result);
-      return NULL;
-#endif
-    }
+    mpc_tan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
   else
     gcc_unreachable ();
 
@@ -5490,14 +5258,7 @@ gfc_simplify_tanh (gfc_expr *x)
   if (x->ts.type == BT_REAL)
     mpfr_tanh (result->value.real, x->value.real, GFC_RND_MODE);
   else if (x->ts.type == BT_COMPLEX)
-    {
-#if HAVE_mpc
-      mpc_tanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
-#else
-      gfc_free_expr (result);
-      return NULL;
-#endif
-    }
+    mpc_tanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
   else
     gcc_unreachable ();
 

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index e19a7d34e0a1ab0e116930ba9d9e4c8762f5019c..19b24c509edc3f98d863adf0065e2ea593099928 100644 (file)
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -164,28 +164,12 @@ encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
 
 
 static int
-encode_complex (int kind,
-#ifdef HAVE_mpc
-               mpc_t cmplx,
-#else
-               mpfr_t real, mpfr_t imaginary,
-#endif
+encode_complex (int kind, mpc_t cmplx,
                unsigned char *buffer, size_t buffer_size)
 {
   int 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
+  size = encode_float (kind, mpc_realref (cmplx), &buffer[0], buffer_size);
+  size += encode_float (kind, mpc_imagref (cmplx),
                        &buffer[size], buffer_size - size);
   return size;
 }
@@ -283,13 +267,7 @@ 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,
-#ifdef HAVE_mpc
-                            source->value.complex,
-#else
-                            source->value.complex.r,
-                            source->value.complex.i,
-#endif
+      return encode_complex (source->ts.kind, source->value.complex,
                             buffer, buffer_size);
     case BT_LOGICAL:
       return encode_logical (source->ts.kind, source->value.logical, buffer,
@@ -391,28 +369,13 @@ 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,
-#ifdef HAVE_mpc
-                      mpc_t complex
-#else
-                      mpfr_t real, mpfr_t imaginary
-#endif
-                      )
+                      mpc_t complex)
 {
   int size;
   size = gfc_interpret_float (kind, &buffer[0], buffer_size,
-#ifdef HAVE_mpc
-                             mpc_realref (complex)
-#else
-                             real
-#endif
-                             );
+                             mpc_realref (complex));
   size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
-#ifdef HAVE_mpc
-                              mpc_imagref (complex)
-#else
-                              imaginary
-#endif
-                              );
+                              mpc_imagref (complex));
   return size;
 }
 
@@ -559,13 +522,7 @@ 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
-#endif
-                              );
+                              result->value.complex);
       break;
 
     case BT_LOGICAL:
@@ -766,19 +723,9 @@ 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,
-#ifdef HAVE_mpc
-                            expr->value.complex
-#else
-                            expr->value.complex.r, expr->value.complex.i
-#endif
-                            );
+                            expr->value.complex);
     }
   expr->is_boz = 0;  
   expr->ts.type = ts->type;

diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index 0052e5aed8f6502346360fe8dfba61d732cb1aa0..603362638dd76c5ddd36df1555d4041b64e3de53 100644 (file)
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -39,11 +39,7 @@ 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 *);