static void
test_reuse (void)
{
mpc_t z;
mpfr_t y;
int inex;
mpfr_init2 (y, 2);
mpc_init2 (z, 2);
mpc_set_si_si (z, 0, -1, MPC_RNDNN);
mpfr_neg (mpc_realref (z), mpc_realref (z), MPFR_RNDN);
mpc_div_2ui (z, z, 4, MPC_RNDNN);
mpfr_set_ui (y, 512, MPFR_RNDN);
inex = mpc_pow_fr (z, z, y, MPC_RNDNN);
if (MPC_INEX_RE(inex) != 0 || MPC_INEX_IM(inex) != 0 ||
mpfr_cmp_ui_2exp (mpc_realref(z), 1, -2048) != 0 ||
mpfr_cmp_ui (mpc_imagref(z), 0) != 0 || mpfr_signbit (mpc_imagref(z)) == 0)
{
printf ("Error in test_reuse, wrong ternary value or output\n");
printf ("inex=(%d %d)\n", MPC_INEX_RE(inex), MPC_INEX_IM(inex));
printf ("z="); mpc_out_str (stdout, 2, 0, z, MPC_RNDNN); printf ("\n");
exit (1);
}
mpfr_clear (y);
mpc_clear (z);
}
int
main (void)
{
mpc_t z;
test_start ();
test_end ();
mpc_init2 (z, 6);
mpc_set_ui_ui (z, 17, 42, MPC_RNDNN);
mpfr_set_ui (mpc_realref (z), 18, GMP_RNDN);
if (mpfr_get_ui (mpc_realref (z), GMP_RNDN) != 18)
{
fprintf (stderr, "Error in mpfr_set_ui/mpc_realref\n");
exit (1);
}
mpfr_set_ui (mpc_imagref (z), 43, GMP_RNDN);
if (mpfr_get_ui (mpc_imagref (z), GMP_RNDN) != 43)
{
fprintf (stderr, "Error in mpfr_set_ui/mpc_imagref\n");
exit (1);
}
mpc_clear (z);
return 0;
}
static void
reuse_fc (mpc_function* function, mpc_ptr z, mpc_ptr x, mpfr_ptr expected)
{
mpc_set (x, z, MPC_RNDNN); /* exact */
function->pointer.FC (expected, z, MPFR_RNDN);
function->pointer.FC (mpc_realref (x), x, MPFR_RNDN);
if (!same_mpfr_value (mpc_realref (x), expected, 1))
{
mpfr_t got;
got[0] = mpc_realref(x)[0]; /* display sensible name */
printf ("Reuse error for %s(mpc_realref(z), z) for\n", function->name);
MPC_OUT (z);
MPFR_OUT (expected);
MPFR_OUT (got);
exit (1);
}
mpc_set (x, z, MPC_RNDNN); /* exact */
function->pointer.FC (mpc_imagref (x), x, MPFR_RNDN);
if (!same_mpfr_value (mpc_imagref (x), expected, 1))
{
mpfr_t got;
got[0] = mpc_imagref(x)[0]; /* display sensible name */
printf ("Reuse error for %s(mpc_imagref(z), z) for \n", function->name);
MPC_OUT (z);
MPFR_OUT (expected);
MPFR_OUT (got);
exit (1);
}
}
static void
reuse_bug (void)
{
/* bug found by the automatic builds on
http://hydra.nixos.org/build/1469029/log/raw */
mpc_t x, y, z;
mp_prec_t prec = 2;
for (prec = 2; prec <= 20; prec ++)
{
mpc_init2 (x, prec);
mpc_init2 (y, prec);
mpc_init2 (z, prec);
mpfr_set_ui (mpc_realref (x), 0ul, MPFR_RNDN);
mpfr_set_ui_2exp (mpc_imagref (x), 3ul, -2, MPFR_RNDN);
mpc_set_ui (y, 8ul, MPC_RNDNN);
mpc_pow (z, x, y, MPC_RNDNN);
mpc_pow (y, x, y, MPC_RNDNN);
if (mpfr_signbit (mpc_imagref (y)) != mpfr_signbit (mpc_imagref (z)))
{
printf ("Error: regression, reuse_bug reproduced\n");
exit (1);
}
mpc_clear (x);
mpc_clear (y);
mpc_clear (z);
}
}
static bool
do_mpc_arg2 (real_value *result_real, real_value *result_imag,
int (*func)(mpc_ptr, mpc_srcptr, mpc_srcptr, mpc_rnd_t),
const real_value *arg0_real, const real_value *arg0_imag,
const real_value *arg1_real, const real_value *arg1_imag,
const real_format *format)
{
if (!real_isfinite (arg0_real)
|| !real_isfinite (arg0_imag)
|| !real_isfinite (arg1_real)
|| !real_isfinite (arg1_imag))
return false;
int prec = format->p;
mpc_rnd_t crnd = format->round_towards_zero ? MPC_RNDZZ : MPC_RNDNN;
mpc_t m0, m1;
mpc_init2 (m0, prec);
mpc_init2 (m1, prec);
mpfr_from_real (mpc_realref (m0), arg0_real, GMP_RNDN);
mpfr_from_real (mpc_imagref (m0), arg0_imag, GMP_RNDN);
mpfr_from_real (mpc_realref (m1), arg1_real, GMP_RNDN);
mpfr_from_real (mpc_imagref (m1), arg1_imag, GMP_RNDN);
mpfr_clear_flags ();
bool inexact = func (m0, m0, m1, crnd);
bool ok = do_mpc_ckconv (result_real, result_imag, m0, inexact, format);
mpc_clear (m0);
mpc_clear (m1);
return ok;
}
static PyObject *
GMPy_Complex_Rect(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *tempx, *tempy;
MPC_Object *result;
CHECK_CONTEXT(context);
tempx = GMPy_MPFR_From_Real(x, 1, context);
tempy = GMPy_MPFR_From_Real(y, 1, context);
result = GMPy_MPC_New(0, 0, context);
if (!tempx || !tempy || !result) {
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_XDECREF((PyObject*)result);
return NULL;
}
mpfr_cos(mpc_realref(result->c), tempy->f, GET_REAL_ROUND(context));
mpfr_mul(mpc_realref(result->c), mpc_realref(result->c), tempx->f, GET_REAL_ROUND(context));
mpfr_sin(mpc_imagref(result->c), tempy->f, GET_IMAG_ROUND(context));
mpfr_mul(mpc_imagref(result->c), mpc_imagref(result->c), tempx->f, GET_IMAG_ROUND(context));
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
GMPY_MPC_CLEANUP(result, context, "rect()");
return (PyObject*)result;
}
static bool
do_mpc_ckconv (real_value *result_real, real_value *result_imag,
mpc_srcptr m, bool inexact, const real_format *format)
{
/* Proceed iff we get a normal number, i.e. not NaN or Inf and no
overflow/underflow occurred. If -frounding-math, proceed iff the
result of calling FUNC was exact. */
if (!mpfr_number_p (mpc_realref (m))
|| !mpfr_number_p (mpc_imagref (m))
|| mpfr_overflow_p ()
|| mpfr_underflow_p ()
|| (flag_rounding_math && inexact))
return false;
REAL_VALUE_TYPE tmp_real, tmp_imag;
real_from_mpfr (&tmp_real, mpc_realref (m), format, GMP_RNDN);
real_from_mpfr (&tmp_imag, mpc_imagref (m), format, GMP_RNDN);
/* Proceed iff GCC's REAL_VALUE_TYPE can hold the MPFR values.
If the REAL_VALUE_TYPE is zero but the mpft_t is not, then we
underflowed in the conversion. */
if (!real_isfinite (&tmp_real)
|| !real_isfinite (&tmp_imag)
|| (tmp_real.cl == rvc_zero) != (mpfr_zero_p (mpc_realref (m)) != 0)
|| (tmp_imag.cl == rvc_zero) != (mpfr_zero_p (mpc_imagref (m)) != 0))
return false;
real_convert (result_real, format, &tmp_real);
real_convert (result_imag, format, &tmp_imag);
return (real_identical (result_real, &tmp_real)
&& real_identical (result_imag, &tmp_imag));
}
static void
check_different_precisions(void)
{
/* check reuse when real and imaginary part have different precisions. */
mpc_t z, expected, got;
int res;
mpc_init2(z, 128);
mpc_init2(expected, 128);
mpc_init2(got, 128);
/* change precision of one part */
mpfr_set_prec (mpc_imagref (z), 32);
mpfr_set_prec (mpc_imagref (expected), 32);
mpfr_set_prec (mpc_imagref (got), 32);
mpfr_set_str (mpc_realref (z), "0x100000000fp-32", 16, GMP_RNDN);
mpfr_set_str (mpc_imagref (z), "-1", 2, GMP_RNDN);
mpfr_set_str (mpc_realref (expected), "+1", 2, GMP_RNDN);
mpfr_set_str (mpc_imagref (expected), "0x100000000fp-32", 16, GMP_RNDN);
mpc_set (got, z, MPC_RNDNN);
res = mpc_mul_i (got, got, +1, MPC_RNDNN);
if (MPC_INEX_RE(res) != 0 || MPC_INEX_IM(res) >=0)
{
printf("Wrong inexact flag for mpc_mul_i(z, z, n)\n"
" got (re=%2d, im=%2d)\nexpected (re= 0, im=-1)\n",
MPC_INEX_RE(res), MPC_INEX_IM(res));
exit(1);
}
if (mpc_cmp(got, expected) != 0)
{
printf ("Error for mpc_mul_i(z, z, n) for\n");
MPC_OUT (z);
printf ("n=+1\n");
MPC_OUT (expected);
MPC_OUT (got);
exit (1);
}
mpc_neg (expected, expected, MPC_RNDNN);
mpc_set (got, z, MPC_RNDNN);
mpc_mul_i (got, got, -1, MPC_RNDNN);
if (mpc_cmp(got, expected) != 0)
{
printf ("Error for mpc_mul_i(z, z, n) for\n");
MPC_OUT (z);
printf ("n=-1\n");
MPC_OUT (expected);
MPC_OUT (got);
exit (1);
}
mpc_clear (z);
mpc_clear (expected);
mpc_clear (got);
}
static void
tgeneric_cc_c (mpc_function *function, mpc_ptr op, mpc_ptr rop1, mpc_ptr rop2,
mpc_ptr rop14, mpc_ptr rop24, mpc_ptr rop14rnd, mpc_ptr rop24rnd,
mpc_rnd_t rnd1, mpc_rnd_t rnd2)
{
/* same as the previous function, but for mpc functions computing two
results from one argument */
known_signs_t ks = {1, 1};
function->pointer.CC_C (rop14, rop24, op, rnd1, rnd2);
function->pointer.CC_C (rop1, rop2, op, rnd1, rnd2);
if ( MPFR_CAN_ROUND (mpc_realref (rop14), 1, MPC_PREC_RE (rop1),
MPC_RND_RE (rnd1))
&& MPFR_CAN_ROUND (mpc_imagref (rop14), 1, MPC_PREC_IM (rop1),
MPC_RND_IM (rnd1))
&& MPFR_CAN_ROUND (mpc_realref (rop24), 1, MPC_PREC_RE (rop2),
MPC_RND_RE (rnd2))
&& MPFR_CAN_ROUND (mpc_imagref (rop24), 1, MPC_PREC_IM (rop2),
MPC_RND_IM (rnd2))) {
mpc_set (rop14rnd, rop14, rnd1);
mpc_set (rop24rnd, rop24, rnd2);
}
else
return;
if (!same_mpc_value (rop1, rop14rnd, ks)) {
/* rounding failed for first result */
printf ("Rounding might be incorrect for the first result of %s at\n", function->name);
MPC_OUT (op);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd1)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd1)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop1);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop14);
printf ("and is rounded to ");
MPC_OUT (rop14rnd);
exit (1);
}
else if (!same_mpc_value (rop2, rop24rnd, ks)) {
/* rounding failed for second result */
printf ("Rounding might be incorrect for the second result of %s at\n", function->name);
MPC_OUT (op);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd2)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd2)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop2);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop24);
printf ("and is rounded to ");
MPC_OUT (rop24rnd);
exit (1);
}
}
/* return 0 iff both the real and imaginary parts are exact */
int
mpc_add_ui (mpc_ptr a, mpc_srcptr b, unsigned long int c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_add_ui (mpc_realref(a), mpc_realref(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(a), mpc_imagref(b), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
/* fix the sign of Re(z) or Im(z) in case it is zero,
and Re(x) is zero.
sign_eps is 0 if Re(x) = +0, 1 if Re(x) = -0
sign_a is the sign bit of Im(x).
Assume y is an integer (does nothing otherwise).
*/
static void
fix_sign (mpc_ptr z, int sign_eps, int sign_a, mpfr_srcptr y)
{
int ymod4 = -1;
mpfr_exp_t ey;
mpz_t my;
unsigned long int t;
mpz_init (my);
ey = mpfr_get_z_exp (my, y);
/* normalize so that my is odd */
t = mpz_scan1 (my, 0);
ey += (mpfr_exp_t) t;
mpz_tdiv_q_2exp (my, my, t);
/* y = my*2^ey */
/* compute y mod 4 (in case y is an integer) */
if (ey >= 2)
ymod4 = 0;
else if (ey == 1)
ymod4 = mpz_tstbit (my, 0) * 2; /* correct if my < 0 */
else if (ey == 0)
{
ymod4 = mpz_tstbit (my, 1) * 2 + mpz_tstbit (my, 0);
if (mpz_cmp_ui (my , 0) < 0)
ymod4 = 4 - ymod4;
}
else /* y is not an integer */
goto end;
if (mpfr_zero_p (mpc_realref(z)))
{
/* we assume y is always integer in that case (FIXME: prove it):
(eps+I*a)^y = +0 + I*a^y for y = 1 mod 4 and sign_eps = 0
(eps+I*a)^y = -0 - I*a^y for y = 3 mod 4 and sign_eps = 0 */
MPC_ASSERT (ymod4 == 1 || ymod4 == 3);
if ((ymod4 == 3 && sign_eps == 0) ||
(ymod4 == 1 && sign_eps == 1))
mpfr_neg (mpc_realref(z), mpc_realref(z), MPFR_RNDZ);
}
else if (mpfr_zero_p (mpc_imagref(z)))
{
/* we assume y is always integer in that case (FIXME: prove it):
(eps+I*a)^y = a^y - 0*I for y = 0 mod 4 and sign_a = sign_eps
(eps+I*a)^y = -a^y +0*I for y = 2 mod 4 and sign_a = sign_eps */
MPC_ASSERT (ymod4 == 0 || ymod4 == 2);
if ((ymod4 == 0 && sign_a == sign_eps) ||
(ymod4 == 2 && sign_a != sign_eps))
mpfr_neg (mpc_imagref(z), mpc_imagref(z), MPFR_RNDZ);
}
end:
mpz_clear (my);
}
/* res <- x[0]*y[0] + ... + x[n-1]*y[n-1] */
int
mpc_dot (mpc_ptr res, const mpc_ptr *x, const mpc_ptr *y,
unsigned long n, mpc_rnd_t rnd)
{
int inex_re, inex_im;
mpfr_ptr *t;
mpfr_t *z;
unsigned long i;
z = (mpfr_t *) malloc (2 * n * sizeof (mpfr_t));
MPC_ASSERT(z != NULL);
t = (mpfr_ptr *) malloc (2 * n * sizeof(mpfr_ptr));
MPC_ASSERT(t != NULL);
for (i = 0; i < 2 * n; i++)
t[i] = z[i];
/* we first store in z[i] the value of Re(x[i])*Re(y[i])
and in z[n+i] that of -Im(x[i])*Im(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_prec_t prec_y_max = MPC_MAX (prec_y_re, prec_y_im);
/* we allocate z[i] with prec_x_re + prec_y_max bits
so that the second loop below does not reallocate */
mpfr_init2 (z[i], prec_x_re + prec_y_max);
mpfr_set_prec (z[i], prec_x_re + prec_y_re);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
/* idem for z[n+i]: we allocate with prec_x_im + prec_y_max bits */
mpfr_init2 (z[n+i], prec_x_im + prec_y_max);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_im);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_neg (z[n+i], z[n+i], MPFR_RNDZ);
}
inex_re = mpfr_sum (mpc_realref (res), t, 2 * n, MPC_RND_RE (rnd));
/* we then store in z[i] the value of Re(x[i])*Im(y[i])
and in z[n+i] that of Im(x[i])*Re(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_set_prec (z[i], prec_x_re + prec_y_im);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_re);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
}
inex_im = mpfr_sum (mpc_imagref (res), t, 2 * n, MPC_RND_IM (rnd));
for (i = 0; i < 2 * n; i++)
mpfr_clear (z[i]);
free (t);
free (z);
return MPC_INEX(inex_re, inex_im);
}
/* this routine deals with the case where w is zero */
static int
mpc_div_zero (mpc_ptr a, mpc_srcptr z, mpc_srcptr w, mpc_rnd_t rnd)
/* Assumes w==0, implementation according to C99 G.5.1.8 */
{
int sign = MPFR_SIGNBIT (mpc_realref (w));
mpfr_t infty;
mpfr_init2 (infty, MPFR_PREC_MIN);
mpfr_set_inf (infty, sign);
mpfr_mul (mpc_realref (a), infty, mpc_realref (z), MPC_RND_RE (rnd));
mpfr_mul (mpc_imagref (a), infty, mpc_imagref (z), MPC_RND_IM (rnd));
mpfr_clear (infty);
return MPC_INEX (0, 0); /* exact */
}
SEXP R_mpc_imag(SEXP e1) {
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (mpfr_fits_sint_p(mpc_imagref(*z1), GMP_RNDN)) {
return Rf_ScalarReal(mpfr_get_d(mpc_imagref(*z1),
GMP_RNDN));
} else {
Rf_error("Imaginary part doesn't fit in numeric.");
}
} else {
Rf_error("Invalid operand for MPC log.");
}
return R_NilValue; /* Not reached */
}
static int
mpc_sin_cos_real (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
/* assumes that op is real */
{
int inex_sin_re = 0, inex_cos_re = 0;
/* Until further notice, assume computations exact; in particular,
by definition, for not computed values. */
mpfr_t s, c;
int inex_s, inex_c;
int sign_im = mpfr_signbit (mpc_imagref (op));
/* sin(x +-0*i) = sin(x) +-0*i*sign(cos(x)) */
/* cos(x +-i*0) = cos(x) -+i*0*sign(sin(x)) */
if (rop_sin != 0)
mpfr_init2 (s, MPC_PREC_RE (rop_sin));
else
mpfr_init2 (s, 2); /* We need only the sign. */
if (rop_cos != NULL)
mpfr_init2 (c, MPC_PREC_RE (rop_cos));
else
mpfr_init2 (c, 2);
inex_s = mpfr_sin (s, mpc_realref (op), MPC_RND_RE (rnd_sin));
inex_c = mpfr_cos (c, mpc_realref (op), MPC_RND_RE (rnd_cos));
/* We cannot use mpfr_sin_cos since we may need two distinct rounding
modes and the exact return values. If we need only the sign, an
arbitrary rounding mode will work. */
if (rop_sin != NULL) {
mpfr_set (mpc_realref (rop_sin), s, MPFR_RNDN); /* exact */
inex_sin_re = inex_s;
mpfr_set_zero (mpc_imagref (rop_sin),
( ( sign_im && !mpfr_signbit(c))
|| (!sign_im && mpfr_signbit(c)) ? -1 : 1));
}
if (rop_cos != NULL) {
mpfr_set (mpc_realref (rop_cos), c, MPFR_RNDN); /* exact */
inex_cos_re = inex_c;
mpfr_set_zero (mpc_imagref (rop_cos),
( ( sign_im && mpfr_signbit(s))
|| (!sign_im && !mpfr_signbit(s)) ? -1 : 1));
}
mpfr_clear (s);
mpfr_clear (c);
return MPC_INEX12 (MPC_INEX (inex_sin_re, 0), MPC_INEX (inex_cos_re, 0));
}
static void
check_regular (void)
{
mpc_t x, y;
int rnd_re, rnd_im;
mpfr_prec_t prec;
testmul (247, -65, -223, 416, 8, 24);
testmul (5, -896, 5, -32, 3, 2);
testmul (-3, -512, -1, -1, 2, 16);
testmul (266013312, 121990769, 110585572, 116491059, 27, 0);
testmul (170, 9, 450, 251, 8, 0);
testmul (768, 85, 169, 440, 8, 16);
testmul (145, 1816, 848, 169, 8, 24);
mpc_init2 (x, 1000);
mpc_init2 (y, 1000);
/* Bug 20081114: mpc_mul_karatsuba returned wrong inexact value for
imaginary part */
mpc_set_prec (x, 7);
mpc_set_prec (y, 7);
mpfr_set_str (mpc_realref (x), "0xB4p+733", 16, MPFR_RNDN);
mpfr_set_str (mpc_imagref (x), "0x90p+244", 16, MPFR_RNDN);
mpfr_set_str (mpc_realref (y), "0xECp-146", 16, MPFR_RNDN);
mpfr_set_str (mpc_imagref (y), "0xACp-471", 16, MPFR_RNDN);
cmpmul (x, y, MPC_RNDNN);
mpfr_set_str (mpc_realref (x), "0xB4p+733", 16, MPFR_RNDN);
mpfr_set_str (mpc_imagref (x), "0x90p+244", 16, MPFR_RNDN);
mpfr_set_str (mpc_realref (y), "0xACp-471", 16, MPFR_RNDN);
mpfr_set_str (mpc_imagref (y), "-0xECp-146", 16, MPFR_RNDN);
cmpmul (x, y, MPC_RNDNN);
for (prec = 2; prec < 1000; prec = (mpfr_prec_t) (prec * 1.1 + 1))
{
mpc_set_prec (x, prec);
mpc_set_prec (y, prec);
test_default_random (x, -1024, 1024, 128, 0);
test_default_random (y, -1024, 1024, 128, 0);
for (rnd_re = 0; rnd_re < 4; rnd_re ++)
for (rnd_im = 0; rnd_im < 4; rnd_im ++)
cmpmul (x, y, MPC_RND (rnd_re, rnd_im));
}
mpc_clear (x);
mpc_clear (y);
}
static void
tgeneric_cci (mpc_function *function, mpc_ptr op1, int op2,
mpc_ptr rop, mpc_ptr rop4, mpc_ptr rop4rnd, mpc_rnd_t rnd)
{
known_signs_t ks = {1, 1};
function->pointer.CCI (rop4, op1, op2, rnd);
function->pointer.CCI (rop, op1, op2, rnd);
if (MPFR_CAN_ROUND (mpc_realref (rop4), 1, MPC_PREC_RE (rop),
MPC_RND_RE (rnd))
&& MPFR_CAN_ROUND (mpc_imagref (rop4), 1, MPC_PREC_IM (rop),
MPC_RND_IM (rnd)))
mpc_set (rop4rnd, rop4, rnd);
else
return;
if (same_mpc_value (rop, rop4rnd, ks))
return;
printf ("Rounding in %s might be incorrect for\n", function->name);
MPC_OUT (op1);
printf ("op2=%d\n", op2);
printf ("with rounding mode (%s, %s)",
mpfr_print_rnd_mode (MPC_RND_RE (rnd)),
mpfr_print_rnd_mode (MPC_RND_IM (rnd)));
printf ("\n%s gives ", function->name);
MPC_OUT (rop);
printf ("%s quadruple precision gives ", function->name);
MPC_OUT (rop4);
printf ("and is rounded to ");
MPC_OUT (rop4rnd);
exit (1);
}
static PyObject *
GMPy_PyStr_From_MPC(MPC_Object *self, int base, int digits, CTXT_Object *context)
{
PyObject *tempreal = 0, *tempimag = 0, *result;
CHECK_CONTEXT(context);
if (!((base >= 2) && (base <= 62))) {
VALUE_ERROR("base must be in the interval [2,62]");
return NULL;
}
if ((digits < 0) || (digits == 1)) {
VALUE_ERROR("digits must be 0 or >= 2");
return NULL;
}
tempreal = mpfr_ascii(mpc_realref(self->c), base, digits,
MPC_RND_RE(GET_MPC_ROUND(context)));
tempimag = mpfr_ascii(mpc_imagref(self->c), base, digits,
MPC_RND_IM(GET_MPC_ROUND(context)));
if (!tempreal || !tempimag) {
Py_XDECREF(tempreal);
Py_XDECREF(tempimag);
return NULL;
}
result = Py_BuildValue("(NN)", tempreal, tempimag);
if (!result) {
Py_DECREF(tempreal);
Py_DECREF(tempimag);
}
return result;
}
static bool
do_mpc_arg1 (real_value *result_real, real_value *result_imag,
int (*func) (mpc_ptr, mpc_srcptr, mpc_rnd_t),
const real_value *arg_real, const real_value *arg_imag,
const real_format *format)
{
/* To proceed, MPFR must exactly represent the target floating point
format, which only happens when the target base equals two. */
if (format->b != 2
|| !real_isfinite (arg_real)
|| !real_isfinite (arg_imag))
return false;
int prec = format->p;
mpc_rnd_t crnd = format->round_towards_zero ? MPC_RNDZZ : MPC_RNDNN;
mpc_t m;
mpc_init2 (m, prec);
mpfr_from_real (mpc_realref (m), arg_real, GMP_RNDN);
mpfr_from_real (mpc_imagref (m), arg_imag, GMP_RNDN);
mpfr_clear_flags ();
bool inexact = func (m, m, crnd);
bool ok = do_mpc_ckconv (result_real, result_imag, m, inexact, format);
mpc_clear (m);
return ok;
}
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
)
{
int size;
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,
#ifdef HAVE_mpc
mpc_imagref (complex)
#else
imaginary
#endif
);
return size;
}
static int
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,
#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;
}
int
mpc_fr_div (mpc_ptr a, mpfr_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
mpc_t bc;
int inexact;
mpc_realref (bc)[0] = b [0];
mpfr_init (mpc_imagref (bc));
/* we consider the operand b to have imaginary part +0 */
mpfr_set_ui (mpc_imagref (bc), 0, GMP_RNDN);
inexact = mpc_div (a, bc, c, rnd);
mpfr_clear (mpc_imagref (bc));
return inexact;
}
static int
mpc_div_real (mpc_ptr rop, mpc_srcptr z, mpc_srcptr w, mpc_rnd_t rnd)
/* Assumes z finite and w finite and non-zero, with imaginary part
of w a signed zero. */
{
int inex_re, inex_im;
/* save signs of operands in case there are overlaps */
int zrs = MPFR_SIGNBIT (mpc_realref (z));
int zis = MPFR_SIGNBIT (mpc_imagref (z));
int wrs = MPFR_SIGNBIT (mpc_realref (w));
int wis = MPFR_SIGNBIT (mpc_imagref (w));
/* warning: rop may overlap with z,w so treat the imaginary part first */
inex_im = mpfr_div (mpc_imagref(rop), mpc_imagref(z), mpc_realref(w), MPC_RND_IM(rnd));
inex_re = mpfr_div (mpc_realref(rop), mpc_realref(z), mpc_realref(w), MPC_RND_RE(rnd));
/* correct signs of zeroes if necessary, which does not affect the
inexact flags */
if (mpfr_zero_p (mpc_realref (rop)))
mpfr_setsign (mpc_realref (rop), mpc_realref (rop), (zrs != wrs && zis != wis),
MPFR_RNDN); /* exact */
if (mpfr_zero_p (mpc_imagref (rop)))
mpfr_setsign (mpc_imagref (rop), mpc_imagref (rop), (zis != wrs && zrs == wis),
MPFR_RNDN);
return MPC_INEX(inex_re, inex_im);
}
static PyObject *
GMPy_MPC_SizeOf_Method(PyObject *self, PyObject *other)
{
return PyIntOrLong_FromSize_t(sizeof(MPC_Object) + \
(((mpc_realref(MPC(self))->_mpfr_prec + mp_bits_per_limb - 1) / \
mp_bits_per_limb) * sizeof(mp_limb_t)) + \
(((mpc_imagref(MPC(self))->_mpfr_prec + mp_bits_per_limb - 1) / \
mp_bits_per_limb) * sizeof(mp_limb_t)));
}
static int
encode_complex (int kind, mpc_t cmplx,
unsigned char *buffer, size_t buffer_size)
{
int size;
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;
}
int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
mpc_t complex)
{
int size;
size = gfc_interpret_float (kind, &buffer[0], buffer_size,
mpc_realref (complex));
size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
mpc_imagref (complex));
return size;
}
int
mpc_mul_fr (mpc_ptr a, mpc_srcptr b, mpfr_srcptr c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
mpfr_t real;
if (c == mpc_realref (a))
/* We have to use a temporary variable. */
mpfr_init2 (real, MPC_PREC_RE (a));
else
real [0] = mpc_realref (a) [0];
inex_re = mpfr_mul (real, mpc_realref(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_mul (mpc_imagref(a), mpc_imagref(b), c, MPC_RND_IM(rnd));
mpfr_set (mpc_realref (a), real, GMP_RNDN); /* exact */
if (c == mpc_realref (a))
mpfr_clear (real);
return MPC_INEX(inex_re, inex_im);
}
int
mpc_tanh (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
/* tanh(op) = -i*tan(i*op) = conj(-i*tan(conj(-i*op))) */
mpc_t z;
mpc_t tan_z;
int inex;
/* z := conj(-i * op) and rop = conj(-i * tan(z)), in other words, we have
to switch real and imaginary parts. Let us set them without copying
significands. */
mpc_realref (z)[0] = mpc_imagref (op)[0];
mpc_imagref (z)[0] = mpc_realref (op)[0];
mpc_realref (tan_z)[0] = mpc_imagref (rop)[0];
mpc_imagref (tan_z)[0] = mpc_realref (rop)[0];
inex = mpc_tan (tan_z, z, MPC_RND (MPC_RND_IM (rnd), MPC_RND_RE (rnd)));
/* tan_z and rop parts share the same significands, copy the rest now. */
mpc_realref (rop)[0] = mpc_imagref (tan_z)[0];
mpc_imagref (rop)[0] = mpc_realref (tan_z)[0];
/* swap inexact flags for real and imaginary parts */
return MPC_INEX (MPC_INEX_IM (inex), MPC_INEX_RE (inex));
}
/* tests intermediate underflow; WONTFIX */
static int
test_underflow (void)
{
mpc_t z;
mpfr_exp_t emin = mpfr_get_emin ();
mpfr_set_emin (-10);
mpc_init2 (z, 21);
mpfr_set_si (mpc_realref(z), -1, GMP_RNDZ);
mpfr_set_ui_2exp (mpc_imagref(z), 1, 20, GMP_RNDZ);
mpfr_add_ui (mpc_imagref(z), mpc_imagref(z), 1, GMP_RNDZ);
mpfr_div_2exp (mpc_imagref(z), mpc_imagref(z), 20, GMP_RNDZ);
mpc_atan (z, z, MPC_RNDNN);
if (mpfr_cmp_si_2exp (mpc_realref(z), -1066635, 20) != 0 ||
mpfr_cmp_si_2exp (mpc_imagref(z), 1687619, 22))
{
printf ("Error in test_coverage\n");
printf ("expected (-1066635/2^20 1687619/2^22)\n");
printf ("got ");
mpc_out_str (stdout, 10, 20, z, MPC_RNDNN);
printf ("\n");
exit (1);
}
mpc_clear (z);
mpfr_set_emin (emin);
}
static PyObject *
GMPy_PyComplex_From_MPC(PyObject *self, PyObject *other)
{
CTXT_Object *context = NULL;
double real, imag;
CHECK_CONTEXT(context);
real = mpfr_get_d(mpc_realref(MPC(self)), GET_REAL_ROUND(context));
imag = mpfr_get_d(mpc_imagref(MPC(self)), GET_IMAG_ROUND(context));
return PyComplex_FromDoubles(real, imag);
}
