/* 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 void
check_nans (void)
{
mpfr_t x, s, c;
mpfr_init2 (x, 123L);
mpfr_init2 (s, 123L);
mpfr_init2 (c, 123L);
/* sin(NaN)==NaN, cos(NaN)==NaN */
mpfr_set_nan (x);
mpfr_sin_cos (s, c, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (s));
MPFR_ASSERTN (mpfr_nan_p (c));
/* sin(+Inf)==NaN, cos(+Inf)==NaN */
mpfr_set_inf (x, 1);
mpfr_sin_cos (s, c, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (s));
MPFR_ASSERTN (mpfr_nan_p (c));
/* sin(-Inf)==NaN, cos(-Inf)==NaN */
mpfr_set_inf (x, -1);
mpfr_sin_cos (s, c, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (s));
MPFR_ASSERTN (mpfr_nan_p (c));
/* check zero */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_sin_cos (s, c, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (s, 0) == 0 && MPFR_IS_POS (s));
MPFR_ASSERTN (mpfr_cmp_ui (c, 1) == 0);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_sin_cos (s, c, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (s, 0) == 0 && MPFR_IS_NEG (s));
MPFR_ASSERTN (mpfr_cmp_ui (c, 1) == 0);
/* coverage test */
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 4, MPFR_RNDN);
mpfr_set_prec (s, 2);
mpfr_set_prec (c, 2);
mpfr_sin_cos (s, c, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si_2exp (s, -3, -2) == 0);
MPFR_ASSERTN (mpfr_cmp_si_2exp (c, -3, -2) == 0);
mpfr_clear (x);
mpfr_clear (s);
mpfr_clear (c);
}
static void
special (void)
{
mpfr_t x;
int i;
mpfr_init (x);
mpfr_set_nan (x);
mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_inf (x, -1);
mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_prec (x, 10);
mpfr_set_str_binary (x, "-0.1001011001");
mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_si_2exp (x, -159, -8) == 0);
/* corner case */
mpfr_set_prec (x, 2);
mpfr_set_str_binary (x, "1E-6");
mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui_2exp (x, 1, -6) == 0);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "1E1000000000");
i = mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
MPFR_ASSERTN (mpfr_overflow_p ());
MPFR_ASSERTN (i == 1);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "-1E1000000000");
i = mpfr_sinh (x, x, MPFR_RNDN);
MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) < 0);
MPFR_ASSERTN (mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == -1);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "-1E1000000000");
i = mpfr_sinh (x, x, MPFR_RNDD);
MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) < 0);
MPFR_ASSERTN (mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == -1);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "-1E1000000000");
i = mpfr_sinh (x, x, MPFR_RNDU);
MPFR_ASSERTN (!MPFR_IS_INF (x) && MPFR_SIGN (x) < 0);
MPFR_ASSERTN (mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == 1);
mpfr_clear (x);
}
static void
special (void)
{
mpfr_t x;
mpfr_init (x);
mpfr_set_nan (x);
mpfr_tanh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_tanh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
mpfr_set_inf (x, -1);
mpfr_tanh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_si (x, -1) == 0);
mpfr_set_prec (x, 10);
mpfr_set_str_binary (x, "-0.1001011001");
mpfr_tanh (x, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_si_2exp (x, -135, -8) == 0);
mpfr_clear (x);
}
/* bug found by Kevin P. Rauch on 22 Oct 2007 */
static void
check2 (void)
{
mpfr_t x, y, z;
int tern;
mpfr_exp_t emin;
emin = mpfr_get_emin ();
mpfr_init2 (x, 32);
mpfr_init2 (y, 32);
mpfr_init2 (z, 32);
mpfr_set_ui (x, 0xC0000000U, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 0xFFFFFFFEU, MPFR_RNDN);
mpfr_set_exp (x, 0);
mpfr_set_exp (y, 0);
mpfr_set_emin (-29);
tern = mpfr_mul (z, x, y, MPFR_RNDN);
/* z = -0.BFFFFFFE, tern > 0 */
tern = mpfr_subnormalize (z, tern, MPFR_RNDN);
/* z should be -0.75 */
MPFR_ASSERTN (tern < 0 && mpfr_cmp_si_2exp (z, -3, -2) == 0);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
MPFR_ASSERTN (mpfr_get_emin () == -29);
set_emin (emin);
}
/* return non zero iff x^y is exact.
Assumes x and y are ordinary numbers (neither NaN nor Inf),
and y is not zero.
*/
int
mpfr_pow_is_exact (mpfr_srcptr x, mpfr_srcptr y)
{
mp_exp_t d;
unsigned long i, c;
mp_limb_t *yp;
if ((mpfr_sgn (x) < 0) && (mpfr_isinteger (y) == 0))
return 0;
if (mpfr_sgn (y) < 0)
return mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0;
/* compute d such that y = c*2^d with c odd integer */
d = MPFR_EXP(y) - MPFR_PREC(y);
/* since y is not zero, necessarily one of the mantissa limbs is not zero,
thus we can simply loop until we find a non zero limb */
yp = MPFR_MANT(y);
for (i = 0; yp[i] == 0; i++, d += BITS_PER_MP_LIMB);
/* now yp[i] is not zero */
count_trailing_zeros (c, yp[i]);
d += c;
if (d < 0)
{
mpz_t a;
mp_exp_t b;
mpz_init (a);
b = mpfr_get_z_exp (a, x); /* x = a * 2^b */
c = mpz_scan1 (a, 0);
mpz_div_2exp (a, a, c);
b += c;
/* now a is odd */
while (d != 0)
{
if (mpz_perfect_square_p (a))
{
d++;
mpz_sqrt (a, a);
}
else
{
mpz_clear (a);
return 0;
}
}
mpz_clear (a);
}
return 1;
}
static int _fmpq_poly_oz_sqrt_approx_break(mpfr_t norm, const fmpq_poly_t f_sqrt, const fmpq_poly_t f, const long n, const mpfr_prec_t bound, const mpfr_prec_t prec) {
fmpq_poly_t f_approx;
fmpq_poly_init(f_approx);
fmpq_poly_oz_mul(f_approx, f_sqrt, f_sqrt, n);
fmpq_poly_sub(f_approx, f_approx, f);
fmpq_poly_2norm_mpfr(norm, f_approx, MPFR_RNDN);
mpfr_t f_norm;
mpfr_init2(f_norm, prec);
fmpq_poly_2norm_mpfr(f_norm, f, MPFR_RNDN);
mpfr_div(norm, norm, f_norm, MPFR_RNDN);
int r = 0;
if(mpfr_cmp_si_2exp(norm, 1, -bound) < 0)
r = 1;
mpfr_clear(f_norm);
fmpq_poly_clear(f_approx);
return r;
}
SeedValue seed_mpfr_cmp_si_2exp (SeedContext ctx,
SeedObject function,
SeedObject this_object,
gsize argument_count,
const SeedValue args[],
SeedException *exception)
{
mpfr_ptr op1;
gulong op2;
mp_exp_t exp;
gint ret;
CHECK_ARG_COUNT("mpfr.cmp_si_2exp", 2);
op1 = seed_object_get_private(this_object);
if ( seed_value_is_number(ctx, args[0]) )
{
op2 = seed_value_to_ulong(ctx, args[0], exception);
}
else
{
TYPE_EXCEPTION("mpfr.cmp_si_2exp", "long int");
}
if ( seed_value_is_number(ctx, args[1]) )
{
exp = seed_value_to_mp_exp_t(ctx, args[1], exception);
}
else
{
TYPE_EXCEPTION("mpfr.cmp_si_2exp", "mp_exp_t");
}
ret = mpfr_cmp_si_2exp(op1, op2, exp);
return seed_value_from_int(ctx, ret, exception);
}
int
main (void)
{
mpfr_t x;
int r;
mp_prec_t p;
unsigned long k;
tests_start_mpfr ();
special ();
mpfr_init (x);
for (p = 2; p < 100; p++)
{
mpfr_set_prec (x, p);
for (r = 0; r < GMP_RND_MAX; r++)
{
mpfr_set_ui (x, 1, GMP_RNDN);
k = 2 + randlimb () % 4; /* 2 <= k <= 5 */
mpfr_root (x, x, k, (mp_rnd_t) r);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in mpfr_root(%lu) for x=1, rnd=%s\ngot ",
k, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
if (k % 2)
{
mpfr_root (x, x, k, (mp_rnd_t) r);
if (mpfr_cmp_si (x, -1))
{
printf ("Error in mpfr_root(%lu) for x=-1, rnd=%s\ngot ",
k, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
}
if (p >= 5)
{
int i;
for (i = -12; i <= 12; i++)
{
mpfr_set_ui (x, 27, GMP_RNDN);
mpfr_mul_2si (x, x, 3*i, GMP_RNDN);
mpfr_root (x, x, 3, GMP_RNDN);
if (mpfr_cmp_si_2exp (x, 3, i))
{
printf ("Error in mpfr_root(3) for "
"x = 27.0 * 2^(%d), rnd=%s\ngot ",
3*i, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\ninstead of 3 * 2^(%d)\n", i);
exit (1);
}
}
}
}
}
mpfr_clear (x);
test_generic_ui (2, 200, 30);
tests_end_mpfr ();
return 0;
}
float
mpfr_get_flt (mpfr_srcptr src, mpfr_rnd_t rnd_mode)
{
int negative;
mpfr_exp_t e;
float d;
/* in case of NaN, +Inf, -Inf, +0, -0, the conversion from double to float
is exact */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (src)))
return (float) mpfr_get_d (src, rnd_mode);
e = MPFR_GET_EXP (src);
negative = MPFR_IS_NEG (src);
if (MPFR_UNLIKELY(rnd_mode == MPFR_RNDA))
rnd_mode = negative ? MPFR_RNDD : MPFR_RNDU;
/* the smallest positive normal float number is 2^(-126) = 0.5*2^(-125),
and the smallest positive subnormal number is 2^(-149) = 0.5*2^(-148) */
if (MPFR_UNLIKELY (e < -148))
{
/* |src| < 2^(-149), i.e., |src| is smaller than the smallest positive
subnormal number.
In round-to-nearest mode, 2^(-150) is rounded to zero.
*/
d = negative ?
(rnd_mode == MPFR_RNDD ||
(rnd_mode == MPFR_RNDN && mpfr_cmp_si_2exp (src, -1, -150) < 0)
? -FLT_MIN : FLT_NEG_ZERO) :
(rnd_mode == MPFR_RNDU ||
(rnd_mode == MPFR_RNDN && mpfr_cmp_si_2exp (src, 1, -150) > 0)
? FLT_MIN : 0.0);
if (d != 0.0) /* we multiply FLT_MIN = 2^(-126) by FLT_EPSILON = 2^(-23)
to get +-2^(-149) */
d *= FLT_EPSILON;
}
/* the largest normal number is 2^128*(1-2^(-24)) = 0.111...111e128 */
else if (MPFR_UNLIKELY (e > 128))
{
d = negative ?
(rnd_mode == MPFR_RNDZ || rnd_mode == MPFR_RNDU ?
-FLT_MAX : MPFR_FLT_INFM) :
(rnd_mode == MPFR_RNDZ || rnd_mode == MPFR_RNDD ?
FLT_MAX : MPFR_FLT_INFP);
}
else /* -148 <= e <= 127 */
{
int nbits;
mp_size_t np, i;
mp_limb_t tp[MPFR_LIMBS_PER_FLT];
int carry;
double dd;
nbits = IEEE_FLT_MANT_DIG; /* 24 */
if (MPFR_UNLIKELY (e < -125))
/*In the subnormal case, compute the exact number of significant bits*/
{
nbits += (125 + e);
MPFR_ASSERTD (nbits >= 1);
}
np = MPFR_PREC2LIMBS (nbits);
MPFR_ASSERTD(np <= MPFR_LIMBS_PER_FLT);
carry = mpfr_round_raw_4 (tp, MPFR_MANT(src), MPFR_PREC(src), negative,
nbits, rnd_mode);
/* we perform the reconstruction using the 'double' type here,
knowing the result is exactly representable as 'float' */
if (MPFR_UNLIKELY(carry))
dd = 1.0;
else
{
/* The following computations are exact thanks to the previous
mpfr_round_raw. */
dd = (double) tp[0] / MP_BASE_AS_DOUBLE;
for (i = 1 ; i < np ; i++)
dd = (dd + tp[i]) / MP_BASE_AS_DOUBLE;
/* dd is the mantissa (between 1/2 and 1) of the argument rounded
to 24 bits */
}
dd = mpfr_scale2 (dd, e);
if (negative)
dd = -dd;
/* convert (exacly) to float */
d = (float) dd;
}
return d;
}
int
main (int argc, char *argv[])
{
#if MPFR_VERSION >= MPFR_VERSION_NUM(2,3,0)
unsigned int prec, yprec;
int rnd;
mpfr_t x, y, z, t;
unsigned long n;
int inex;
tests_start_mpfr ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
if (argc >= 3) /* tzeta_ui n prec [rnd] */
{
mpfr_set_prec (x, atoi (argv[2]));
mpfr_zeta_ui (x, atoi (argv[1]),
argc > 3 ? (mpfr_rnd_t) atoi (argv[3]) : MPFR_RNDN);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("\n");
goto clear_and_exit;
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 33);
mpfr_zeta_ui (x, 3, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.100110011101110100000000001001111E1");
if (mpfr_cmp (x, y))
{
printf ("Error for zeta(3), prec=33, MPFR_RNDZ\n");
printf ("expected "); mpfr_dump (y);
printf ("got "); mpfr_dump (x);
exit (1);
}
mpfr_clear_divby0 ();
inex = mpfr_zeta_ui (x, 0, MPFR_RNDN);
MPFR_ASSERTN (inex == 0 && mpfr_cmp_si_2exp (x, -1, -1) == 0
&& !mpfr_divby0_p ());
mpfr_clear_divby0 ();
inex = mpfr_zeta_ui (x, 1, MPFR_RNDN);
MPFR_ASSERTN (inex == 0 && MPFR_IS_INF (x) && MPFR_IS_POS (x)
&& mpfr_divby0_p ());
for (prec = MPFR_PREC_MIN; prec <= 100; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
for (n = 0; n < 50; n++)
for (rnd = 0; rnd < MPFR_RND_MAX; rnd++)
{
mpfr_zeta_ui (y, n, MPFR_RNDN);
if (mpfr_can_round (y, yprec, MPFR_RNDN, MPFR_RNDZ, prec
+ (rnd == MPFR_RNDN)))
{
mpfr_set (t, y, (mpfr_rnd_t) rnd);
mpfr_zeta_ui (z, n, (mpfr_rnd_t) rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for n=%lu", n);
printf (" prec=%u rnd_mode=%s\n", prec,
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
printf (" got ");
mpfr_dump (z);
printf (" expected ");
mpfr_dump (t);
printf (" approx ");
mpfr_dump (y);
exit (1);
}
}
}
}
clear_and_exit:
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
tests_end_mpfr ();
#endif
return 0;
}
/* The computation of z = pow(x,y) is done by
z = exp(y * log(x)) = x^y
For the special cases, see Section F.9.4.4 of the C standard:
_ pow(±0, y) = ±inf for y an odd integer < 0.
_ pow(±0, y) = +inf for y < 0 and not an odd integer.
_ pow(±0, y) = ±0 for y an odd integer > 0.
_ pow(±0, y) = +0 for y > 0 and not an odd integer.
_ pow(-1, ±inf) = 1.
_ pow(+1, y) = 1 for any y, even a NaN.
_ pow(x, ±0) = 1 for any x, even a NaN.
_ pow(x, y) = NaN for finite x < 0 and finite non-integer y.
_ pow(x, -inf) = +inf for |x| < 1.
_ pow(x, -inf) = +0 for |x| > 1.
_ pow(x, +inf) = +0 for |x| < 1.
_ pow(x, +inf) = +inf for |x| > 1.
_ pow(-inf, y) = -0 for y an odd integer < 0.
_ pow(-inf, y) = +0 for y < 0 and not an odd integer.
_ pow(-inf, y) = -inf for y an odd integer > 0.
_ pow(-inf, y) = +inf for y > 0 and not an odd integer.
_ pow(+inf, y) = +0 for y < 0.
_ pow(+inf, y) = +inf for y > 0. */
int
mpfr_pow (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode)
{
int inexact;
int cmp_x_1;
int y_is_integer;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x,
mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (z), mpfr_log_prec, z, inexact));
if (MPFR_ARE_SINGULAR (x, y))
{
/* pow(x, 0) returns 1 for any x, even a NaN. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (y)))
return mpfr_set_ui (z, 1, rnd_mode);
else if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_NAN (y))
{
/* pow(+1, NaN) returns 1. */
if (mpfr_cmp_ui (x, 1) == 0)
return mpfr_set_ui (z, 1, rnd_mode);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (y))
{
if (MPFR_IS_INF (x))
{
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int cmp;
cmp = mpfr_cmpabs (x, __gmpfr_one) * MPFR_INT_SIGN (y);
MPFR_SET_POS (z);
if (cmp > 0)
{
/* Return +inf. */
MPFR_SET_INF (z);
MPFR_RET (0);
}
else if (cmp < 0)
{
/* Return +0. */
MPFR_SET_ZERO (z);
MPFR_RET (0);
}
else
{
/* Return 1. */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
}
else if (MPFR_IS_INF (x))
{
int negative;
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG (x) && is_odd (y);
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int negative;
MPFR_ASSERTD (MPFR_IS_ZERO (x));
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG(x) && is_odd (y);
if (MPFR_IS_NEG (y))
{
MPFR_ASSERTD (! MPFR_IS_INF (y));
MPFR_SET_INF (z);
mpfr_set_divby0 ();
}
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* x^y for x < 0 and y not an integer is not defined */
y_is_integer = mpfr_integer_p (y);
if (MPFR_IS_NEG (x) && ! y_is_integer)
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
/* now the result cannot be NaN:
(1) either x > 0
(2) or x < 0 and y is an integer */
cmp_x_1 = mpfr_cmpabs (x, __gmpfr_one);
if (cmp_x_1 == 0)
return mpfr_set_si (z, MPFR_IS_NEG (x) && is_odd (y) ? -1 : 1, rnd_mode);
/* now we have:
(1) either x > 0
(2) or x < 0 and y is an integer
and in addition |x| <> 1.
*/
/* detect overflow: an overflow is possible if
(a) |x| > 1 and y > 0
(b) |x| < 1 and y < 0.
FIXME: this assumes 1 is always representable.
FIXME2: maybe we can test overflow and underflow simultaneously.
The idea is the following: first compute an approximation to
y * log2|x|, using rounding to nearest. If |x| is not too near from 1,
this approximation should be accurate enough, and in most cases enable
one to prove that there is no underflow nor overflow.
Otherwise, it should enable one to check only underflow or overflow,
instead of both cases as in the present case.
*/
if (cmp_x_1 * MPFR_SIGN (y) > 0)
{
mpfr_t t;
int negative, overflow;
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (t, 53);
/* we want a lower bound on y*log2|x|:
(i) if x > 0, it suffices to round log2(x) toward zero, and
to round y*o(log2(x)) toward zero too;
(ii) if x < 0, we first compute t = o(-x), with rounding toward 1,
and then follow as in case (1). */
if (MPFR_SIGN (x) > 0)
mpfr_log2 (t, x, MPFR_RNDZ);
else
{
mpfr_neg (t, x, (cmp_x_1 > 0) ? MPFR_RNDZ : MPFR_RNDU);
mpfr_log2 (t, t, MPFR_RNDZ);
}
mpfr_mul (t, t, y, MPFR_RNDZ);
overflow = mpfr_cmp_si (t, __gmpfr_emax) > 0;
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
if (overflow)
{
MPFR_LOG_MSG (("early overflow detection\n", 0));
negative = MPFR_SIGN(x) < 0 && is_odd (y);
return mpfr_overflow (z, rnd_mode, negative ? -1 : 1);
}
}
/* Basic underflow checking. One has:
* - if y > 0, |x^y| < 2^(EXP(x) * y);
* - if y < 0, |x^y| <= 2^((EXP(x) - 1) * y);
* so that one can compute a value ebound such that |x^y| < 2^ebound.
* If we have ebound <= emin - 2 (emin - 1 in directed rounding modes),
* then there is an underflow and we can decide the return value.
*/
if (MPFR_IS_NEG (y) ? (MPFR_GET_EXP (x) > 1) : (MPFR_GET_EXP (x) < 0))
{
mpfr_t tmp;
mpfr_eexp_t ebound;
int inex2;
/* We must restore the flags. */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, sizeof (mpfr_exp_t) * CHAR_BIT);
inex2 = mpfr_set_exp_t (tmp, MPFR_GET_EXP (x), MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
if (MPFR_IS_NEG (y))
{
inex2 = mpfr_sub_ui (tmp, tmp, 1, MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
}
mpfr_mul (tmp, tmp, y, MPFR_RNDU);
if (MPFR_IS_NEG (y))
mpfr_nextabove (tmp);
/* tmp doesn't necessarily fit in ebound, but that doesn't matter
since we get the minimum value in such a case. */
ebound = mpfr_get_exp_t (tmp, MPFR_RNDU);
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
if (MPFR_UNLIKELY (ebound <=
__gmpfr_emin - (rnd_mode == MPFR_RNDN ? 2 : 1)))
{
/* warning: mpfr_underflow rounds away from 0 for MPFR_RNDN */
MPFR_LOG_MSG (("early underflow detection\n", 0));
return mpfr_underflow (z,
rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
MPFR_SIGN (x) < 0 && is_odd (y) ? -1 : 1);
}
}
/* If y is an integer, we can use mpfr_pow_z (based on multiplications),
but if y is very large (I'm not sure about the best threshold -- VL),
we shouldn't use it, as it can be very slow and take a lot of memory
(and even crash or make other programs crash, as several hundred of
MBs may be necessary). Note that in such a case, either x = +/-2^b
(this case is handled below) or x^y cannot be represented exactly in
any precision supported by MPFR (the general case uses this property).
*/
if (y_is_integer && (MPFR_GET_EXP (y) <= 256))
{
mpz_t zi;
MPFR_LOG_MSG (("special code for y not too large integer\n", 0));
mpz_init (zi);
mpfr_get_z (zi, y, MPFR_RNDN);
inexact = mpfr_pow_z (z, x, zi, rnd_mode);
mpz_clear (zi);
return inexact;
}
/* Special case (+/-2^b)^Y which could be exact. If x is negative, then
necessarily y is a large integer. */
{
mpfr_exp_t b = MPFR_GET_EXP (x) - 1;
MPFR_ASSERTN (b >= LONG_MIN && b <= LONG_MAX); /* FIXME... */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), b) == 0)
{
mpfr_t tmp;
int sgnx = MPFR_SIGN (x);
MPFR_LOG_MSG (("special case (+/-2^b)^Y\n", 0));
/* now x = +/-2^b, so x^y = (+/-1)^y*2^(b*y) is exact whenever b*y is
an integer */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_PREC (y) + sizeof (long) * CHAR_BIT);
inexact = mpfr_mul_si (tmp, y, b, MPFR_RNDN); /* exact */
MPFR_ASSERTN (inexact == 0);
/* Note: as the exponent range has been extended, an overflow is not
possible (due to basic overflow and underflow checking above, as
the result is ~ 2^tmp), and an underflow is not possible either
because b is an integer (thus either 0 or >= 1). */
MPFR_CLEAR_FLAGS ();
inexact = mpfr_exp2 (z, tmp, rnd_mode);
mpfr_clear (tmp);
if (sgnx < 0 && is_odd (y))
{
mpfr_neg (z, z, rnd_mode);
inexact = -inexact;
}
/* Without the following, the overflows3 test in tpow.c fails. */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Case where |y * log(x)| is very small. Warning: x can be negative, in
that case y is a large integer. */
{
mpfr_t t;
mpfr_exp_t err;
/* We need an upper bound on the exponent of y * log(x). */
mpfr_init2 (t, 16);
if (MPFR_IS_POS(x))
mpfr_log (t, x, cmp_x_1 < 0 ? MPFR_RNDD : MPFR_RNDU); /* away from 0 */
else
{
/* if x < -1, round to +Inf, else round to zero */
mpfr_neg (t, x, (mpfr_cmp_si (x, -1) < 0) ? MPFR_RNDU : MPFR_RNDD);
mpfr_log (t, t, (mpfr_cmp_ui (t, 1) < 0) ? MPFR_RNDD : MPFR_RNDU);
}
MPFR_ASSERTN (MPFR_IS_PURE_FP (t));
err = MPFR_GET_EXP (y) + MPFR_GET_EXP (t);
mpfr_clear (t);
MPFR_CLEAR_FLAGS ();
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (z, __gmpfr_one, - err, 0,
(MPFR_SIGN (y) > 0) ^ (cmp_x_1 < 0),
rnd_mode, expo, {});
}
/* General case */
inexact = mpfr_pow_general (z, x, y, rnd_mode, y_is_integer, &expo);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
int
mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd)
{
if (n >= 0)
return mpfr_pow_ui (y, x, n, rnd);
else
{
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
MPFR_SET_ZERO (y);
if (MPFR_IS_POS (x) || ((unsigned) n & 1) == 0)
MPFR_SET_POS (y);
else
MPFR_SET_NEG (y);
MPFR_RET (0);
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_INF(y);
if (MPFR_IS_POS (x) || ((unsigned) n & 1) == 0)
MPFR_SET_POS (y);
else
MPFR_SET_NEG (y);
MPFR_RET(0);
}
}
MPFR_CLEAR_FLAGS (y);
/* detect exact powers: x^(-n) is exact iff x is a power of 2 */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0)
{
mp_exp_t expx = MPFR_EXP (x) - 1, expy;
MPFR_ASSERTD (n < 0);
/* Warning: n * expx may overflow!
* Some systems (apparently alpha-freebsd) abort with
* LONG_MIN / 1, and LONG_MIN / -1 is undefined.
* Proof of the overflow checking. The expressions below are
* assumed to be on the rational numbers, but the word "overflow"
* still has its own meaning in the C context. / still denotes
* the integer (truncated) division, and // denotes the exact
* division.
* - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n
* cannot overflow due to the constraints on the exponents of
* MPFR numbers.
* - If n = -1, then n * expx = - expx, which is representable
* because of the constraints on the exponents of MPFR numbers.
* - If expx = 0, then n * expx = 0, which is representable.
* - If n < -1 and expx > 0:
* + If expx > (__gmpfr_emin - 1) / n, then
* expx >= (__gmpfr_emin - 1) / n + 1
* > (__gmpfr_emin - 1) // n,
* and
* n * expx < __gmpfr_emin - 1,
* i.e.
* n * expx <= __gmpfr_emin - 2.
* This corresponds to an underflow, with a null result in
* the rounding-to-nearest mode.
* + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot
* overflow since 0 < expx <= (__gmpfr_emin - 1) / n and
* 0 > n * expx >= n * ((__gmpfr_emin - 1) / n)
* >= __gmpfr_emin - 1.
* - If n < -1 and expx < 0:
* + If expx < (__gmpfr_emax - 1) / n, then
* expx <= (__gmpfr_emax - 1) / n - 1
* < (__gmpfr_emax - 1) // n,
* and
* n * expx > __gmpfr_emax - 1,
* i.e.
* n * expx >= __gmpfr_emax.
* This corresponds to an overflow (2^(n * expx) has an
* exponent > __gmpfr_emax).
* + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot
* overflow since 0 > expx >= (__gmpfr_emax - 1) / n and
* 0 < n * expx <= n * ((__gmpfr_emax - 1) / n)
* <= __gmpfr_emax - 1.
* Note: one could use expx bounds based on MPFR_EXP_MIN and
* MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The
* current bounds do not lead to noticeably slower code and
* allow us to avoid a bug in Sun's compiler for Solaris/x86
* (when optimizations are enabled).
*/
expy =
n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ?
MPFR_EMIN_MIN - 2 /* Underflow */ :
n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ?
MPFR_EMAX_MAX /* Overflow */ : n * expx;
return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1,
expy, rnd);
}
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mp_prec_t Ny = MPFR_PREC (y); /* target precision */
mp_prec_t Nt; /* working precision */
mp_exp_t err; /* error */
int inexact;
unsigned long abs_n;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
abs_n = - (unsigned long) n;
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 3 + MPFR_INT_CEIL_LOG2 (Ny);
MPFR_SAVE_EXPO_MARK (expo);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute 1/(x^n), with n > 0 */
mpfr_pow_ui (t, x, abs_n, GMP_RNDN);
mpfr_ui_div (t, 1, t, GMP_RNDN);
/* FIXME: old code improved, but I think this is still incorrect. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (t)))
{
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (y, rnd == GMP_RNDN ? GMP_RNDZ : rnd,
abs_n & 1 ? MPFR_SIGN (x) :
MPFR_SIGN_POS);
}
if (MPFR_UNLIKELY (MPFR_IS_INF (t)))
{
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) :
MPFR_SIGN_POS);
}
/* error estimate -- see pow function in algorithms.ps */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd)))
break;
/* actualisation of the precision */
Nt += BITS_PER_MP_LIMB;
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd);
}
}
}
int
main (void)
{
mpfr_t x;
int r;
mp_prec_t p;
tests_start_mpfr ();
special ();
mpfr_init (x);
for (p=2; p<100; p++)
{
mpfr_set_prec (x, p);
for (r = 0; r < GMP_RND_MAX; r++)
{
mpfr_set_ui (x, 1, GMP_RNDN);
mpfr_cbrt (x, x, (mp_rnd_t) r);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in mpfr_cbrt for x=1, rnd=%s\ngot ",
mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_cbrt (x, x, (mp_rnd_t) r);
if (mpfr_cmp_si (x, -1))
{
printf ("Error in mpfr_cbrt for x=-1, rnd=%s\ngot ",
mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
if (p >= 5)
{
int i;
for (i = -12; i <= 12; i++)
{
mpfr_set_ui (x, 27, GMP_RNDN);
mpfr_mul_2si (x, x, 3*i, GMP_RNDN);
mpfr_cbrt (x, x, GMP_RNDN);
if (mpfr_cmp_si_2exp (x, 3, i))
{
printf ("Error in mpfr_cbrt for "
"x = 27.0 * 2^(%d), rnd=%s\ngot ",
3*i, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\ninstead of 3 * 2^(%d)\n", i);
exit (1);
}
}
}
}
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
/* return non zero iff x^y is exact.
Assumes x and y are ordinary numbers,
y is not an integer, x is not a power of 2 and x is positive
If x^y is exact, it computes it and sets *inexact.
*/
static int
mpfr_pow_is_exact (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y,
mpfr_rnd_t rnd_mode, int *inexact)
{
mpz_t a, c;
mpfr_exp_t d, b;
unsigned long i;
int res;
MPFR_ASSERTD (!MPFR_IS_SINGULAR (y));
MPFR_ASSERTD (!MPFR_IS_SINGULAR (x));
MPFR_ASSERTD (!mpfr_integer_p (y));
MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_INT_SIGN (x),
MPFR_GET_EXP (x) - 1) != 0);
MPFR_ASSERTD (MPFR_IS_POS (x));
if (MPFR_IS_NEG (y))
return 0; /* x is not a power of two => x^-y is not exact */
/* compute d such that y = c*2^d with c odd integer */
mpz_init (c);
d = mpfr_get_z_2exp (c, y);
i = mpz_scan1 (c, 0);
mpz_fdiv_q_2exp (c, c, i);
d += i;
/* now y=c*2^d with c odd */
/* Since y is not an integer, d is necessarily < 0 */
MPFR_ASSERTD (d < 0);
/* Compute a,b such that x=a*2^b */
mpz_init (a);
b = mpfr_get_z_2exp (a, x);
i = mpz_scan1 (a, 0);
mpz_fdiv_q_2exp (a, a, i);
b += i;
/* now x=a*2^b with a is odd */
for (res = 1 ; d != 0 ; d++)
{
/* a*2^b is a square iff
(i) a is a square when b is even
(ii) 2*a is a square when b is odd */
if (b % 2 != 0)
{
mpz_mul_2exp (a, a, 1); /* 2*a */
b --;
}
MPFR_ASSERTD ((b % 2) == 0);
if (!mpz_perfect_square_p (a))
{
res = 0;
goto end;
}
mpz_sqrt (a, a);
b = b / 2;
}
/* Now x = (a'*2^b')^(2^-d) with d < 0
so x^y = ((a'*2^b')^(2^-d))^(c*2^d)
= ((a'*2^b')^c with c odd integer */
{
mpfr_t tmp;
mpfr_prec_t p;
MPFR_MPZ_SIZEINBASE2 (p, a);
mpfr_init2 (tmp, p); /* prec = 1 should not be possible */
res = mpfr_set_z (tmp, a, MPFR_RNDN);
MPFR_ASSERTD (res == 0);
res = mpfr_mul_2si (tmp, tmp, b, MPFR_RNDN);
MPFR_ASSERTD (res == 0);
*inexact = mpfr_pow_z (z, tmp, c, rnd_mode);
mpfr_clear (tmp);
res = 1;
}
end:
mpz_clear (a);
mpz_clear (c);
return res;
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, r;
long q[1];
if (argc == 3) /* usage: tremquo x y (rnd=MPFR_RNDN implicit) */
{
mpfr_init2 (x, GMP_NUMB_BITS);
mpfr_init2 (y, GMP_NUMB_BITS);
mpfr_init2 (r, GMP_NUMB_BITS);
mpfr_set_str (x, argv[1], 10, MPFR_RNDN);
mpfr_set_str (y, argv[2], 10, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
printf ("r=");
mpfr_out_str (stdout, 10, 0, r, MPFR_RNDN);
printf (" q=%ld\n", q[0]);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
return 0;
}
tests_start_mpfr ();
bug20090227 ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (r);
/* special values */
mpfr_set_nan (x);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (r));
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_nan (y);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_POS (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN); /* -0 */
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_NEG (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp (r, x) == 0);
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_POS (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_NEG (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
/* check four possible sign combinations */
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 8) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_si (x, -42, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -8) == 0);
MPFR_ASSERTN (q[0] == (long) -2);
mpfr_set_si (x, -42, MPFR_RNDN);
mpfr_set_si (y, -17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -8) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_si (y, -17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 8) == 0);
MPFR_ASSERTN (q[0] == (long) -2);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 50);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_nextabove (x); /* 42 + 2^(-94) */
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -94) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 100);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_nextabove (x); /* 42 + 2^(-44) */
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -44) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 50);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_nextabove (y); /* 21 + 2^(-45) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* r should be 42 - 2*(21 + 2^(-45)) = -2^(-44) */
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -44) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 100);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_nextabove (y); /* 21 + 2^(-95) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* r should be 42 - 2*(21 + 2^(-95)) = -2^(-94) */
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -94) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
/* exercise large quotient */
mpfr_set_ui_2exp (x, 1, 65, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
/* quotient is 2^65 */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, 0) == 0);
MPFR_ASSERTN (q[0] % 1073741824L == 0L);
/* another large quotient */
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_const_pi (x, MPFR_RNDN);
mpfr_mul_2exp (x, x, 63, MPFR_RNDN);
mpfr_const_log2 (y, MPFR_RNDN);
mpfr_set_prec (r, 10);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* q should be 41803643793084085130, r should be 605/2048 */
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 605, -11) == 0);
MPFR_ASSERTN ((q[0] > 0) && ((q[0] % 1073741824L) == 733836170L));
/* check cases where quotient is 1.5 +/- eps */
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_set_prec (r, 63);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5, quotient should be 2 (even rule), remainder should be -1 */
MPFR_ASSERTN (mpfr_cmp_si (r, -1) == 0);
MPFR_ASSERTN (q[0] == 2L);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_nextabove (x); /* 3 + 2^(-63) */
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5 + 2^(-64), quo should be 2, r should be -1 + 2^(-63) */
MPFR_ASSERTN (mpfr_add_ui (r, r, 1, MPFR_RNDN) == 0);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -63) == 0);
MPFR_ASSERTN (q[0] == 2L);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_nextabove (y); /* 2 + 2^(-63) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5 - eps, quo should be 1, r should be 1 - 2^(-63) */
MPFR_ASSERTN (mpfr_sub_ui (r, r, 1, MPFR_RNDN) == 0);
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -63) == 0);
MPFR_ASSERTN (q[0] == 1L);
/* bug founds by Kaveh Ghazi, 3 May 2007 */
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_set_ui (y, 3, MPFR_RNDN);
mpfr_remainder (r, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -1) == 0);
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remainder (r, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, 0) == 0 && MPFR_SIGN (r) < 0);
/* check argument reuse */
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remainder (x, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (x, 0) == 0 && MPFR_SIGN (x) < 0);
mpfr_set_ui_2exp (x, 1, mpfr_get_emax () - 1, MPFR_RNDN);
mpfr_set_ui_2exp (y, 1, mpfr_get_emin (), MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_zero_p (r) && MPFR_SIGN (r) > 0);
MPFR_ASSERTN (q[0] == 0);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
tests_end_mpfr ();
return 0;
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
long add;
mpfr_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (
("s[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (s), mpfr_log_prec, s, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, MPFR_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
return mpfr_set_si_2exp (z, -1, -1, rnd_mode);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 2^(-4), we have |zeta(s) + 1/2| <= |s|.
EXP(s) + 1 < -PREC(z) is a sufficient condition to be able to round
correctly, for any PREC(z) >= 1 (see algorithms.tex for details). */
if (MPFR_GET_EXP (s) + 1 < - (mpfr_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
MPFR_SAVE_EXPO_MARK (expo);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if (rnd_mode == MPFR_RNDA)
rnd_mode = MPFR_RNDD; /* the result is around -1/2, thus negative */
if ((rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == MPFR_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == MPFR_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == MPFR_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (MPFR_RNDZ and s > 0) or MPFR_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_GET_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* Check for case s=1 before changing the exponent range */
if (mpfr_cmp (s, __gmpfr_one) == 0)
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
MPFR_SET_DIVBY0 ();
MPFR_RET (0);
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
int overflow = 0;
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
add = compute_add (s, precz);
prec1 = precz + add;
/* FIXME: To avoid that the working precision (prec1) depends on the
input precision, one would need to take into account the error made
when s1 is not exactly 1-s when computing zeta(s1) and gamma(s1)
below, and also in the case y=Inf (i.e. when gamma(s1) overflows).
Make sure that underflows do not occur in intermediate computations.
Due to the limited precision, they are probably not possible
in practice; add some MPFR_ASSERTN's to be sure that problems
do not remain undetected? */
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_exp_t ey;
mpfr_t z_up;
mpfr_const_pi (p, MPFR_RNDD); /* p is Pi */
mpfr_sub (s1, __gmpfr_one, s, MPFR_RNDN); /* s1 = 1-s */
mpfr_gamma (y, s1, MPFR_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* zeta(s) < 0 for -4k-2 < s < -4k,
zeta(s) > 0 for -4k < s < -4k+2 */
{
/* FIXME: An overflow in gamma(s1) does not imply that
zeta(s) will overflow. A solution:
1. Compute
log(|zeta(s)|/2) = (s-1)*log(2*pi) + lngamma(1-s)
+ log(abs(sin(Pi*s/2)) * zeta(1-s))
(possibly sharing computations with the normal case)
with a rather good accuracy (see (2)).
Memorize the sign of sin(...) for the final sign.
2. Take the exponential, ~= |zeta(s)|/2. If there is an
overflow, then this means an overflow on the final result
(due to the multiplication by 2, which has not been done
yet).
3. Ziv test.
4. Correct the sign from the sign of sin(...).
5. Round then multiply by 2. Here, an overflow in either
operation means a real overflow. */
mpfr_reflection_overflow (z_pre, s1, s, y, p, MPFR_RNDD);
/* z_pre is a lower bound of |zeta(s)|/2, thus if it overflows,
or has exponent emax, then |zeta(s)| overflows too. */
if (MPFR_IS_INF (z_pre) || MPFR_GET_EXP(z_pre) == __gmpfr_emax)
{ /* determine the sign of overflow */
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
overflow = (mpfr_cmp_si_2exp (s1, -1, -1) > 0) ? -1 : 1;
break;
}
else /* EXP(z_pre) < __gmpfr_emax */
{
int ok = 0;
mpfr_t z_down;
mpfr_init2 (z_up, mpfr_get_prec (z_pre));
mpfr_reflection_overflow (z_up, s1, s, y, p, MPFR_RNDU);
/* if the lower approximation z_pre does not overflow, but
z_up does, we need more precision */
if (MPFR_IS_INF (z_up) || MPFR_GET_EXP(z_up) == __gmpfr_emax)
goto next_loop;
/* check if z_pre and z_up round to the same number */
mpfr_init2 (z_down, precz);
mpfr_set (z_down, z_pre, rnd_mode);
/* Note: it might be that EXP(z_down) = emax here, in that
case we will have overflow below when we multiply by 2 */
mpfr_prec_round (z_up, precz, rnd_mode);
ok = mpfr_cmp (z_down, z_up) == 0;
mpfr_clear (z_up);
mpfr_clear (z_down);
if (ok)
{
/* get correct sign and multiply by 2 */
mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */
if (mpfr_cmp_si_2exp (s1, -1, -1) > 0)
mpfr_neg (z_pre, z_pre, rnd_mode);
mpfr_mul_2ui (z_pre, z_pre, 1, rnd_mode);
break;
}
else
goto next_loop;
}
}
mpfr_zeta_pos (z_pre, s1, MPFR_RNDN); /* zeta(1-s) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); /* gamma(1-s)*zeta(1-s) */
/* multiply z_pre by 2^s*Pi^(s-1) where p=Pi, s1=1-s */
mpfr_mul_2ui (y, p, 1, MPFR_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, MPFR_RNDN); /* s-1 */
mpfr_pow (y, y, s1, MPFR_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, MPFR_RNDN);
/* multiply z_pre by sin(Pi*s/2) */
mpfr_mul (y, s, p, MPFR_RNDN);
mpfr_div_2ui (p, y, 1, MPFR_RNDN); /* p = s*Pi/2 */
/* FIXME: sinpi will be available, we should replace the mpfr_sin
call below by mpfr_sinpi(s/2), where s/2 will be exact.
Can mpfr_sin underflow? Moreover, the code below should be
improved so that the "if" condition becomes unlikely, e.g.
by taking a slightly larger working precision. */
mpfr_sin (y, p, MPFR_RNDN); /* y = sin(Pi*s/2) */
ey = MPFR_GET_EXP (y);
if (ey < 0) /* take account of cancellation in sin(p) */
{
mpfr_t t;
MPFR_ASSERTN (- ey < MPFR_PREC_MAX - prec1);
mpfr_init2 (t, prec1 - ey);
mpfr_const_pi (t, MPFR_RNDD);
mpfr_mul (t, s, t, MPFR_RNDN);
mpfr_div_2ui (t, t, 1, MPFR_RNDN);
mpfr_sin (y, t, MPFR_RNDN);
mpfr_clear (t);
}
mpfr_mul (z_pre, z_pre, y, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
next_loop:
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
if (overflow != 0)
{
inex = mpfr_overflow (z, rnd_mode, overflow);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
}
else
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
int
mpfr_exp2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
int inexact;
long xint;
mpfr_t xfrac;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(y), mpfr_log_prec, y,
inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
if (MPFR_IS_POS (x))
MPFR_SET_INF (y);
else
MPFR_SET_ZERO (y);
MPFR_SET_POS (y);
MPFR_RET (0);
}
else /* 2^0 = 1 */
{
MPFR_ASSERTD (MPFR_IS_ZERO(x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
/* since the smallest representable non-zero float is 1/2*2^__gmpfr_emin,
if x < __gmpfr_emin - 1, the result is either 1/2*2^__gmpfr_emin or 0 */
MPFR_ASSERTN (MPFR_EMIN_MIN >= LONG_MIN + 2);
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emin - 1) < 0))
{
mpfr_rnd_t rnd2 = rnd_mode;
/* in round to nearest mode, round to zero when x <= __gmpfr_emin-2 */
if (rnd_mode == MPFR_RNDN &&
mpfr_cmp_si_2exp (x, __gmpfr_emin - 2, 0) <= 0)
rnd2 = MPFR_RNDZ;
return mpfr_underflow (y, rnd2, 1);
}
MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax) >= 0))
return mpfr_overflow (y, rnd_mode, 1);
/* We now know that emin - 1 <= x < emax. */
MPFR_SAVE_EXPO_MARK (expo);
/* 2^x = 1 + x*log(2) + O(x^2) for x near zero, and for |x| <= 1 we have
|2^x - 1| <= x < 2^EXP(x). If x > 0 we must round away from 0 (dir=1);
if x < 0 we must round toward 0 (dir=0). */
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, - MPFR_GET_EXP (x), 0,
MPFR_IS_POS (x), rnd_mode, expo, {});
xint = mpfr_get_si (x, MPFR_RNDZ);
mpfr_init2 (xfrac, MPFR_PREC (x));
mpfr_sub_si (xfrac, x, xint, MPFR_RNDN); /* exact */
if (MPFR_IS_ZERO (xfrac))
{
mpfr_set_ui (y, 1, MPFR_RNDN);
inexact = 0;
}
else
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_exp_t err; /* error */
MPFR_ZIV_DECL (loop);
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 5 + MPFR_INT_CEIL_LOG2 (Ny);
/* initialize of intermediary variable */
mpfr_init2 (t, Nt);
/* First computation */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute exp(x*ln(2))*/
mpfr_const_log2 (t, MPFR_RNDU); /* ln(2) */
mpfr_mul (t, xfrac, t, MPFR_RNDU); /* xfrac * ln(2) */
err = Nt - (MPFR_GET_EXP (t) + 2); /* Estimate of the error */
mpfr_exp (t, t, MPFR_RNDN); /* exp(xfrac * ln(2)) */
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd_mode);
mpfr_clear (t);
}
mpfr_clear (xfrac);
MPFR_CLEAR_FLAGS ();
mpfr_mul_2si (y, y, xint, MPFR_RNDN); /* exact or overflow */
/* Note: We can have an overflow only when t was rounded up to 2. */
MPFR_ASSERTD (MPFR_IS_PURE_FP (y) || inexact > 0);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
static void
check_pow_si (void)
{
mpfr_t x;
mpfr_init (x);
mpfr_set_nan (x);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_inf (x, -1);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x));
mpfr_set_inf (x, -1);
mpfr_pow_si (x, x, -2, GMP_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
mpfr_pow_si (x, x, -2, GMP_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_si (x, 2, GMP_RNDN);
mpfr_pow_si (x, x, LONG_MAX, GMP_RNDN); /* 2^LONG_MAX */
if (LONG_MAX > mpfr_get_emax () - 1) /* LONG_MAX + 1 > emax */
{
MPFR_ASSERTN (mpfr_inf_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MAX));
}
mpfr_set_si (x, 2, GMP_RNDN);
mpfr_pow_si (x, x, LONG_MIN, GMP_RNDN); /* 2^LONG_MIN */
if (LONG_MIN + 1 < mpfr_get_emin ())
{
MPFR_ASSERTN (mpfr_zero_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MIN));
}
mpfr_set_si (x, 2, GMP_RNDN);
mpfr_pow_si (x, x, LONG_MIN + 1, GMP_RNDN); /* 2^(LONG_MIN+1) */
if (mpfr_nan_p (x))
{
printf ("Error in pow_si(2, LONG_MIN+1): got NaN\n");
exit (1);
}
if (LONG_MIN + 2 < mpfr_get_emin ())
{
MPFR_ASSERTN (mpfr_zero_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MIN + 1));
}
mpfr_set_si_2exp (x, 1, -1, GMP_RNDN); /* 0.5 */
mpfr_pow_si (x, x, LONG_MIN, GMP_RNDN); /* 2^(-LONG_MIN) */
if (LONG_MIN < 1 - mpfr_get_emax ()) /* 1 - LONG_MIN > emax */
{
MPFR_ASSERTN (mpfr_inf_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 2, - (LONG_MIN + 1)));
}
mpfr_clear (x);
}
int
mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mpfr_rnd_t rnd)
{
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg n=%ld rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x, n, rnd),
("y[%Pu]=%.*Rg", mpfr_get_prec (y), mpfr_log_prec, y));
if (n >= 0)
return mpfr_pow_ui (y, x, n, rnd);
else
{
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else
{
int positive = MPFR_IS_POS (x) || ((unsigned long) n & 1) == 0;
if (MPFR_IS_INF (x))
MPFR_SET_ZERO (y);
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_INF (y);
mpfr_set_divby0 ();
}
if (positive)
MPFR_SET_POS (y);
else
MPFR_SET_NEG (y);
MPFR_RET (0);
}
}
/* detect exact powers: x^(-n) is exact iff x is a power of 2 */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0)
{
mpfr_exp_t expx = MPFR_EXP (x) - 1, expy;
MPFR_ASSERTD (n < 0);
/* Warning: n * expx may overflow!
*
* Some systems (apparently alpha-freebsd) abort with
* LONG_MIN / 1, and LONG_MIN / -1 is undefined.
* http://www.freebsd.org/cgi/query-pr.cgi?pr=72024
*
* Proof of the overflow checking. The expressions below are
* assumed to be on the rational numbers, but the word "overflow"
* still has its own meaning in the C context. / still denotes
* the integer (truncated) division, and // denotes the exact
* division.
* - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n
* cannot overflow due to the constraints on the exponents of
* MPFR numbers.
* - If n = -1, then n * expx = - expx, which is representable
* because of the constraints on the exponents of MPFR numbers.
* - If expx = 0, then n * expx = 0, which is representable.
* - If n < -1 and expx > 0:
* + If expx > (__gmpfr_emin - 1) / n, then
* expx >= (__gmpfr_emin - 1) / n + 1
* > (__gmpfr_emin - 1) // n,
* and
* n * expx < __gmpfr_emin - 1,
* i.e.
* n * expx <= __gmpfr_emin - 2.
* This corresponds to an underflow, with a null result in
* the rounding-to-nearest mode.
* + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot
* overflow since 0 < expx <= (__gmpfr_emin - 1) / n and
* 0 > n * expx >= n * ((__gmpfr_emin - 1) / n)
* >= __gmpfr_emin - 1.
* - If n < -1 and expx < 0:
* + If expx < (__gmpfr_emax - 1) / n, then
* expx <= (__gmpfr_emax - 1) / n - 1
* < (__gmpfr_emax - 1) // n,
* and
* n * expx > __gmpfr_emax - 1,
* i.e.
* n * expx >= __gmpfr_emax.
* This corresponds to an overflow (2^(n * expx) has an
* exponent > __gmpfr_emax).
* + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot
* overflow since 0 > expx >= (__gmpfr_emax - 1) / n and
* 0 < n * expx <= n * ((__gmpfr_emax - 1) / n)
* <= __gmpfr_emax - 1.
* Note: one could use expx bounds based on MPFR_EXP_MIN and
* MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The
* current bounds do not lead to noticeably slower code and
* allow us to avoid a bug in Sun's compiler for Solaris/x86
* (when optimizations are enabled); known affected versions:
* cc: Sun C 5.8 2005/10/13
* cc: Sun C 5.8 Patch 121016-02 2006/03/31
* cc: Sun C 5.8 Patch 121016-04 2006/10/18
*/
expy =
n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ?
MPFR_EMIN_MIN - 2 /* Underflow */ :
n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ?
MPFR_EMAX_MAX /* Overflow */ : n * expx;
return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1,
expy, rnd);
}
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mpfr_prec_t Ny; /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_rnd_t rnd1;
int size_n;
int inexact;
unsigned long abs_n;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
abs_n = - (unsigned long) n;
count_leading_zeros (size_n, (mp_limb_t) abs_n);
size_n = GMP_NUMB_BITS - size_n;
/* initial working precision */
Ny = MPFR_PREC (y);
Nt = Ny + size_n + 3 + MPFR_INT_CEIL_LOG2 (Ny);
MPFR_SAVE_EXPO_MARK (expo);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
/* We will compute rnd(rnd1(1/x) ^ |n|), where rnd1 is the rounding
toward sign(x), to avoid spurious overflow or underflow, as in
mpfr_pow_z. */
rnd1 = MPFR_EXP (x) < 1 ? MPFR_RNDZ :
(MPFR_SIGN (x) > 0 ? MPFR_RNDU : MPFR_RNDD);
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute (1/x)^|n| */
MPFR_BLOCK (flags, mpfr_ui_div (t, 1, x, rnd1));
MPFR_ASSERTD (! MPFR_UNDERFLOW (flags));
/* t = (1/x)*(1+theta) where |theta| <= 2^(-Nt) */
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
goto overflow;
MPFR_BLOCK (flags, mpfr_pow_ui (t, t, abs_n, rnd));
/* t = (1/x)^|n|*(1+theta')^(|n|+1) where |theta'| <= 2^(-Nt).
If (|n|+1)*2^(-Nt) <= 1/2, which is satisfied as soon as
Nt >= bits(n)+2, then we can use Lemma \ref{lemma_graillat}
from algorithms.tex, which yields x^n*(1+theta) with
|theta| <= 2(|n|+1)*2^(-Nt), thus the error is bounded by
2(|n|+1) ulps <= 2^(bits(n)+2) ulps. */
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
overflow:
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
MPFR_LOG_MSG (("overflow\n", 0));
return mpfr_overflow (y, rnd, abs_n & 1 ?
MPFR_SIGN (x) : MPFR_SIGN_POS);
}
if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags)))
{
MPFR_ZIV_FREE (loop);
mpfr_clear (t);
MPFR_LOG_MSG (("underflow\n", 0));
if (rnd == MPFR_RNDN)
{
mpfr_t y2, nn;
/* We cannot decide now whether the result should be
rounded toward zero or away from zero. So, like
in mpfr_pow_pos_z, let's use the general case of
mpfr_pow in precision 2. */
MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_SIGN (x),
MPFR_EXP (x) - 1) != 0);
mpfr_init2 (y2, 2);
mpfr_init2 (nn, sizeof (long) * CHAR_BIT);
inexact = mpfr_set_si (nn, n, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0);
inexact = mpfr_pow_general (y2, x, nn, rnd, 1,
(mpfr_save_expo_t *) NULL);
mpfr_clear (nn);
mpfr_set (y, y2, MPFR_RNDN);
mpfr_clear (y2);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW);
goto end;
}
else
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (y, rnd, abs_n & 1 ?
MPFR_SIGN (x) : MPFR_SIGN_POS);
}
}
/* error estimate -- see pow function in algorithms.ps */
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - size_n - 2, Ny, rnd)))
break;
/* actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd);
mpfr_clear (t);
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd);
}
}
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
double sd, eps, m1, c;
long add;
mp_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("s[%#R]=%R rnd=%d", s, s, rnd_mode),
("z[%#R]=%R inexact=%d", z, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, GMP_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
mpfr_set_ui (z, 1, rnd_mode);
mpfr_div_2ui (z, z, 1, rnd_mode);
MPFR_CHANGE_SIGN (z);
MPFR_RET (0);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 0.074, we have |zeta(s) + 1/2| <= |s|.
Thus if |s| <= 1/4*ulp(1/2), we can deduce the correct rounding
(the 1/4 covers the case where |zeta(s)| < 1/2 and rounding to nearest).
A sufficient condition is that EXP(s) + 1 < -PREC(z). */
if (MPFR_EXP(s) + 1 < - (mp_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if ((rnd_mode == GMP_RNDU || rnd_mode == GMP_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == GMP_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == GMP_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == GMP_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (GMP_RNDZ and s > 0) or GMP_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
sd = mpfr_get_d (s, GMP_RNDN) - 1.0;
if (sd < 0.0)
sd = -sd; /* now sd = abs(s-1.0) */
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
/* eps = pow (2.0, - (double) precz - 14.0); */
eps = __gmpfr_ceil_exp2 (- (double) precz - 14.0);
m1 = 1.0 + MAX(1.0 / eps, 2.0 * sd) * (1.0 + eps);
c = (1.0 + eps) * (1.0 + eps * MAX(8.0, m1));
/* add = 1 + floor(log(c*c*c*(13 + m1))/log(2)); */
add = __gmpfr_ceil_log2 (c * c * c * (13.0 + m1));
prec1 = precz + add;
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_sub (s1, __gmpfr_one, s, GMP_RNDN);/* s1 = 1-s */
mpfr_zeta_pos (z_pre, s1, GMP_RNDN); /* zeta(1-s) */
mpfr_gamma (y, s1, GMP_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* Zeta(s) < 0 for -4k-2 < s < -4k,
Zeta(s) > 0 for -4k < s < -4k+2 */
{
MPFR_SET_INF (z_pre);
mpfr_div_2ui (s1, s, 2, GMP_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, GMP_RNDN); /* exact, -1 < s1 < 0 */
if (mpfr_cmp_si_2exp (s1, -1, -1) > 0)
MPFR_SET_NEG (z_pre);
else
MPFR_SET_POS (z_pre);
break;
}
mpfr_mul (z_pre, z_pre, y, GMP_RNDN); /* gamma(1-s)*zeta(1-s) */
mpfr_const_pi (p, GMP_RNDD);
mpfr_mul (y, s, p, GMP_RNDN);
mpfr_div_2ui (y, y, 1, GMP_RNDN); /* s*Pi/2 */
mpfr_sin (y, y, GMP_RNDN); /* sin(Pi*s/2) */
mpfr_mul (z_pre, z_pre, y, GMP_RNDN);
mpfr_mul_2ui (y, p, 1, GMP_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, GMP_RNDN); /* s-1 */
mpfr_pow (y, y, s1, GMP_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, GMP_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, GMP_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
/* Put in z the value of x^y, rounded according to 'rnd'.
Return the inexact flag in [0, 10]. */
int
mpc_pow (mpc_ptr z, mpc_srcptr x, mpc_srcptr y, mpc_rnd_t rnd)
{
int ret = -2, loop, x_real, y_real, z_real = 0, z_imag = 0;
mpc_t t, u;
mp_prec_t p, q, pr, pi, maxprec;
long Q;
x_real = mpfr_zero_p (MPC_IM(x));
y_real = mpfr_zero_p (MPC_IM(y));
if (y_real && mpfr_zero_p (MPC_RE(y))) /* case y zero */
{
if (x_real && mpfr_zero_p (MPC_RE(x))) /* 0^0 = NaN +i*NaN */
{
mpfr_set_nan (MPC_RE(z));
mpfr_set_nan (MPC_IM(z));
return 0;
}
else /* x^0 = 1 +/- i*0 even for x=NaN see algorithms.tex for the
sign of zero */
{
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, GMP_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (MPC_IM (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (MPC_IM (x)) != mpfr_signbit (MPC_RE (y)))
|| (cx1 > 0 && mpfr_signbit (MPC_IM (y)));
/* warning: mpc_set_ui_ui does not set Im(z) to -0 if Im(rnd)=RNDD */
ret = mpc_set_ui_ui (z, 1, 0, rnd);
if (MPC_RND_IM (rnd) == GMP_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
return ret;
}
}
if (mpfr_nan_p (MPC_RE(x)) || mpfr_nan_p (MPC_IM(x)) ||
mpfr_nan_p (MPC_RE(y)) || mpfr_nan_p (MPC_IM(y)) ||
mpfr_inf_p (MPC_RE(x)) || mpfr_inf_p (MPC_IM(x)) ||
mpfr_inf_p (MPC_RE(y)) || mpfr_inf_p (MPC_IM(y)))
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
if (x_real) /* case x real */
{
if (mpfr_zero_p (MPC_RE(x))) /* x is zero */
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
/* Special case 1^y = 1 */
if (mpfr_cmp_ui (MPC_RE(x), 1) == 0)
{
int s1, s2;
s1 = mpfr_signbit (MPC_RE (y));
s2 = mpfr_signbit (MPC_IM (x));
ret = mpc_set_ui (z, +1, rnd);
/* the sign of the zero imaginary part is known in some cases (see
algorithm.tex). In such cases we have
(x +s*0i)^(y+/-0i) = x^y + s*sign(y)*0i
where s = +/-1. We extend here this rule to fix the sign of the
zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM (rnd) == GMP_RNDD || s1 != s2)
mpc_conj (z, z, MPC_RNDNN);
goto end;
}
/* x^y is real when:
(a) x is real and y is integer
(b) x is real non-negative and y is real */
if (y_real && (mpfr_integer_p (MPC_RE(y)) ||
mpfr_cmp_ui (MPC_RE(x), 0) >= 0))
{
int s1, s2;
s1 = mpfr_signbit (MPC_RE (y));
s2 = mpfr_signbit (MPC_IM (x));
ret = mpfr_pow (MPC_RE(z), MPC_RE(x), MPC_RE(y), MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_ui (MPC_IM(z), 0, MPC_RND_IM(rnd)));
/* the sign of the zero imaginary part is known in some cases
(see algorithm.tex). In such cases we have (x +s*0i)^(y+/-0i)
= x^y + s*sign(y)*0i where s = +/-1.
We extend here this rule to fix the sign of the zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM(rnd) == GMP_RNDD || s1 != s2)
mpfr_neg (MPC_IM(z), MPC_IM(z), MPC_RND_IM(rnd));
goto end;
}
/* (-1)^(n+I*t) is real for n integer and t real */
if (mpfr_cmp_si (MPC_RE(x), -1) == 0 && mpfr_integer_p (MPC_RE(y)))
z_real = 1;
/* for x real, x^y is imaginary when:
(a) x is negative and y is half-an-integer
(b) x = -1 and Re(y) is half-an-integer
*/
if (mpfr_cmp_ui (MPC_RE(x), 0) < 0 && is_odd (MPC_RE(y), 1) &&
(y_real || mpfr_cmp_si (MPC_RE(x), -1) == 0))
z_imag = 1;
}
else /* x non real */
/* I^(t*I) and (-I)^(t*I) are real for t real,
I^(n+t*I) and (-I)^(n+t*I) are real for n even and t real, and
I^(n+t*I) and (-I)^(n+t*I) are imaginary for n odd and t real
(s*I)^n is real for n even and imaginary for n odd */
if ((mpc_cmp_si_si (x, 0, 1) == 0 || mpc_cmp_si_si (x, 0, -1) == 0 ||
(mpfr_cmp_ui (MPC_RE(x), 0) == 0 && y_real)) &&
mpfr_integer_p (MPC_RE(y)))
{ /* x is I or -I, and Re(y) is an integer */
if (is_odd (MPC_RE(y), 0))
z_imag = 1; /* Re(y) odd: z is imaginary */
else
z_real = 1; /* Re(y) even: z is real */
}
else /* (t+/-t*I)^(2n) is imaginary for n odd and real for n even */
if (mpfr_cmpabs (MPC_RE(x), MPC_IM(x)) == 0 && y_real &&
mpfr_integer_p (MPC_RE(y)) && is_odd (MPC_RE(y), 0) == 0)
{
if (is_odd (MPC_RE(y), -1)) /* y/2 is odd */
z_imag = 1;
else
z_real = 1;
}
/* first bound |Re(y log(x))|, |Im(y log(x)| < 2^q */
mpc_init2 (t, 64);
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
/* the default maximum exponent for MPFR is emax=2^30-1, thus if
t > log(2^emax) = emax*log(2), then exp(t) will overflow */
if (mpfr_cmp_ui_2exp (MPC_RE(t), 372130558, 1) > 0)
goto overflow;
/* the default minimum exponent for MPFR is emin=-2^30+1, thus the
smallest representable value is 2^(emin-1), and if
t < log(2^(emin-1)) = (emin-1)*log(2), then exp(t) will underflow */
if (mpfr_cmp_si_2exp (MPC_RE(t), -372130558, 1) < 0)
goto underflow;
q = mpfr_get_exp (MPC_RE(t)) > 0 ? mpfr_get_exp (MPC_RE(t)) : 0;
if (mpfr_get_exp (MPC_IM(t)) > (mp_exp_t) q)
q = mpfr_get_exp (MPC_IM(t));
pr = mpfr_get_prec (MPC_RE(z));
pi = mpfr_get_prec (MPC_IM(z));
p = (pr > pi) ? pr : pi;
p += 11; /* experimentally, seems to give less than 10% of failures in
Ziv's strategy */
mpc_init2 (u, p);
pr += MPC_RND_RE(rnd) == GMP_RNDN;
pi += MPC_RND_IM(rnd) == GMP_RNDN;
maxprec = MPFR_PREC(MPC_RE(z));
if (MPFR_PREC(MPC_IM(z)) > maxprec)
maxprec = MPFR_PREC(MPC_IM(z));
for (loop = 0;; loop++)
{
mp_exp_t dr, di;
if (p + q > 64) /* otherwise we reuse the initial approximation
t of y*log(x), avoiding two computations */
{
mpc_set_prec (t, p + q);
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
}
mpc_exp (u, t, MPC_RNDNN);
/* Since the error bound is global, we have to take into account the
exponent difference between the real and imaginary parts. We assume
either the real or the imaginary part of u is not zero.
*/
dr = mpfr_zero_p (MPC_RE(u)) ? mpfr_get_exp (MPC_IM(u))
: mpfr_get_exp (MPC_RE(u));
di = mpfr_zero_p (MPC_IM(u)) ? dr : mpfr_get_exp (MPC_IM(u));
if (dr > di)
{
di = dr - di;
dr = 0;
}
else
{
dr = di - dr;
di = 0;
}
/* the term -3 takes into account the factor 4 in the complex error
(see algorithms.tex) plus one due to the exponent difference: if
z = a + I*b, where the relative error on z is at most 2^(-p), and
EXP(a) = EXP(b) + k, the relative error on b is at most 2^(k-p) */
if ((z_imag || mpfr_can_round (MPC_RE(u), p - 3 - dr, GMP_RNDN, GMP_RNDZ, pr)) &&
(z_real || mpfr_can_round (MPC_IM(u), p - 3 - di, GMP_RNDN, GMP_RNDZ, pi)))
break;
/* if Re(u) is not known to be zero, assume it is a normal number, i.e.,
neither zero, Inf or NaN, otherwise we might enter an infinite loop */
MPC_ASSERT (z_imag || mpfr_number_p (MPC_RE(u)));
/* idem for Im(u) */
MPC_ASSERT (z_real || mpfr_number_p (MPC_IM(u)));
if (ret == -2) /* we did not yet call mpc_pow_exact, or it aborted
because intermediate computations had > maxprec bits */
{
/* check exact cases (see algorithms.tex) */
if (y_real)
{
maxprec *= 2;
ret = mpc_pow_exact (z, x, MPC_RE(y), rnd, maxprec);
if (ret != -1 && ret != -2)
goto exact;
}
p += dr + di + 64;
}
else
p += p / 2;
mpc_set_prec (t, p + q);
mpc_set_prec (u, p);
}
if (z_real)
{
/* When the result is real (see algorithm.tex for details),
Im(x^y) =
+ sign(imag(y))*0i, if |x| > 1
+ sign(imag(x))*sign(real(y))*0i, if |x| = 1
- sign(imag(y))*0i, if |x| < 1
*/
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, GMP_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (MPC_IM (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (MPC_IM (x)) != mpfr_signbit (MPC_RE (y)))
|| (cx1 > 0 && mpfr_signbit (MPC_IM (y)));
ret = mpfr_set (MPC_RE(z), MPC_RE(u), MPC_RND_RE(rnd));
/* warning: mpfr_set_ui does not set Im(z) to -0 if Im(rnd) = RNDD */
ret = MPC_INEX (ret, mpfr_set_ui (MPC_IM (z), 0, MPC_RND_IM (rnd)));
if (MPC_RND_IM (rnd) == GMP_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
}
else if (z_imag)
{
ret = mpfr_set (MPC_IM(z), MPC_IM(u), MPC_RND_IM(rnd));
ret = MPC_INEX(mpfr_set_ui (MPC_RE(z), 0, MPC_RND_RE(rnd)), ret);
}
else
ret = mpc_set (z, u, rnd);
exact:
mpc_clear (t);
mpc_clear (u);
end:
return ret;
underflow:
/* If we have an underflow, we know that |z| is too small to be
represented, but depending on arg(z), we should return +/-0 +/- I*0.
We assume t is the approximation of y*log(x), thus we want
exp(t) = exp(Re(t))+exp(I*Im(t)).
FIXME: this part of code is not 100% rigorous, since we don't consider
rounding errors.
*/
mpc_init2 (u, 64);
mpfr_const_pi (MPC_RE(u), GMP_RNDN);
mpfr_div_2exp (MPC_RE(u), MPC_RE(u), 1, GMP_RNDN); /* Pi/2 */
mpfr_remquo (MPC_RE(u), &Q, MPC_IM(t), MPC_RE(u), GMP_RNDN);
if (mpfr_sgn (MPC_RE(u)) < 0)
Q--; /* corresponds to positive remainder */
mpfr_set_ui (MPC_RE(z), 0, GMP_RNDN);
mpfr_set_ui (MPC_IM(z), 0, GMP_RNDN);
switch (Q & 3)
{
case 0: /* first quadrant: round to (+0 +0) */
ret = MPC_INEX(-1, -1);
break;
case 1: /* second quadrant: round to (-0 +0) */
mpfr_neg (MPC_RE(z), MPC_RE(z), GMP_RNDN);
ret = MPC_INEX(1, -1);
break;
case 2: /* third quadrant: round to (-0 -0) */
mpfr_neg (MPC_RE(z), MPC_RE(z), GMP_RNDN);
mpfr_neg (MPC_IM(z), MPC_IM(z), GMP_RNDN);
ret = MPC_INEX(1, 1);
break;
case 3: /* fourth quadrant: round to (+0 -0) */
mpfr_neg (MPC_IM(z), MPC_IM(z), GMP_RNDN);
ret = MPC_INEX(-1, 1);
break;
}
goto clear_t_and_u;
overflow:
/* If we have an overflow, we know that |z| is too large to be
represented, but depending on arg(z), we should return +/-Inf +/- I*Inf.
We assume t is the approximation of y*log(x), thus we want
exp(t) = exp(Re(t))+exp(I*Im(t)).
FIXME: this part of code is not 100% rigorous, since we don't consider
rounding errors.
*/
mpc_init2 (u, 64);
mpfr_const_pi (MPC_RE(u), GMP_RNDN);
mpfr_div_2exp (MPC_RE(u), MPC_RE(u), 1, GMP_RNDN); /* Pi/2 */
/* the quotient is rounded to the nearest integer in mpfr_remquo */
mpfr_remquo (MPC_RE(u), &Q, MPC_IM(t), MPC_RE(u), GMP_RNDN);
if (mpfr_sgn (MPC_RE(u)) < 0)
Q--; /* corresponds to positive remainder */
switch (Q & 3)
{
case 0: /* first quadrant */
mpfr_set_inf (MPC_RE(z), 1);
mpfr_set_inf (MPC_IM(z), 1);
ret = MPC_INEX(1, 1);
break;
case 1: /* second quadrant */
mpfr_set_inf (MPC_RE(z), -1);
mpfr_set_inf (MPC_IM(z), 1);
ret = MPC_INEX(-1, 1);
break;
case 2: /* third quadrant */
mpfr_set_inf (MPC_RE(z), -1);
mpfr_set_inf (MPC_IM(z), -1);
ret = MPC_INEX(-1, -1);
break;
case 3: /* fourth quadrant */
mpfr_set_inf (MPC_RE(z), 1);
mpfr_set_inf (MPC_IM(z), -1);
ret = MPC_INEX(1, -1);
break;
}
clear_t_and_u:
mpc_clear (t);
mpc_clear (u);
return ret;
}
double
mpfr_get_d (mpfr_srcptr src, mpfr_rnd_t rnd_mode)
{
double d;
int negative;
mpfr_exp_t e;
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (src)))
{
if (MPFR_IS_NAN (src))
return MPFR_DBL_NAN;
negative = MPFR_IS_NEG (src);
if (MPFR_IS_INF (src))
return negative ? MPFR_DBL_INFM : MPFR_DBL_INFP;
MPFR_ASSERTD (MPFR_IS_ZERO(src));
return negative ? DBL_NEG_ZERO : 0.0;
}
e = MPFR_GET_EXP (src);
negative = MPFR_IS_NEG (src);
if (MPFR_UNLIKELY(rnd_mode == MPFR_RNDA))
rnd_mode = negative ? MPFR_RNDD : MPFR_RNDU;
/* the smallest normalized number is 2^(-1022)=0.1e-1021, and the smallest
subnormal is 2^(-1074)=0.1e-1073 */
if (MPFR_UNLIKELY (e < -1073))
{
/* Note: Avoid using a constant expression DBL_MIN * DBL_EPSILON
as this gives 0 instead of the correct result with gcc on some
Alpha machines. */
d = negative ?
(rnd_mode == MPFR_RNDD ||
(rnd_mode == MPFR_RNDN && mpfr_cmp_si_2exp(src, -1, -1075) < 0)
? -DBL_MIN : DBL_NEG_ZERO) :
(rnd_mode == MPFR_RNDU ||
(rnd_mode == MPFR_RNDN && mpfr_cmp_si_2exp(src, 1, -1075) > 0)
? DBL_MIN : 0.0);
if (d != 0.0) /* we multiply DBL_MIN = 2^(-1022) by DBL_EPSILON = 2^(-52)
to get +-2^(-1074) */
d *= DBL_EPSILON;
}
/* the largest normalized number is 2^1024*(1-2^(-53))=0.111...111e1024 */
else if (MPFR_UNLIKELY (e > 1024))
{
d = negative ?
(rnd_mode == MPFR_RNDZ || rnd_mode == MPFR_RNDU ?
-DBL_MAX : MPFR_DBL_INFM) :
(rnd_mode == MPFR_RNDZ || rnd_mode == MPFR_RNDD ?
DBL_MAX : MPFR_DBL_INFP);
}
else
{
int nbits;
mp_size_t np, i;
mp_limb_t tp[ MPFR_LIMBS_PER_DOUBLE ];
int carry;
nbits = IEEE_DBL_MANT_DIG; /* 53 */
if (MPFR_UNLIKELY (e < -1021))
/*In the subnormal case, compute the exact number of significant bits*/
{
nbits += (1021 + e);
MPFR_ASSERTD (nbits >= 1);
}
np = MPFR_PREC2LIMBS (nbits);
MPFR_ASSERTD ( np <= MPFR_LIMBS_PER_DOUBLE );
carry = mpfr_round_raw_4 (tp, MPFR_MANT(src), MPFR_PREC(src), negative,
nbits, rnd_mode);
if (MPFR_UNLIKELY(carry))
d = 1.0;
else
{
/* The following computations are exact thanks to the previous
mpfr_round_raw. */
d = (double) tp[0] / MP_BASE_AS_DOUBLE;
for (i = 1 ; i < np ; i++)
d = (d + tp[i]) / MP_BASE_AS_DOUBLE;
/* d is the mantissa (between 1/2 and 1) of the argument rounded
to 53 bits */
}
d = mpfr_scale2 (d, e);
if (negative)
d = -d;
}
return d;
}
int
main (int argc, char *argv[])
{
unsigned int prec, yprec;
int rnd;
mpfr_t x, y, z, t;
unsigned long n;
int inex;
mpfr_exp_t emin, emax;
mpfr_flags_t flags, ex_flags;
int i;
tests_start_mpfr ();
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
if (argc >= 3) /* tzeta_ui n prec [rnd] */
{
mpfr_set_prec (x, atoi (argv[2]));
mpfr_zeta_ui (x, atoi (argv[1]),
argc > 3 ? (mpfr_rnd_t) atoi (argv[3]) : MPFR_RNDN);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("\n");
goto clear_and_exit;
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 33);
mpfr_zeta_ui (x, 3, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.100110011101110100000000001001111E1");
if (mpfr_cmp (x, y))
{
printf ("Error for zeta(3), prec=33, MPFR_RNDZ\n");
printf ("expected "); mpfr_dump (y);
printf ("got "); mpfr_dump (x);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_zeta_ui (x, 0, MPFR_RNDN);
flags = __gmpfr_flags;
MPFR_ASSERTN (inex == 0 && mpfr_cmp_si_2exp (x, -1, -1) == 0 && flags == 0);
for (i = -2; i <= 2; i += 2)
RND_LOOP (rnd)
{
int ex_inex;
set_emin (i);
set_emax (i);
mpfr_clear_flags ();
inex = mpfr_zeta_ui (x, 0, (mpfr_rnd_t) rnd);
flags = __gmpfr_flags;
if (i < 0)
{
mpfr_set_inf (y, -1);
if (rnd == MPFR_RNDU || rnd == MPFR_RNDZ)
{
mpfr_nextabove (y);
ex_inex = 1;
}
else
{
ex_inex = -1;
}
ex_flags = MPFR_FLAGS_OVERFLOW | MPFR_FLAGS_INEXACT;
}
else if (i > 0)
{
mpfr_set_zero (y, -1);
if (rnd == MPFR_RNDD || rnd == MPFR_RNDA)
{
mpfr_nextbelow (y);
ex_inex = -1;
}
else
{
ex_inex = 1;
}
ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT;
}
else
{
mpfr_set_str_binary (y, "-1e-1");
ex_inex = 0;
ex_flags = 0;
}
set_emin (emin);
set_emax (emax);
if (! (mpfr_equal_p (x, y) && MPFR_IS_NEG (x) &&
SAME_SIGN (inex, ex_inex) && flags == ex_flags))
{
printf ("Failure for zeta(0) in %s, exponent range [%d,%d]\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), i, i);
printf ("Expected ");
mpfr_dump (y);
printf (" with inex ~ %d, flags =", ex_inex);
flags_out (ex_flags);
printf ("Got ");
mpfr_dump (x);
printf (" with inex = %d, flags =", inex);
flags_out (flags);
exit (1);
}
}
mpfr_clear_divby0 ();
inex = mpfr_zeta_ui (x, 1, MPFR_RNDN);
MPFR_ASSERTN (inex == 0 && MPFR_IS_INF (x) && MPFR_IS_POS (x)
&& mpfr_divby0_p ());
for (prec = MPFR_PREC_MIN; prec <= 100; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
mpfr_set_prec (y, yprec);
for (n = 0; n < 50; n++)
RND_LOOP (rnd)
{
mpfr_zeta_ui (y, n, MPFR_RNDN);
if (mpfr_can_round (y, yprec, MPFR_RNDN, MPFR_RNDZ, prec
+ (rnd == MPFR_RNDN)))
{
mpfr_set (t, y, (mpfr_rnd_t) rnd);
for (i = 0; i <= 1; i++)
{
if (i)
{
mpfr_exp_t e;
if (MPFR_IS_SINGULAR (t))
break;
e = mpfr_get_exp (t);
set_emin (e);
set_emax (e);
}
mpfr_zeta_ui (z, n, (mpfr_rnd_t) rnd);
if (i)
{
set_emin (emin);
set_emax (emax);
}
if (mpfr_cmp (t, z))
{
printf ("results differ for n = %lu, prec = %u,"
" %s%s\n", n, prec,
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd),
i ? ", reduced exponent range" : "");
printf (" got ");
mpfr_dump (z);
printf (" expected ");
mpfr_dump (t);
printf (" approx ");
mpfr_dump (y);
exit (1);
}
}
}
}
}
clear_and_exit:
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
tests_end_mpfr ();
return 0;
}
int
main (int argc, char *argv[])
{
mpfr_t x, y;
int inex;
tests_start_mpfr ();
mpfr_init (x);
mpfr_init (y);
/* special values */
mpfr_set_nan (x);
mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (y));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS (y));
mpfr_set_inf (x, -1); /* -Inf */
mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS (y));
mpfr_set_ui (x, 0, MPFR_RNDN); /* +0 */
mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0); /* j0(+0)=1 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN); /* -0 */
mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0); /* j0(-0)=1 */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_j0 (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100001111100011111111101101111010111101110001111");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_j0 for x=1, rnd=MPFR_RNDN\n");
printf ("Expected "); mpfr_dump (x);
printf ("Got "); mpfr_dump (y);
exit (1);
}
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_j0 (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100001111100011111111101101111010111101110001111");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_j0 for x=-1, rnd=MPFR_RNDN\n");
printf ("Expected "); mpfr_dump (x);
printf ("Got "); mpfr_dump (y);
exit (1);
}
/* Bug reported on 2007-07-03 by Sisyphus (assertion failed in r4619) */
mpfr_set_si (x, 70000, MPFR_RNDN);
mpfr_j0 (y, x, MPFR_RNDN);
/* Bug reported by Kevin Rauch on 27 Oct 2007 */
mpfr_set_prec (x, 7);
mpfr_set_prec (y, 7);
mpfr_set_si (x, -100, MPFR_RNDN);
mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN (! mpfr_nan_p (y) && mpfr_cmp_ui_2exp (y, 41, -11) == 0);
/* Bug reported by Fredrik Johansson on 19 Jan 2016 */
mpfr_set_prec (x, 53);
mpfr_set_str (x, "0x4.3328p+0", 0, MPFR_RNDN);
mpfr_set_prec (y, 2);
mpfr_j0 (y, x, MPFR_RNDD);
/* y should be -0.5 */
MPFR_ASSERTN (! mpfr_nan_p (y) && mpfr_cmp_si_2exp (y, -1, -1) == 0);
mpfr_set_prec (y, 3);
mpfr_j0 (y, x, MPFR_RNDD);
/* y should be -0.4375 */
MPFR_ASSERTN (! mpfr_nan_p (y) && mpfr_cmp_si_2exp (y, -7, -4) == 0);
/* Case for which s = 0 in mpfr_jn */
mpfr_set_prec (x, 44);
mpfr_set_prec (y, 44);
mpfr_set_si (x, 2, MPFR_RNDN);
mpfr_clear_flags ();
inex = mpfr_j0 (y, x, MPFR_RNDN);
MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_INEXACT);
mpfr_set_str (x, "0x.e5439fd9267p-2", 0, MPFR_RNDN);
if (! mpfr_equal_p (y, x))
{
printf ("Error on 2:\n");
printf ("Expected ");
mpfr_dump (x);
printf ("Got ");
mpfr_dump (y);
exit (1);
}
if (inex >= 0)
{
printf ("Bad ternary value on 2: expected negative, got %d\n", inex);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
test_generic (2, 100, 10);
data_check ("data/j0", mpfr_j0, "mpfr_j0");
tests_end_mpfr ();
return 0;
}
int
mpfr_cmp_si (mpfr_srcptr b, long int i)
{
return mpfr_cmp_si_2exp (b, i, 0);
}
