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);
}
/* test a random division of p+extra bits divided by p+extra bits,
with quotient of p bits only, where the p+extra bit approximation
of the quotient is very near a rounding frontier. */
static void
test_bad_aux (mpfr_prec_t p, mpfr_prec_t extra)
{
mpfr_t u, v, w, q0, q;
mpfr_init2 (u, p + extra);
mpfr_init2 (v, p + extra);
mpfr_init2 (w, p + extra);
mpfr_init2 (q0, p);
mpfr_init2 (q, p);
do mpfr_urandomb (q0, RANDS); while (mpfr_zero_p (q0));
do mpfr_urandomb (v, RANDS); while (mpfr_zero_p (v));
mpfr_set (w, q0, MPFR_RNDN); /* exact */
mpfr_nextabove (w); /* now w > q0 */
mpfr_mul (u, v, w, MPFR_RNDU); /* thus u > v*q0 */
mpfr_div (q, u, v, MPFR_RNDU); /* should have q > q0 */
MPFR_ASSERTN (mpfr_cmp (q, q0) > 0);
mpfr_div (q, u, v, MPFR_RNDZ); /* should have q = q0 */
MPFR_ASSERTN (mpfr_cmp (q, q0) == 0);
mpfr_set (w, q0, MPFR_RNDN); /* exact */
mpfr_nextbelow (w); /* now w < q0 */
mpfr_mul (u, v, w, MPFR_RNDZ); /* thus u < v*q0 */
mpfr_div (q, u, v, MPFR_RNDZ); /* should have q < q0 */
MPFR_ASSERTN (mpfr_cmp (q, q0) < 0);
mpfr_div (q, u, v, MPFR_RNDU); /* should have q = q0 */
MPFR_ASSERTN (mpfr_cmp (q, q0) == 0);
mpfr_clear (u);
mpfr_clear (v);
mpfr_clear (w);
mpfr_clear (q0);
mpfr_clear (q);
}
static void
check_nans (void)
{
mpfr_t x, xi, xf;
mpfr_init2 (x, 123);
mpfr_init2 (xi, 123);
mpfr_init2 (xf, 123);
/* nan */
mpfr_set_nan (x);
mpfr_modf (xi, xf, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (xi));
MPFR_ASSERTN (mpfr_nan_p (xf));
/* +inf */
mpfr_set_inf (x, 1);
mpfr_modf (xi, xf, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (xi));
MPFR_ASSERTN (mpfr_sgn (xi) > 0);
MPFR_ASSERTN (mpfr_zero_p (xf));
/* -inf */
mpfr_set_inf (x, -1);
mpfr_modf (xi ,xf, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (xi));
MPFR_ASSERTN (mpfr_sgn (xi) < 0);
MPFR_ASSERTN (mpfr_zero_p (xf));
mpfr_clear (x);
mpfr_clear (xi);
mpfr_clear (xf);
}
static PyObject *
GMPy_Real_Is_Zero(PyObject *x, CTXT_Object *context)
{
MPFR_Object *tempx;
int res;
if (MPFR_Check(x)) {
res = mpfr_zero_p(MPFR(x));
}
else {
CHECK_CONTEXT(context);
if (!(tempx = GMPy_MPFR_From_Real(x, 1, context))) {
return NULL;
}
res = mpfr_zero_p(tempx->f);
Py_DECREF((PyObject*)tempx);
}
if (res) {
Py_RETURN_TRUE;
}
else {
Py_RETURN_FALSE;
}
}
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));
}
/* from Christopher Creutzig, 18 Jul 2007 */
static void
smallvals_atan2 (void)
{
mpfr_t a, x, y;
mpfr_exp_t old_emin;
mpfr_inits (a, x, y, (mpfr_ptr) 0);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_nextbelow (y);
mpfr_set_ui (x, 1, MPFR_RNDN);
/* y=-2^(-emin-1), x=1 */
mpfr_atan2 (a, y, x, MPFR_RNDD);
MPFR_ASSERTN (mpfr_equal_p (a, y));
mpfr_atan2 (a, y, x, MPFR_RNDU);
MPFR_ASSERTN (mpfr_zero_p (a) && MPFR_IS_NEG(a));
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 8);
mpfr_set_prec (a, 8);
old_emin = mpfr_get_emin ();
mpfr_set_emin (MPFR_EMIN_MIN);
mpfr_set_si (y, 3, MPFR_RNDN);
mpfr_set_exp (y, mpfr_get_emin ());
mpfr_set_str_binary (x, "1.1");
mpfr_atan2 (a, y, x, MPFR_RNDU);
mpfr_set_si (y, 1, MPFR_RNDN);
mpfr_set_exp (y, mpfr_get_emin ());
MPFR_ASSERTN (mpfr_equal_p (a, y));
/* From a bug reported by Christopher Creutzig on 2007-08-28.
Added test in each rounding mode.
Segmentation fault or assertion failure due to an infinite Ziv loop. */
mpfr_set_si (y, 1, MPFR_RNDN);
mpfr_set_exp (y, mpfr_get_emin ());
mpfr_set_str_binary (x, "1.01");
mpfr_atan2 (a, y, x, MPFR_RNDZ);
MPFR_ASSERTN (mpfr_zero_p (a));
mpfr_atan2 (a, y, x, MPFR_RNDD);
MPFR_ASSERTN (mpfr_zero_p (a));
mpfr_atan2 (a, y, x, MPFR_RNDU);
MPFR_ASSERTN (mpfr_equal_p (a, y));
mpfr_atan2 (a, y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_equal_p (a, y));
/* trigger underflow with rounding to nearest */
mpfr_set_ui (x, 4, MPFR_RNDN);
mpfr_atan2 (a, y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_zero_p (a));
mpfr_set_emin (old_emin);
mpfr_clears (a, x, y, (mpfr_ptr) 0);
}
/* the rounding mode is mpfr_rnd_t here since we return an mpfr number */
int
mpc_norm (mpfr_ptr a, mpc_srcptr b, mpfr_rnd_t rnd)
{
mpfr_t u, v;
mp_prec_t prec;
int inexact, overflow;
prec = MPFR_PREC(a);
/* handling of special values; consistent with abs in that
norm = abs^2; so norm (+-inf, nan) = norm (nan, +-inf) = +inf */
if ( (mpfr_nan_p (MPC_RE (b)) || mpfr_nan_p (MPC_IM (b)))
|| (mpfr_inf_p (MPC_RE (b)) || mpfr_inf_p (MPC_IM (b))))
return mpc_abs (a, b, rnd);
mpfr_init (u);
mpfr_init (v);
if (!mpfr_zero_p(MPC_RE(b)) && !mpfr_zero_p(MPC_IM(b)) &&
2 * SAFE_ABS (mp_exp_t, MPFR_EXP (MPC_RE (b)) - MPFR_EXP (MPC_IM (b)))
> (mp_exp_t)prec)
/* If real and imaginary part have very different magnitudes, then the */
/* generic code increases the precision too much. Instead, compute the */
/* squarings _exactly_. */
{
mpfr_set_prec (u, 2 * MPFR_PREC (MPC_RE (b)));
mpfr_set_prec (v, 2 * MPFR_PREC (MPC_IM (b)));
mpfr_sqr (u, MPC_RE (b), GMP_RNDN);
mpfr_sqr (v, MPC_IM (b), GMP_RNDN);
inexact = mpfr_add (a, u, v, rnd);
}
else
{
do
{
prec += mpc_ceil_log2 (prec) + 3;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
inexact = mpfr_sqr (u, MPC_RE(b), GMP_RNDN); /* err<=1/2ulp */
inexact |= mpfr_sqr (v, MPC_IM(b), GMP_RNDN); /* err<=1/2ulp*/
inexact |= mpfr_add (u, u, v, GMP_RNDN); /* err <= 3/2 ulps */
overflow = mpfr_inf_p (u);
}
while (!overflow && inexact &&
mpfr_can_round (u, prec - 2, GMP_RNDN, rnd, MPFR_PREC(a)) == 0);
inexact |= mpfr_set (a, u, rnd);
}
mpfr_clear (u);
mpfr_clear (v);
return inexact;
}
/* 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);
}
int
mpfi_div_d (mpfi_ptr a, mpfi_srcptr b, const double c)
{
mpfr_t tmp;
int inexact_left, inexact_right;
int inexact = 0;
if (MPFI_NAN_P (b))
{
mpfr_set_nan (&(a->left));
mpfr_set_nan (&(a->right));
MPFR_RET_NAN;
}
if (c == 0.0)
{
if (mpfr_zero_p (&(b->left)))
mpfr_set_nan (&(a->left));
else
mpfr_set_inf (&(a->left), -1);
inexact_left = 0;
if (mpfr_zero_p (&(b->right)))
mpfr_set_nan (&(a->right));
else
mpfr_set_inf (&(a->right), +1);
inexact_right = 0;
}
else if (c < 0.0)
{
mpfr_init2 (tmp, mpfr_get_prec (&(a->left)));
inexact_left = mpfr_div_d (tmp, &(b->right), c, MPFI_RNDD);
inexact_right = mpfr_div_d (&(a->right), &(b->left), c, MPFI_RNDU);
mpfr_set (&(a->left), tmp, MPFI_RNDD); /* exact */
mpfr_clear (tmp);
}
else /* c > 0.0 */
{
inexact_left = mpfr_div_d (&(a->left), &(b->left), c, MPFI_RNDD);
inexact_right = mpfr_div_d (&(a->right), &(b->right), c, MPFI_RNDU);
}
if (MPFI_NAN_P (a))
MPFR_RET_NAN;
/* no need to check to sign of the bounds in case they are 0 */
if (inexact_left)
inexact += 1;
if (inexact_right)
inexact += 2;
return inexact;
}
static void
check_specials (void)
{
mpfr_t x, y;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
mpfr_set_nan (x);
mpfr_coth (y, x, GMP_RNDN);
if (! mpfr_nan_p (y))
{
printf ("Error: coth(NaN) != NaN\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_coth (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error: coth(Inf) != 1\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_coth (y, x, GMP_RNDN);
if (mpfr_cmp_si (y, -1))
{
printf ("Error: coth(-Inf) != -1\n");
exit (1);
}
/* cot(+/-0) = +/-0 */
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_coth (y, x, GMP_RNDN);
if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: coth(+0) != +0\n");
exit (1);
}
mpfr_neg (x, x, GMP_RNDN);
mpfr_coth (y, x, GMP_RNDN);
if (! (mpfr_zero_p (y) && MPFR_SIGN (y) < 0))
{
printf ("Error: coth(-0) != -0\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
static void
check_special (void)
{
mpfr_t x, y;
int inexact;
mpfr_init (x);
mpfr_init (y);
mpfr_set_inf (x, 1);
PRINT_ERROR_IF (!mpfr_inf_p (x) || mpfr_sgn (x) < 0,
"ERROR: mpfr_set_inf failed to set variable to +infinity.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to +infinity.\n");
inexact = mpfr_set_ui (y, 0, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) < 0 || inexact != 0,
"ERROR: mpfr_set_ui failed to set variable to +0.\n");
mpfr_set_inf (x, -1);
PRINT_ERROR_IF (!mpfr_inf_p (x) || mpfr_sgn (x) > 0,
"ERROR: mpfr_set_inf failed to set variable to -infinity.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_inf_p (y) || mpfr_sgn (y) > 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to -infinity.\n");
mpfr_set_zero (x, 1);
PRINT_ERROR_IF (!mpfr_zero_p (x) || mpfr_sgn (x) < 0,
"ERROR: mpfr_set_zero failed to set variable to +0.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) < 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to +0.\n");
mpfr_set_zero (x, -1);
PRINT_ERROR_IF (!mpfr_zero_p (x) || mpfr_sgn (x) > 0,
"ERROR: mpfr_set_zero failed to set variable to -0.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_zero_p (y) || mpfr_sgn (y) > 0 || inexact != 0,
"ERROR: mpfr_set failed to set variable to -0.\n");
mpfr_set_nan (x);
PRINT_ERROR_IF (!mpfr_nan_p (x),
"ERROR: mpfr_set_nan failed to set variable to NaN.\n");
inexact = mpfr_set (y, x, MPFR_RNDN);
PRINT_ERROR_IF (!mpfr_nan_p (y) || inexact != 0,
"ERROR: mpfr_set failed to set variable to NaN.\n");
mpfr_clear (x);
mpfr_clear (y);
}
int
tpl_same_mpfr_value (mpfr_ptr x1, mpfr_ptr x2, int known_sign)
{
/* The sign of zeroes and infinities is checked only when known_sign is
true. */
if (mpfr_nan_p (x1))
return mpfr_nan_p (x2);
if (mpfr_inf_p (x1))
return mpfr_inf_p (x2) &&
(!known_sign || mpfr_signbit (x1) == mpfr_signbit (x2));
if (mpfr_zero_p (x1))
return mpfr_zero_p (x2) &&
(!known_sign || mpfr_signbit (x1) == mpfr_signbit (x2));
return mpfr_cmp (x1, x2) == 0;
}
/* comparisons, see description in mpc-tests.h */
int
same_mpfr_value (mpfr_ptr got, mpfr_ptr ref, int known_sign)
{
/* The sign of zeroes and infinities is checked only when
known_sign is true. */
if (mpfr_nan_p (got))
return mpfr_nan_p (ref);
if (mpfr_inf_p (got))
return mpfr_inf_p (ref) &&
(!known_sign || mpfr_signbit (got) == mpfr_signbit (ref));
if (mpfr_zero_p (got))
return mpfr_zero_p (ref) &&
(!known_sign || mpfr_signbit (got) == mpfr_signbit (ref));
return mpfr_cmp (got, ref) == 0;
}
int
mpfi_put_q (mpfi_ptr a, mpq_srcptr b)
{
int inexact_left = 0;
int inexact_right = 0;
int inexact = 0;
if ( MPFI_NAN_P (a) )
MPFR_RET_NAN;
if (mpfr_cmp_q (&(a->left), b) > 0 ) {
inexact_left = mpfr_set_q (&(a->left), b, MPFI_RNDD);
}
else if (mpfr_cmp_q (&(a->right), b) < 0 ) {
inexact_right = mpfr_set_q (&(a->right), b, MPFI_RNDU);
/* do not allow +0 as upper bound */
if (mpfr_zero_p (&(a->right)) && !mpfr_signbit (&(a->right))) {
mpfr_neg (&(a->right), &(a->right), MPFI_RNDD);
}
}
if (inexact_left)
inexact += 1;
if (inexact_right)
inexact += 2;
return inexact;
}
static Obj VIEWSTRING_MPD(Obj self, Obj f, Obj digits)
{
mp_prec_t prec = mpd_get_prec(GET_MPD(f));
Obj str = NEW_STRING(2*(prec*302/1000+10)+3);
int slen = 0, n;
TEST_IS_INTOBJ("STRING_MPD",digits);
n = INT_INTOBJ(digits);
if (n == 1) n = 2;
char *c = CSTR_STRING(str);
slen += PRINT_MPFR(c+slen, 0, n, GET_MPD(f)->re, GMP_RNDN);
Obj im = NEW_MPFR(prec);
mpfr_add(MPFR_OBJ(im), GET_MPD(f)->re, GET_MPD(f)->im, GMP_RNDN);
mpfr_sub(MPFR_OBJ(im), MPFR_OBJ(im), MPD_OBJ(f)->re, GMP_RNDN); /* round off small im */
if (!mpfr_zero_p(MPFR_OBJ(im))) {
if (mpfr_sgn(MPFR_OBJ(im)) < 0)
c[slen++] = '-';
else
c[slen++] = '+';
mpfr_abs (MPFR_OBJ(im), MPD_OBJ(f)->im, GMP_RNDN);
c[slen++] = 'I';
c[slen++] = '*';
slen += PRINT_MPFR(c+slen, 0, n, MPFR_OBJ(im), GMP_RNDN);
}
SET_LEN_STRING(str, slen);
SHRINK_STRING(str);
return str;
}
static void
check_special (void)
{
mpc_t z[3], res;
mpc_ptr t[3];
int i, inex;
/* z[0] = (1,2), z[1] = (2,3), z[2] = (3,4) */
for (i = 0; i < 3; i++)
{
mpc_init2 (z[i], 17);
mpc_set_ui_ui (z[i], i+1, i+2, MPC_RNDNN);
t[i] = z[i];
}
mpc_init2 (res, 17);
/* dot product of empty vectors is 0 */
inex = mpc_dot (res, t, t, 0, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_zero_p (mpc_realref (res)));
MPC_ASSERT (mpfr_zero_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_signbit (mpc_realref (res)) == 0);
MPC_ASSERT (mpfr_signbit (mpc_imagref (res)) == 0);
/* (1,2)*(1,2) = (-3,4) */
inex = mpc_dot (res, t, t, 1, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_regular_p (mpc_realref (res)));
MPC_ASSERT (mpfr_regular_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_cmp_si (mpc_realref (res), -3) == 0);
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref (res), 4) == 0);
/* (1,2)*(1,2) + (2,3)*(2,3) = (-8,16) */
inex = mpc_dot (res, t, t, 2, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_regular_p (mpc_realref (res)));
MPC_ASSERT (mpfr_regular_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_cmp_si (mpc_realref (res), -8) == 0);
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref (res), 16) == 0);
/* (1,2)*(1,2) + (2,3)*(2,3) + (3,4)*(3,4) = (-15,40) */
inex = mpc_dot (res, t, t, 3, MPC_RNDNN);
MPC_ASSERT (inex == 0);
MPC_ASSERT (mpfr_regular_p (mpc_realref (res)));
MPC_ASSERT (mpfr_regular_p (mpc_imagref (res)));
MPC_ASSERT (mpfr_cmp_si (mpc_realref (res), -15) == 0);
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref (res), 40) == 0);
for (i = 0; i < 3; i++)
mpc_clear (z[i]);
mpc_clear (res);
}
static int
mpc_div_imag (mpc_ptr rop, mpc_srcptr z, mpc_srcptr w, mpc_rnd_t rnd)
/* Assumes z finite and w finite and non-zero, with real part
of w a signed zero. */
{
int inex_re, inex_im;
int overlap = (rop == z) || (rop == w);
int imag_z = mpfr_zero_p (mpc_realref (z));
mpfr_t wloc;
mpc_t tmprop;
mpc_ptr dest = (overlap) ? tmprop : rop;
/* 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));
if (overlap)
mpc_init3 (tmprop, MPC_PREC_RE (rop), MPC_PREC_IM (rop));
wloc[0] = mpc_imagref(w)[0]; /* copies mpfr struct IM(w) into wloc */
inex_re = mpfr_div (mpc_realref(dest), mpc_imagref(z), wloc, MPC_RND_RE(rnd));
mpfr_neg (wloc, wloc, MPFR_RNDN);
/* changes the sign only in wloc, not in w; no need to correct later */
inex_im = mpfr_div (mpc_imagref(dest), mpc_realref(z), wloc, MPC_RND_IM(rnd));
if (overlap) {
/* Note: we could use mpc_swap here, but this might cause problems
if rop and tmprop have been allocated using different methods, since
it will swap the significands of rop and tmprop. See
http://lists.gforge.inria.fr/pipermail/mpc-discuss/2009-August/000504.html */
mpc_set (rop, tmprop, MPC_RNDNN); /* exact */
mpc_clear (tmprop);
}
/* 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 (imag_z)
mpfr_setsign (mpc_imagref (rop), mpc_imagref (rop), (zis != wrs && zrs == wis),
MPFR_RNDN);
return MPC_INEX(inex_re, inex_im);
}
static void
test_sum (mpfr_prec_t f, unsigned long n)
{
mpfr_t sum, real_sum, real_non_rounded;
mpfr_t *tab;
unsigned long i;
int rnd_mode;
/* Init */
tab = (mpfr_t *) (*__gmp_allocate_func) (n * sizeof(mpfr_t));
for (i = 0; i < n; i++)
mpfr_init2 (tab[i], f);
mpfr_inits2 (f, sum, real_sum, real_non_rounded, (mpfr_ptr) 0);
/* First Uniform */
for (i = 0; i < n; i++)
mpfr_urandomb (tab[i], RANDS);
algo_exact (real_non_rounded, tab, n, f);
for (rnd_mode = 0; rnd_mode < MPFR_RND_MAX; rnd_mode++)
{
sum_tab (sum, tab, n, (mpfr_rnd_t) rnd_mode);
mpfr_set (real_sum, real_non_rounded, (mpfr_rnd_t) rnd_mode);
if (mpfr_cmp (real_sum, sum) != 0)
{
printf ("mpfr_sum incorrect.\n");
mpfr_dump (real_sum);
mpfr_dump (sum);
exit (1);
}
}
/* Then non uniform */
for (i = 0; i < n; i++)
{
mpfr_urandomb (tab[i], RANDS);
if (! mpfr_zero_p (tab[i]))
mpfr_set_exp (tab[i], randlimb () % 1000);
}
algo_exact (real_non_rounded, tab, n, f);
for (rnd_mode = 0; rnd_mode < MPFR_RND_MAX; rnd_mode++)
{
sum_tab (sum, tab, n, (mpfr_rnd_t) rnd_mode);
mpfr_set (real_sum, real_non_rounded, (mpfr_rnd_t) rnd_mode);
if (mpfr_cmp (real_sum, sum) != 0)
{
printf ("mpfr_sum incorrect.\n");
mpfr_dump (real_sum);
mpfr_dump (sum);
exit (1);
}
}
/* Clear stuff */
for (i = 0; i < n; i++)
mpfr_clear (tab[i]);
mpfr_clears (sum, real_sum, real_non_rounded, (mpfr_ptr) 0);
(*__gmp_free_func) (tab, n * sizeof(mpfr_t));
}
static void
special (void)
{
mpfr_t x, y;
int inex;
mpfr_init (x);
mpfr_init (y);
/* rec_sqrt(NaN) = NaN */
mpfr_set_nan (x);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x) && inex == 0);
/* rec_sqrt(+Inf) = +0 */
mpfr_set_inf (x, 1);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_zero_p (x) && MPFR_IS_POS(x) && inex == 0);
/* rec_sqrt(-Inf) = NaN */
mpfr_set_inf (x, -1);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x) && inex == 0);
/* rec_sqrt(+0) = +Inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && MPFR_IS_POS(x) && inex == 0);
/* rec_sqrt(-0) = +Inf */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && MPFR_IS_POS(x) && inex == 0);
/* rec_sqrt(-1) = NaN */
mpfr_set_si (x, -1, MPFR_RNDN);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x) && inex == 0);
/* rec_sqrt(1) = 1 */
mpfr_set_ui (x, 1, MPFR_RNDN);
inex = mpfr_rec_sqrt (x, x, MPFR_RNDN);
MPFR_ASSERTN((mpfr_cmp_ui (x, 1) == 0) && (inex == 0));
mpfr_set_prec (x, 23);
mpfr_set_prec (y, 33);
mpfr_set_str_binary (x, "1.0001110110101001010100e-1");
inex = mpfr_rec_sqrt (y, x, MPFR_RNDU);
mpfr_set_prec (x, 33);
mpfr_set_str_binary (x, "1.01010110101110100100100101011");
MPFR_ASSERTN (inex > 0 && mpfr_cmp (x, y) == 0);
mpfr_clear (x);
mpfr_clear (y);
}
int
mpc_acosh (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
/* acosh(z) =
NaN + i*NaN, if z=0+i*NaN
-i*acos(z), if sign(Im(z)) = -
i*acos(z), if sign(Im(z)) = +
http://functions.wolfram.com/ElementaryFunctions/ArcCosh/27/02/03/01/01/
*/
mpc_t a;
mpfr_t tmp;
int inex;
if (mpfr_zero_p (MPC_RE (op)) && mpfr_nan_p (MPC_IM (op)))
{
mpfr_set_nan (MPC_RE (rop));
mpfr_set_nan (MPC_IM (rop));
return 0;
}
/* Note reversal of precisions due to later multiplication by i or -i */
mpc_init3 (a, MPC_PREC_IM(rop), MPC_PREC_RE(rop));
if (mpfr_signbit (MPC_IM (op)))
{
inex = mpc_acos (a, op,
RNDC (INV_RND (MPC_RND_IM (rnd)), MPC_RND_RE (rnd)));
/* change a to -i*a, i.e., -y+i*x to x+i*y */
tmp[0] = MPC_RE (a)[0];
MPC_RE (a)[0] = MPC_IM (a)[0];
MPC_IM (a)[0] = tmp[0];
MPFR_CHANGE_SIGN (MPC_IM (a));
inex = MPC_INEX (MPC_INEX_IM (inex), -MPC_INEX_RE (inex));
}
else
{
inex = mpc_acos (a, op,
RNDC (MPC_RND_IM (rnd), INV_RND(MPC_RND_RE (rnd))));
/* change a to i*a, i.e., y-i*x to x+i*y */
tmp[0] = MPC_RE (a)[0];
MPC_RE (a)[0] = MPC_IM (a)[0];
MPC_IM (a)[0] = tmp[0];
MPFR_CHANGE_SIGN (MPC_RE (a));
inex = MPC_INEX (-MPC_INEX_IM (inex), MPC_INEX_RE (inex));
}
mpc_set (rop, a, rnd);
mpc_clear (a);
return inex;
}
/* bug reported by Kevin Rauch on 15 December 2007 */
static void
test20071215 (void)
{
mpfr_t x, y;
mpfr_init (x);
mpfr_init (y);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_asin (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_zero_p (y) && MPFR_IS_NEG(y));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_si (y, -1, MPFR_RNDN);
mpfr_asin (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_zero_p (y) && MPFR_IS_POS(y));
mpfr_clear (x);
mpfr_clear (y);
}
std::string real::get_string(int p) const
{
std::string string;
char *raw_string;
mpfr_exp_t exp;
if (mpfr_nan_p(r) != 0)
{
string = "nan";
}
else if (mpfr_inf_p(r) != 0)
{
if (mpfr_sgn(r) < 0)
{
string = "-inf";
}
else
{
string = "inf";
}
}
else
{
// Dynamically allocate a character array to hold the base-10
// representation of the real.
raw_string = new char[(int)mpfr_get_default_prec()];
mpfr_get_str(raw_string, &exp, 10, p, r, MPFR_RNDN);
string = std::string(raw_string);
if (mpfr_zero_p(r) == 0)
{
// The cast is to prevent a warning in case mpfr_exp_t is not
// defined as an int, but as a short or a long.
std::sprintf(raw_string, "%d", (int)(exp - 1));
}
else
{
std::sprintf(raw_string, "0");
}
if (string[0] == '-')
{
string = string.substr(0, 2) + std::string(".") + string.substr(2) + std::string("e") + std::string(raw_string);
}
else
{
string = string.substr(0, 1) + std::string(".") + string.substr(1) + std::string("e") + std::string(raw_string);
}
// Free the array.
delete[] raw_string;
}
return string;
}
int
mpfi_sub (mpfi_ptr a, mpfi_srcptr b, mpfi_srcptr c)
{
mpfr_t tmp;
int inexact_left, inexact_right, inexact = 0;
if (MPFI_IS_ZERO (c)) {
return mpfi_set (a, b);
}
else if (MPFI_IS_ZERO (b)) {
return mpfi_neg (a, c);
}
else {
mpfr_init2 (tmp, mpfr_get_prec (&(a->left)));
inexact_left = mpfr_sub (tmp, &(b->left), &(c->right), MPFI_RNDD);
inexact_right = mpfr_sub (&(a->right), &(b->right), &(c->left), MPFI_RNDU);
mpfr_set (&(a->left), tmp, MPFI_RNDD); /* exact */
mpfr_clear (tmp);
/* do not allow -0 as lower bound */
if (mpfr_zero_p (&(a->left)) && mpfr_signbit (&(a->left))) {
mpfr_neg (&(a->left), &(a->left), MPFI_RNDU);
}
/* do not allow +0 as upper bound */
if (mpfr_zero_p (&(a->right)) && !mpfr_signbit (&(a->right))) {
mpfr_neg (&(a->right), &(a->right), MPFI_RNDD);
}
if (MPFI_NAN_P (a))
MPFR_RET_NAN;
if (inexact_left)
inexact += 1;
if (inexact_right)
inexact += 2;
return inexact;
}
}
static void
check_special (void)
{
mpfr_t x, y;
mpfr_exp_t emin;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_sqr (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y));
mpfr_set_inf (x, 1);
mpfr_sqr (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y) && mpfr_sgn (y) > 0);
mpfr_set_inf (x, -1);
mpfr_sqr (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y) && mpfr_sgn (y) > 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_sqr (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_zero_p (y));
emin = mpfr_get_emin ();
mpfr_set_emin (0);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
MPFR_ASSERTN (!mpfr_zero_p (x));
mpfr_sqr (y, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_zero_p (y));
mpfr_set_emin (emin);
mpfr_clear (y);
mpfr_clear (x);
}
int
mpfi_interv_fr (mpfi_ptr a, mpfr_srcptr b, mpfr_srcptr c)
{
int inexact_left, inexact_right, inexact=0;
if ( mpfr_nan_p (b) || mpfr_nan_p (c) ) {
mpfr_set_nan (&(a->left));
mpfr_set_nan (&(a->right));
MPFR_RET_NAN;
}
if ( mpfr_cmp (b, c) <= 0 ) {
inexact_left = mpfr_set (&(a->left), b, MPFI_RNDD);
inexact_right = mpfr_set (&(a->right), c, MPFI_RNDU);
}
else {
inexact_left = mpfr_set (&(a->left), c, MPFI_RNDD);
inexact_right = mpfr_set (&(a->right), b, MPFI_RNDU);
}
/* a cannot be a NaN, it has been tested before */
if (inexact_left)
inexact += 1;
if (inexact_right)
inexact += 2;
/* do not allow -0 as lower bound */
if (mpfr_zero_p (&(a->left)) && mpfr_signbit (&(a->left))) {
mpfr_neg (&(a->left), &(a->left), MPFI_RNDU);
}
/* do not allow +0 as upper bound */
if (mpfr_zero_p (&(a->right)) && !mpfr_signbit (&(a->right))) {
mpfr_neg (&(a->right), &(a->right), MPFI_RNDD);
}
return inexact;
}
void
tpl_read_mpfr (mpc_datafile_context_t* datafile_context, mpfr_ptr x,
int* known_sign)
{
int sign;
mpfr_set_prec (x, tpl_read_mpfr_prec (datafile_context));
sign = datafile_context->nextchar;
tpl_read_mpfr_mantissa (datafile_context, x);
/* the sign always matters for regular values ('+' is implicit),
but when no sign appears before 0 or Inf in the data file, it means
that only absolute value must be checked. */
MPC_ASSERT(known_sign != NULL);
*known_sign =
(!mpfr_zero_p (x) && !mpfr_inf_p (x)) || sign == '+' || sign == '-';
}
obool_t
ofalse_p(oobject_t object)
{
if (object == null)
return (true);
switch (otype(object)) {
case t_word:
return (*(oword_t *)object == 0);
case t_float:
return (*(ofloat_t *)object == 0.0);
case t_mpr:
return (mpfr_zero_p((ompr_t)object) != 0);
default:
return (false);
}
}
void
read_mpfr (FILE *fp, mpfr_ptr x, int *known_sign)
{
int sign;
mpfr_set_prec (x, read_mpfr_prec (fp));
sign = nextchar;
read_mpfr_mantissa (fp, x);
/* the sign always matters for regular values ('+' is implicit),
but when no sign appears before 0 or Inf in the data file, it means
that only absolute value must be checked. */
if (known_sign != NULL)
*known_sign =
(!mpfr_zero_p (x) && !mpfr_inf_p (x))
|| sign == '+' || sign == '-';
}
static void
consistency (void)
{
mpfr_t x, y, z1, z2;
int i;
mpfr_inits (x, y, z1, z2, (mpfr_ptr) 0);
for (i = 0; i < 10000; i++)
{
mpfr_rnd_t rnd;
mpfr_prec_t px, py, pz, p;
int inex1, inex2;
rnd = RND_RAND ();
px = (randlimb () % 256) + 2;
py = (randlimb () % 128) + 2;
pz = (randlimb () % 256) + 2;
mpfr_set_prec (x, px);
mpfr_set_prec (y, py);
mpfr_set_prec (z1, pz);
mpfr_set_prec (z2, pz);
mpfr_urandomb (x, RANDS);
do
mpfr_urandomb (y, RANDS);
while (mpfr_zero_p (y));
inex1 = mpfr_div (z1, x, y, rnd);
MPFR_ASSERTN (!MPFR_IS_NAN (z1));
p = MAX (MAX (px, py), pz);
if (mpfr_prec_round (x, p, MPFR_RNDN) != 0 ||
mpfr_prec_round (y, p, MPFR_RNDN) != 0)
{
printf ("mpfr_prec_round error for i = %d\n", i);
exit (1);
}
inex2 = mpfr_div (z2, x, y, rnd);
MPFR_ASSERTN (!MPFR_IS_NAN (z2));
if (inex1 != inex2 || mpfr_cmp (z1, z2) != 0)
{
printf ("Consistency error for i = %d\n", i);
exit (1);
}
}
mpfr_clears (x, y, z1, z2, (mpfr_ptr) 0);
}
static char *
get_pretty_str (const int base, const size_t n, mpfr_srcptr x, mpfr_rnd_t rnd)
{
mp_exp_t expo;
char *ugly;
char *pretty;
if (mpfr_zero_p (x))
return pretty_zero (x);
ugly = mpfr_get_str (NULL, &expo, base, n, x, rnd);
MPC_ASSERT (ugly != NULL);
pretty = prettify (ugly, expo, base, !mpfr_number_p (x));
mpfr_free_str (ugly);
return pretty;
}
