diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/fortran/arith.c | 306 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 22 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 10 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 247 | ||||
| -rw-r--r-- | gcc/fortran/target-memory.c | 71 | ||||
| -rw-r--r-- | gcc/fortran/target-memory.h | 4 |
8 files changed, 29 insertions, 654 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f8d45a4..9d0506e 100644 --- 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 bd0ca61..d119d12 100644 --- 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 cbd3172..c693773 100644 --- 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 e552203..3a13cfe 100644 --- 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 bf705c6..6f6cb78 100644 --- 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 9856b2e..8768cb6 100644 --- 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 e19a7d3..19b24c5 100644 --- 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 0052e5a..6033626 100644 --- 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 *); |