/* compute in s an approximation of S1 = sum((n-k)!/k!*y^k,k=0..n)
return e >= 0 the exponent difference between the maximal value of |s|
during the for loop and the final value of |s|.
*/
static mp_exp_t
mpfr_yn_s1 (mpfr_ptr s, mpfr_srcptr y, unsigned long n)
{
unsigned long k;
mpz_t f;
mp_exp_t e, emax;
mpz_init_set_ui (f, 1);
/* we compute n!*S1 = sum(a[k]*y^k,k=0..n) where a[k] = n!*(n-k)!/k!,
a[0] = (n!)^2, a[1] = n!*(n-1)!, ..., a[n-1] = n, a[n] = 1 */
mpfr_set_ui (s, 1, GMP_RNDN); /* a[n] */
emax = MPFR_EXP(s);
for (k = n; k-- > 0;)
{
/* a[k]/a[k+1] = (n-k)!/k!/(n-(k+1))!*(k+1)! = (k+1)*(n-k) */
mpfr_mul (s, s, y, GMP_RNDN);
mpz_mul_ui (f, f, n - k);
mpz_mul_ui (f, f, k + 1);
/* invariant: f = a[k] */
mpfr_add_z (s, s, f, GMP_RNDN);
e = MPFR_EXP(s);
if (e > emax)
emax = e;
}
/* now we have f = (n!)^2 */
mpz_sqrt (f, f);
mpfr_div_z (s, s, f, GMP_RNDN);
mpz_clear (f);
return emax - MPFR_EXP(s);
}
/* sets x to x+sign(x)*ulp(x) */
int
mpfr_add_one_ulp (mpfr_ptr x, mp_rnd_t rnd_mode)
{
mp_size_t xn;
int sh;
mp_limb_t *xp;
if (MPFR_IS_NAN(x))
MPFR_RET_NAN;
if (MPFR_IS_INF(x) || MPFR_IS_ZERO(x))
return 0;
xn = 1 + (MPFR_PREC(x) - 1) / BITS_PER_MP_LIMB;
sh = xn * BITS_PER_MP_LIMB - MPFR_PREC(x);
xp = MPFR_MANT(x);
if (mpn_add_1 (xp, xp, xn, MP_LIMB_T_ONE << sh)) /* got 1.0000... */
{
mp_exp_t exp = MPFR_EXP(x);
if (exp == __mpfr_emax)
return mpfr_set_overflow(x, rnd_mode, MPFR_SIGN(x));
else
{
MPFR_EXP(x)++;
xp[xn-1] = GMP_LIMB_HIGHBIT;
}
}
return 0;
}
/* try asymptotic expansion when x is large and negative:
Li2(x) = -log(-x)^2/2 - Pi^2/6 - 1/x + O(1/x^2).
More precisely for x <= -2 we have for g(x) = -log(-x)^2/2 - Pi^2/6:
|Li2(x) - g(x)| <= 1/|x|.
Assumes x <= -7, which ensures |log(-x)^2/2| >= Pi^2/6, and g(x) <= -3.5.
Return 0 if asymptotic expansion failed (unable to round), otherwise
returns correct ternary value.
*/
static int
mpfr_li2_asympt_neg (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t g, h;
mp_prec_t w = MPFR_PREC (y) + 20;
int inex = 0;
MPFR_ASSERTN (mpfr_cmp_si (x, -7) <= 0);
mpfr_init2 (g, w);
mpfr_init2 (h, w);
mpfr_neg (g, x, GMP_RNDN);
mpfr_log (g, g, GMP_RNDN); /* rel. error <= |(1 + theta) - 1| */
mpfr_sqr (g, g, GMP_RNDN); /* rel. error <= |(1 + theta)^3 - 1| <= 2^(2-w) */
mpfr_div_2ui (g, g, 1, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_const_pi (h, GMP_RNDN); /* error <= 2^(1-w) */
mpfr_sqr (h, h, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_div_ui (h, h, 6, GMP_RNDN); /* rel. error <= |(1 + theta)^4 - 1|
<= 5 * 2^(-w) */
MPFR_ASSERTN (MPFR_EXP (g) >= MPFR_EXP (h));
mpfr_add (g, g, h, GMP_RNDN); /* err <= ulp(g)/2 + g*2^(2-w) + g*5*2^(-w)
<= ulp(g) * (1/2 + 4 + 5) < 10 ulp(g).
If in addition |1/x| <= 4 ulp(g), then the
total error is bounded by 16 ulp(g). */
if ((MPFR_EXP (x) >= (mp_exp_t) (w - 2) - MPFR_EXP (g)) &&
MPFR_CAN_ROUND (g, w - 4, MPFR_PREC (y), rnd_mode))
inex = mpfr_neg (y, g, rnd_mode);
mpfr_clear (g);
mpfr_clear (h);
return inex;
}
/* 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;
}
int
mpfr_const_euler_internal (mpfr_t x, mpfr_rnd_t rnd)
{
mpfr_prec_t prec = MPFR_PREC(x), m, log2m;
mpfr_t y, z;
unsigned long n;
int inexact;
MPFR_ZIV_DECL (loop);
log2m = MPFR_INT_CEIL_LOG2 (prec);
m = prec + 2 * log2m + 23;
mpfr_init2 (y, m);
mpfr_init2 (z, m);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
mpfr_exp_t exp_S, err;
/* since prec >= 1, we have m >= 24 here, which ensures n >= 9 below */
n = 1 + (unsigned long) ((double) m * LOG2 / 2.0);
MPFR_ASSERTD (n >= 9);
mpfr_const_euler_S2 (y, n); /* error <= 3 ulps */
exp_S = MPFR_EXP(y);
mpfr_set_ui (z, n, MPFR_RNDN);
mpfr_log (z, z, MPFR_RNDD); /* error <= 1 ulp */
mpfr_sub (y, y, z, MPFR_RNDN); /* S'(n) - log(n) */
/* the error is less than 1/2 + 3*2^(exp_S-EXP(y)) + 2^(EXP(z)-EXP(y))
<= 1/2 + 2^(exp_S+2-EXP(y)) + 2^(EXP(z)-EXP(y))
<= 1/2 + 2^(1+MAX(exp_S+2,EXP(z))-EXP(y)) */
err = 1 + MAX(exp_S + 2, MPFR_EXP(z)) - MPFR_EXP(y);
err = (err >= -1) ? err + 1 : 0; /* error <= 2^err ulp(y) */
exp_S = MPFR_EXP(y);
mpfr_const_euler_R (z, n); /* err <= ulp(1/2) = 2^(-m) */
mpfr_sub (y, y, z, MPFR_RNDN);
/* err <= 1/2 ulp(y) + 2^(-m) + 2^(err + exp_S - EXP(y)) ulp(y).
Since the result is between 0.5 and 1, ulp(y) = 2^(-m).
So we get 3/2*ulp(y) + 2^(err + exp_S - EXP(y)) ulp(y).
3/2 + 2^e <= 2^(e+1) for e>=1, and <= 2^2 otherwise */
err = err + exp_S - MPFR_EXP(y);
err = (err >= 1) ? err + 1 : 2;
if (MPFR_LIKELY (MPFR_CAN_ROUND (y, m - err, prec, rnd)))
break;
MPFR_ZIV_NEXT (loop, m);
mpfr_set_prec (y, m);
mpfr_set_prec (z, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (x, y, rnd);
mpfr_clear (y);
mpfr_clear (z);
return inexact; /* always inexact */
}
int
mpfr_set_si (mpfr_ptr x, long i, mp_rnd_t rnd_mode)
{
int inex;
mp_size_t xn;
unsigned int cnt, nbits;
mp_limb_t ai, *xp;
MPFR_CLEAR_FLAGS(x);
if (i == 0)
{
MPFR_SET_ZERO(x);
MPFR_SET_POS(x);
MPFR_RET(0);
}
xn = (MPFR_PREC(x)-1)/BITS_PER_MP_LIMB;
ai = SAFE_ABS(long, i);
count_leading_zeros(cnt, ai);
xp = MPFR_MANT(x);
xp[xn] = ai << cnt;
/* don't forget to put zero in lower limbs */
MPN_ZERO(xp, xn);
/* set sign */
if ((i < 0) ^ (MPFR_SIGN(x) < 0))
MPFR_CHANGE_SIGN(x);
MPFR_EXP(x) = nbits = BITS_PER_MP_LIMB - cnt;
inex = mpfr_check_range(x, rnd_mode);
if (inex)
return inex; /* underflow or overflow */
/* round if MPFR_PREC(x) smaller than length of i */
if (MPFR_PREC(x) < nbits)
{
int carry;
carry = mpfr_round_raw(xp+xn, xp+xn, nbits, (i < 0), MPFR_PREC(x),
rnd_mode, &inex);
if (carry)
{
mp_exp_t exp = MPFR_EXP(x);
if (exp == __mpfr_emax)
return mpfr_set_overflow(x, rnd_mode, (i < 0 ? -1 : 1));
MPFR_EXP(x)++;
xp[xn] = GMP_LIMB_HIGHBIT;
}
}
MPFR_RET(inex);
}
/*
* Check if x is a valid mpfr_t initializes by mpfr_init
* Returns 0 if isn't valid
*/
int
mpfr_check (mpfr_srcptr x)
{
mp_size_t s, i;
mp_limb_t tmp;
volatile mp_limb_t *xm;
mpfr_prec_t prec;
int rw;
/* Check sign */
if (MPFR_SIGN(x) != MPFR_SIGN_POS &&
MPFR_SIGN(x) != MPFR_SIGN_NEG)
return 0;
/* Check precision */
prec = MPFR_PREC(x);
if (prec < MPFR_PREC_MIN ||
prec > MPFR_PREC_MAX)
return 0;
/* Check mantissa */
xm = MPFR_MANT(x);
if (xm == NULL)
return 0;
/* Check size of mantissa */
s = MPFR_GET_ALLOC_SIZE(x);
if (s <= 0 || s > MP_SIZE_T_MAX ||
prec > (mpfr_prec_t) s * GMP_NUMB_BITS)
return 0;
/* Acces all the mp_limb of the mantissa: may do a seg fault */
for (i = 0 ; i < s ; i++)
tmp = xm[i];
/* Check singular numbers (do not use MPFR_IS_PURE_FP() in order to avoid
any assertion checking, as this function mpfr_check() does something
similar by returning a Boolean instead of doing an abort if the format
is incorrect). */
if (MPFR_IS_SINGULAR (x))
return MPFR_IS_ZERO(x) || MPFR_IS_NAN(x) || MPFR_IS_INF(x);
/* Check the most significant limb (its MSB must be 1) */
if ((xm[MPFR_LAST_LIMB(x)] & MPFR_LIMB_HIGHBIT) == 0)
return 0;
/* Check the least significant limb (the trailing bits must be 0) */
rw = prec % GMP_NUMB_BITS;
if (rw != 0)
{
tmp = MPFR_LIMB_MASK (GMP_NUMB_BITS - rw);
if ((xm[0] & tmp) != 0)
return 0;
}
/* Check exponent range */
if (MPFR_EXP (x) < __gmpfr_emin ||
MPFR_EXP (x) > __gmpfr_emax)
return 0;
return 1;
}
/* 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;
}
int
mpfr_set_underflow (mpfr_ptr x, mp_rnd_t rnd_mode, int sign)
{
int inex;
MPFR_CLEAR_FLAGS(x);
if ((rnd_mode == GMP_RNDU && sign > 0)
|| (rnd_mode == GMP_RNDD && sign < 0))
{
mp_size_t xn;
mp_limb_t *xp;
MPFR_EXP(x) = __mpfr_emin;
xn = (MPFR_PREC(x)-1)/BITS_PER_MP_LIMB;
xp = MPFR_MANT(x);
xp[xn] = GMP_LIMB_HIGHBIT;
MPN_ZERO(xp, xn);
inex = 1;
}
else
{
MPFR_SET_ZERO(x);
inex = -1;
}
if (MPFR_SIGN(x) != sign)
MPFR_CHANGE_SIGN(x);
__mpfr_flags |= MPFR_FLAGS_INEXACT | MPFR_FLAGS_UNDERFLOW;
return sign > 0 ? inex : -inex;
}
void
mpfr_custom_init_set (mpfr_ptr x, int kind, mp_exp_t exp,
mp_prec_t prec, void *mantissa)
{
mpfr_kind_t t;
int s;
mp_exp_t e;
if (kind >= 0)
{
t = (mpfr_kind_t) kind;
s = MPFR_SIGN_POS;
}
else
{
t = (mpfr_kind_t) -kind;
s = MPFR_SIGN_NEG;
}
MPFR_ASSERTD (t <= MPFR_REGULAR_KIND);
e = MPFR_LIKELY (t == MPFR_REGULAR_KIND) ? exp :
MPFR_UNLIKELY (t == MPFR_NAN_KIND) ? MPFR_EXP_NAN :
MPFR_UNLIKELY (t == MPFR_INF_KIND) ? MPFR_EXP_INF : MPFR_EXP_ZERO;
MPFR_PREC (x) = prec;
MPFR_SET_SIGN (x, s);
MPFR_EXP (x) = e;
MPFR_MANT (x) = (mp_limb_t*) mantissa;
return;
}
void
mpfr_random2 (mpfr_ptr x, mp_size_t size, mp_exp_t exp)
{
mp_size_t xn;
unsigned long cnt;
mp_ptr xp = MPFR_MANT(x), yp[1];
mp_size_t prec = (MPFR_PREC(x) - 1)/BITS_PER_MP_LIMB;
MPFR_CLEAR_FLAGS(x);
xn = ABS (size);
if (xn != 0)
{
if (xn > prec + 1)
xn = prec + 1;
mpn_random2 (xp, xn);
}
if (exp != 0) {
/* use mpn_random instead of random since that function is not
available on all platforms (for example HPUX, DEC OSF, ...) */
mpn_random ((mp_limb_t*) yp, 1);
exp = (mp_exp_t) yp[0] % (2 * exp) - exp;
}
count_leading_zeros(cnt, xp[xn - 1]);
if (cnt) mpn_lshift(xp, xp, xn, cnt);
MPFR_EXP(x) = exp-cnt;
cnt = xn*BITS_PER_MP_LIMB - prec;
/* cnt is the number of non significant bits in the low limb */
xp[0] &= ~((MP_LIMB_T_ONE << cnt) - MP_LIMB_T_ONE);
}
int
mpfr_check_range (mpfr_ptr x, int t, mp_rnd_t rnd_mode)
{
if (MPFR_LIKELY( MPFR_IS_PURE_FP(x)) )
{ /* x is a non-zero FP */
mp_exp_t exp = MPFR_EXP (x); /* Do not use MPFR_GET_EXP */
if (MPFR_UNLIKELY( exp < __gmpfr_emin) )
{
/* The following test is necessary because in the rounding to the
* nearest mode, mpfr_underflow always rounds away from 0. In
* this rounding mode, we need to round to 0 if:
* _ |x| < 2^(emin-2), or
* _ |x| = 2^(emin-2) and the absolute value of the exact
* result is <= 2^(emin-2).
*/
if (rnd_mode == GMP_RNDN &&
(exp + 1 < __gmpfr_emin ||
(mpfr_powerof2_raw(x) &&
(MPFR_IS_NEG(x) ? t <= 0 : t >= 0))))
rnd_mode = GMP_RNDZ;
return mpfr_underflow(x, rnd_mode, MPFR_SIGN(x));
}
if (MPFR_UNLIKELY( exp > __gmpfr_emax) )
return mpfr_overflow(x, rnd_mode, MPFR_SIGN(x));
}
MPFR_RET (t); /* propagate inexact ternary value, unlike most functions */
}
int
mpfr_set_overflow (mpfr_ptr x, mp_rnd_t rnd_mode, int sign)
{
int inex;
MPFR_CLEAR_FLAGS(x);
if ((rnd_mode == GMP_RNDU && sign < 0)
|| (rnd_mode == GMP_RNDD && sign > 0))
{
mp_size_t xn, i;
int sh;
mp_limb_t *xp;
MPFR_EXP(x) = __mpfr_emax;
xn = 1 + (MPFR_PREC(x) - 1) / BITS_PER_MP_LIMB;
sh = xn * BITS_PER_MP_LIMB - MPFR_PREC(x);
xp = MPFR_MANT(x);
xp[0] = MP_LIMB_T_MAX << sh;
for (i = 1; i < xn; i++)
xp[i] = MP_LIMB_T_MAX;
inex = -1;
}
else
{
MPFR_SET_INF(x);
inex = 1;
}
if (MPFR_SIGN(x) != sign)
MPFR_CHANGE_SIGN(x);
__mpfr_flags |= MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
return sign > 0 ? inex : -inex;
}
int
mpfr_add_ui (mpfr_ptr y, mpfr_srcptr x, unsigned long int u, mp_rnd_t rnd_mode)
{
if (u) /* if u=0, do nothing */
{
mpfr_t uu;
mp_limb_t up[1];
unsigned long cnt;
int inex;
MPFR_INIT1(up, uu, BITS_PER_MP_LIMB, 1);
count_leading_zeros(cnt, (mp_limb_t) u);
*up = (mp_limb_t) u << cnt;
MPFR_EXP(uu) = BITS_PER_MP_LIMB - cnt;
/* Optimization note: Exponent operations may be removed
if mpfr_add works even when uu is out-of-range. */
mpfr_save_emin_emax();
inex = mpfr_add(y, x, uu, rnd_mode);
MPFR_RESTORE_RET(inex, y, rnd_mode);
}
else
return mpfr_set (y, x, rnd_mode);
}
int
mpfr_check_range (mpfr_ptr x, int t, mpfr_rnd_t rnd_mode)
{
if (MPFR_LIKELY( MPFR_IS_PURE_FP(x)) )
{ /* x is a non-zero FP */
mpfr_exp_t exp = MPFR_EXP (x); /* Do not use MPFR_GET_EXP */
/* Even if it is unlikely that exp is lower than emin,
this function is called by MPFR functions only if it is
already the case (or if exp is greater than emax) */
if (exp < __gmpfr_emin)
{
/* The following test is necessary because in the rounding to the
* nearest mode, mpfr_underflow always rounds away from 0. In
* this rounding mode, we need to round to 0 if:
* _ |x| < 2^(emin-2), or
* _ |x| = 2^(emin-2) and the absolute value of the exact
* result is <= 2^(emin-2).
*/
if (rnd_mode == MPFR_RNDN &&
(exp + 1 < __gmpfr_emin ||
(mpfr_powerof2_raw(x) &&
(MPFR_IS_NEG(x) ? t <= 0 : t >= 0))))
rnd_mode = MPFR_RNDZ;
return mpfr_underflow(x, rnd_mode, MPFR_SIGN(x));
}
if (exp > __gmpfr_emax)
return mpfr_overflow (x, rnd_mode, MPFR_SIGN(x));
}
else if (MPFR_UNLIKELY (t != 0 && MPFR_IS_INF (x)))
{
/* We need to do the following because most MPFR functions are
* implemented in the following way:
* Ziv's loop:
* | Compute an approximation to the result and an error bound.
* | Possible underflow/overflow detection -> return.
* | If can_round, break (exit the loop).
* | Otherwise, increase the working precision and loop.
* Round the approximation in the target precision. <== See below
* Restore the flags (that could have been set due to underflows
* or overflows during the internal computations).
* Execute: return mpfr_check_range (...).
* The problem is that an overflow could be generated when rounding the
* approximation (in general, such an overflow could not be detected
* earlier), and the overflow flag is lost when the flags are restored.
* This can occur only when the rounding yields an exponent change
* and the new exponent is larger than the maximum exponent, so that
* an infinity is necessarily obtained.
* So, the simplest solution is to detect this overflow case here in
* mpfr_check_range, which is easy to do since the rounded result is
* necessarily an inexact infinity.
*/
__gmpfr_flags |= MPFR_FLAGS_OVERFLOW;
}
MPFR_RET (t); /* propagate inexact ternary value, unlike most functions */
}
static void
check_set_uj (mpfr_prec_t pmin, mpfr_prec_t pmax, int N)
{
mpfr_t x, y;
mpfr_prec_t p;
int inex1, inex2, n;
mp_limb_t limb;
mpfr_inits2 (pmax, x, y, (mpfr_ptr) 0);
for ( p = pmin ; p < pmax ; p++)
{
mpfr_set_prec (x, p);
mpfr_set_prec (y, p);
for (n = 0 ; n < N ; n++)
{
/* mp_limb_t may be unsigned long long */
limb = (unsigned long) randlimb ();
inex1 = mpfr_set_uj (x, limb, MPFR_RNDN);
inex2 = mpfr_set_ui (y, limb, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("ERROR for mpfr_set_uj and j=%lu and p=%lu\n",
(unsigned long) limb, (unsigned long) p);
printf ("X=");
mpfr_dump (x);
printf ("Y=");
mpfr_dump (y);
exit (1);
}
if (inexact_sign (inex1) != inexact_sign (inex2))
{
printf ("ERROR for inexact(set_uj): j=%lu p=%lu\n"
"Inexact1= %d Inexact2= %d\n",
(unsigned long) limb, (unsigned long) p, inex1, inex2);
exit (1);
}
}
}
/* Special case */
mpfr_set_prec (x, sizeof(uintmax_t)*CHAR_BIT);
inex1 = mpfr_set_uj (x, MPFR_UINTMAX_MAX, MPFR_RNDN);
if (inex1 != 0 || mpfr_sgn(x) <= 0)
ERROR ("inexact / UINTMAX_MAX");
inex1 = mpfr_add_ui (x, x, 1, MPFR_RNDN);
if (inex1 != 0 || !mpfr_powerof2_raw (x)
|| MPFR_EXP (x) != (sizeof(uintmax_t)*CHAR_BIT+1) )
ERROR ("power of 2");
mpfr_set_uj (x, 0, MPFR_RNDN);
if (!MPFR_IS_ZERO (x))
ERROR ("Setting 0");
mpfr_clears (x, y, (mpfr_ptr) 0);
}
int
mpfr_set_exp (mpfr_ptr x, mpfr_exp_t exponent)
{
if (exponent >= __gmpfr_emin && exponent <= __gmpfr_emax)
{
MPFR_EXP(x) = exponent; /* do not use MPFR_SET_EXP of course... */
return 0;
}
else
{
return 1;
}
}
int
mpfr_div_2si (mpfr_ptr y, mpfr_srcptr x, long int n, mp_rnd_t rnd_mode)
{
int inexact;
inexact = y != x ? mpfr_set (y, x, rnd_mode) : 0;
if (MPFR_IS_FP(y) && MPFR_NOTZERO(y))
{
if (n > 0 && (__mpfr_emin > MPFR_EMAX_MAX - n ||
MPFR_EXP(y) < __mpfr_emin + n))
return mpfr_set_underflow (y, rnd_mode, MPFR_SIGN(y));
if (n < 0 && (__mpfr_emax < MPFR_EMIN_MIN - n ||
MPFR_EXP(y) > __mpfr_emax + n))
return mpfr_set_overflow (y, rnd_mode, MPFR_SIGN(y));
MPFR_EXP(y) -= n;
}
return inexact;
}
int
mpfr_check_range (mpfr_ptr x, mp_rnd_t rnd_mode)
{
if (MPFR_IS_FP(x) && MPFR_NOTZERO(x))
{ /* x is a non-zero FP */
mp_exp_t exp = MPFR_EXP(x);
if (exp < __mpfr_emin)
return mpfr_set_underflow(x, rnd_mode, MPFR_SIGN(x));
if (exp > __mpfr_emax)
return mpfr_set_overflow(x, rnd_mode, MPFR_SIGN(x));
}
return 0;
}
/* We can't use fits_u.h <= mpfr_cmp_ui */
int
mpfr_fits_uintmax_p (mpfr_srcptr f, mp_rnd_t rnd)
{
mp_exp_t exp;
mp_prec_t prec;
uintmax_t s;
mpfr_t x, y;
int res;
if (MPFR_IS_NAN(f) || MPFR_IS_INF(f) || MPFR_SIGN(f) < 0)
return 0; /* does not fit */
if (MPFR_IS_ZERO(f))
return 1; /* zero always fits */
/* now it fits if
(a) f <= MAXIMUM
(b) round(f, prec(slong), rnd) <= MAXIMUM */
exp = MPFR_EXP(f);
if (exp < 1)
return 1; /* |f| < 1: always fits */
/* first compute prec(MAXIMUM) */
for (s = UINTMAX_MAX, prec = 0; s != 0; s /= 2, prec ++);
/* MAXIMUM needs prec bits, i.e. 2^(prec-1) <= |MAXIMUM| < 2^prec */
/* if exp < prec - 1, then f < 2^(prec-1) < |MAXIMUM| */
if ((mpfr_prec_t) exp < prec - 1)
return 1;
/* if exp > prec + 1, then f >= 2^prec > MAXIMUM */
if ((mpfr_prec_t) exp > prec + 1)
return 0;
/* remains cases exp = prec-1 to prec+1 */
/* hard case: first round to prec bits, then check */
mpfr_init2 (x, prec);
mpfr_init2 (y, prec);
mpfr_set (x, f, rnd);
res = mpfr_set_uj (y, UINTMAX_MAX, GMP_RNDN);
MPFR_ASSERTD (res == 0);
res = mpfr_cmp (x, y) <= 0;
mpfr_clear (y);
mpfr_clear (x);
return res;
}
/* try asymptotic expansion when x is large and positive:
Li2(x) = -log(x)^2/2 + Pi^2/3 - 1/x + O(1/x^2).
More precisely for x >= 2 we have for g(x) = -log(x)^2/2 + Pi^2/3:
-2 <= x * (Li2(x) - g(x)) <= -1
thus |Li2(x) - g(x)| <= 2/x.
Assumes x >= 38, which ensures log(x)^2/2 >= 2*Pi^2/3, and g(x) <= -3.3.
Return 0 if asymptotic expansion failed (unable to round), otherwise
returns correct ternary value.
*/
static int
mpfr_li2_asympt_pos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t g, h;
mp_prec_t w = MPFR_PREC (y) + 20;
int inex = 0;
MPFR_ASSERTN (mpfr_cmp_ui (x, 38) >= 0);
mpfr_init2 (g, w);
mpfr_init2 (h, w);
mpfr_log (g, x, GMP_RNDN); /* rel. error <= |(1 + theta) - 1| */
mpfr_sqr (g, g, GMP_RNDN); /* rel. error <= |(1 + theta)^3 - 1| <= 2^(2-w) */
mpfr_div_2ui (g, g, 1, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_const_pi (h, GMP_RNDN); /* error <= 2^(1-w) */
mpfr_sqr (h, h, GMP_RNDN); /* rel. error <= 2^(2-w) */
mpfr_div_ui (h, h, 3, GMP_RNDN); /* rel. error <= |(1 + theta)^4 - 1|
<= 5 * 2^(-w) */
/* since x is chosen such that log(x)^2/2 >= 2 * (Pi^2/3), we should have
g >= 2*h, thus |g-h| >= |h|, and the relative error on g is at most
multiplied by 2 in the difference, and that by h is unchanged. */
MPFR_ASSERTN (MPFR_EXP (g) > MPFR_EXP (h));
mpfr_sub (g, h, g, GMP_RNDN); /* err <= ulp(g)/2 + g*2^(3-w) + g*5*2^(-w)
<= ulp(g) * (1/2 + 8 + 5) < 14 ulp(g).
If in addition 2/x <= 2 ulp(g), i.e.,
1/x <= ulp(g), then the total error is
bounded by 16 ulp(g). */
if ((MPFR_EXP (x) >= (mp_exp_t) w - MPFR_EXP (g)) &&
MPFR_CAN_ROUND (g, w - 4, MPFR_PREC (y), rnd_mode))
inex = mpfr_set (y, g, rnd_mode);
mpfr_clear (g);
mpfr_clear (h);
return inex;
}
static void
check_set_sj_2exp (void)
{
mpfr_t x;
int inex;
mpfr_init2 (x, sizeof(intmax_t)*CHAR_BIT-1);
inex = mpfr_set_sj_2exp (x, MPFR_INTMAX_MIN, 1000, MPFR_RNDN);
if (inex || mpfr_sgn (x) >=0 || !mpfr_powerof2_raw (x)
|| MPFR_EXP (x) != (sizeof(intmax_t)*CHAR_BIT+1000) )
ERROR("set_sj_2exp (INTMAX_MIN)");
mpfr_clear (x);
}
int
mpfr_set_si_2exp (mpfr_ptr x, long i, mp_exp_t e, mp_rnd_t rnd_mode)
{
if (i == 0)
{
MPFR_SET_ZERO (x);
MPFR_SET_POS (x);
MPFR_RET (0);
}
else
{
mp_size_t xn;
unsigned int cnt, nbits;
mp_limb_t ai, *xp;
int inex = 0;
/* FIXME: support int limbs (e.g. 16-bit limbs on 16-bit proc) */
ai = SAFE_ABS (unsigned long, i);
MPFR_ASSERTN (SAFE_ABS (unsigned long, i) == ai);
/* Position of the highest limb */
xn = (MPFR_PREC (x) - 1) / BITS_PER_MP_LIMB;
count_leading_zeros (cnt, ai);
MPFR_ASSERTD (cnt < BITS_PER_MP_LIMB); /* OK since i != 0 */
xp = MPFR_MANT(x);
xp[xn] = ai << cnt;
/* Zero the xn lower limbs. */
MPN_ZERO(xp, xn);
MPFR_SET_SIGN (x, i < 0 ? MPFR_SIGN_NEG : MPFR_SIGN_POS);
nbits = BITS_PER_MP_LIMB - cnt;
e += nbits; /* exponent _before_ the rounding */
/* round if MPFR_PREC(x) smaller than length of i */
if (MPFR_UNLIKELY (MPFR_PREC (x) < nbits) &&
MPFR_UNLIKELY (mpfr_round_raw (xp + xn, xp + xn, nbits, i < 0,
MPFR_PREC (x), rnd_mode, &inex)))
{
e++;
xp[xn] = MPFR_LIMB_HIGHBIT;
}
MPFR_CLEAR_FLAGS (x);
MPFR_EXP (x) = e;
return mpfr_check_range (x, inex, rnd_mode);
}
}
int
mpfr_set_ui_2exp (mpfr_ptr x, unsigned long i, mpfr_exp_t e, mpfr_rnd_t rnd_mode)
{
MPFR_SET_POS (x);
if (i == 0)
{
MPFR_SET_ZERO (x);
MPFR_RET (0);
}
else
{
mp_size_t xn;
unsigned int cnt, nbits;
mp_limb_t *xp;
int inex = 0;
/* FIXME: support int limbs (e.g. 16-bit limbs on 16-bit proc) */
MPFR_ASSERTD (i == (mp_limb_t) i);
/* Position of the highest limb */
xn = (MPFR_PREC (x) - 1) / GMP_NUMB_BITS;
count_leading_zeros (cnt, (mp_limb_t) i);
MPFR_ASSERTD (cnt < GMP_NUMB_BITS); /* OK since i != 0 */
xp = MPFR_MANT(x);
xp[xn] = ((mp_limb_t) i) << cnt;
/* Zero the xn lower limbs. */
MPN_ZERO(xp, xn);
nbits = GMP_NUMB_BITS - cnt;
e += nbits; /* exponent _before_ the rounding */
/* round if MPFR_PREC(x) smaller than length of i */
if (MPFR_UNLIKELY (MPFR_PREC (x) < nbits) &&
MPFR_UNLIKELY (mpfr_round_raw (xp + xn, xp + xn, nbits, 0,
MPFR_PREC (x), rnd_mode, &inex)))
{
e++;
xp[xn] = MPFR_LIMB_HIGHBIT;
}
MPFR_EXP (x) = e;
return mpfr_check_range (x, inex, rnd_mode);
}
}
void
mpfr_urandomb (mpfr_ptr rop, gmp_randstate_t rstate)
{
mp_ptr rp;
mp_size_t nlimbs;
mp_exp_t exp;
unsigned long cnt, nbits;
MPFR_CLEAR_FLAGS(rop);
rp = MPFR_MANT(rop);
nbits = MPFR_PREC(rop);
nlimbs = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
_gmp_rand (rp, rstate, nbits);
/* If nbits isn't a multiple of BITS_PER_MP_LIMB, shift up. */
if (nlimbs != 0)
{
if (nbits % BITS_PER_MP_LIMB != 0)
mpn_lshift (rp, rp, nlimbs,
BITS_PER_MP_LIMB - nbits % BITS_PER_MP_LIMB);
}
exp = 0;
while (nlimbs != 0 && rp[nlimbs - 1] == 0)
{
nlimbs--;
exp--;
}
if (nlimbs != 0) /* otherwise value is zero */
{
count_leading_zeros (cnt, rp[nlimbs - 1]);
if (cnt) mpn_lshift (rp, rp, nlimbs, cnt);
exp -= cnt;
cnt = nlimbs*BITS_PER_MP_LIMB - nbits;
/* cnt is the number of non significant bits in the low limb */
rp[0] &= ~((MP_LIMB_T_ONE << cnt) - 1);
}
MPFR_EXP (rop) = exp;
}
void
mpfr_get_z (mpz_ptr z, mpfr_srcptr f, mp_rnd_t rnd)
{
mpfr_t r;
mp_exp_t exp = MPFR_EXP (f);
/* if exp <= 0, then |f|<1, thus |o(f)|<=1 */
MPFR_ASSERTN (exp < 0 || exp <= MPFR_PREC_MAX);
mpfr_init2 (r, (exp < (mp_exp_t) MPFR_PREC_MIN ?
MPFR_PREC_MIN : (mpfr_prec_t) exp));
mpfr_rint (r, f, rnd);
MPFR_ASSERTN (MPFR_IS_FP (r) );
exp = mpfr_get_z_exp (z, r);
if (exp >= 0)
mpz_mul_2exp (z, z, exp);
else
mpz_div_2exp (z, z, -exp);
mpfr_clear (r);
}
static void
check_set_sj (void)
{
mpfr_t x;
int inex;
mpfr_init2 (x, sizeof(intmax_t)*CHAR_BIT-1);
inex = mpfr_set_sj (x, -MPFR_INTMAX_MAX, MPFR_RNDN);
inex |= mpfr_add_si (x, x, -1, MPFR_RNDN);
if (inex || mpfr_sgn (x) >=0 || !mpfr_powerof2_raw (x)
|| MPFR_EXP (x) != (sizeof(intmax_t)*CHAR_BIT) )
ERROR("set_sj (-INTMAX_MAX)");
inex = mpfr_set_sj (x, 1742, MPFR_RNDN);
if (inex || mpfr_cmp_ui (x, 1742))
ERROR ("set_sj (1742)");
mpfr_clear (x);
}
static void
check_set_uj_2exp (void)
{
mpfr_t x;
int inex;
mpfr_init2 (x, sizeof(uintmax_t)*CHAR_BIT);
inex = mpfr_set_uj_2exp (x, 1, 0, MPFR_RNDN);
if (inex || mpfr_cmp_ui(x, 1))
ERROR("(1U,0)");
inex = mpfr_set_uj_2exp (x, 1024, -10, MPFR_RNDN);
if (inex || mpfr_cmp_ui(x, 1))
ERROR("(1024U,-10)");
inex = mpfr_set_uj_2exp (x, 1024, 10, MPFR_RNDN);
if (inex || mpfr_cmp_ui(x, 1024L * 1024L))
ERROR("(1024U,+10)");
inex = mpfr_set_uj_2exp (x, MPFR_UINTMAX_MAX, 1000, MPFR_RNDN);
inex |= mpfr_div_2ui (x, x, 1000, MPFR_RNDN);
inex |= mpfr_add_ui (x, x, 1, MPFR_RNDN);
if (inex || !mpfr_powerof2_raw (x)
|| MPFR_EXP (x) != (sizeof(uintmax_t)*CHAR_BIT+1) )
ERROR("(UINTMAX_MAX)");
inex = mpfr_set_uj_2exp (x, MPFR_UINTMAX_MAX, MPFR_EMAX_MAX-10, MPFR_RNDN);
if (inex == 0 || !mpfr_inf_p (x))
ERROR ("Overflow");
inex = mpfr_set_uj_2exp (x, MPFR_UINTMAX_MAX, MPFR_EMIN_MIN-1000, MPFR_RNDN);
if (inex == 0 || !MPFR_IS_ZERO (x))
ERROR ("Underflow");
mpfr_clear (x);
}
int
main (int argc, char *argv[])
{
unsigned int prec, err, yprec, n, k, zeros;
int rnd;
mpfr_t x, y, z, t;
int inexact;
tests_start_mpfr ();
special ();
test_int ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_fac_ui (y, 0, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("mpfr_fac_ui(0) does not give 1\n");
exit (1);
}
for (prec = 2; 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 < GMP_RND_MAX; rnd++)
{
inexact = mpfr_fac_ui (y, n, (mp_rnd_t) rnd);
err = (rnd == GMP_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, (mp_rnd_t) rnd, (mp_rnd_t) rnd, prec))
{
mpfr_set (t, y, (mp_rnd_t) rnd);
inexact = mpfr_fac_ui (z, n, (mp_rnd_t) rnd);
/* fact(n) ends with floor(n/2)+floor(n/4)+... zeros */
for (k=n/2, zeros=0; k; k >>= 1)
zeros += k;
if (MPFR_EXP(y) <= (mp_exp_t) (prec + zeros))
/* result should be exact */
{
if (inexact)
{
printf ("Wrong inexact flag: expected exact\n");
exit (1);
}
}
else /* result is inexact */
{
if (!inexact)
{
printf ("Wrong inexact flag: expected inexact\n");
printf ("n=%u prec=%u\n", n, prec);
mpfr_print_binary(z); puts ("");
exit (1);
}
}
if (mpfr_cmp (t, z))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, GMP_RNDN);
printf (" prec=%u rnd_mode=%s\n", prec,
mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf (" got ");
mpfr_out_str (stdout, 2, prec, z, GMP_RNDN);
puts ("");
printf (" expected ");
mpfr_out_str (stdout, 2, prec, t, GMP_RNDN);
puts ("");
printf (" approximation was ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
}
}
}
int
main (void)
{
int j, k;
mpfr_t x, y, z, t, y2, z2, t2;
tests_start_mpfr ();
mpfr_inits2 (SIZEX, x, y, z, t, y2, z2, t2, (mpfr_ptr) 0);
mpfr_set_str1 (x, "0.5");
mpfr_ceil(y, x);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error in mpfr_ceil for x=0.5: expected 1.0, got ");
mpfr_print_binary(y);
putchar('\n');
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_ceil(y, x);
if (mpfr_cmp_ui(y,0))
{
printf ("Error in mpfr_ceil for x=0.0: expected 0.0, got ");
mpfr_print_binary(y);
putchar('\n');
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_ceil(y, x);
if (mpfr_cmp_ui(y,1))
{
printf ("Error in mpfr_ceil for x=1.0: expected 1.0, got ");
mpfr_print_binary(y);
putchar('\n');
exit (1);
}
for (j=0;j<1000;j++)
{
mpfr_urandomb (x, RANDS);
MPFR_EXP (x) = 2;
for (k = 2; k <= SIZEX; k++)
{
mpfr_set_prec(y, k);
mpfr_set_prec(y2, k);
mpfr_set_prec(z, k);
mpfr_set_prec(z2, k);
mpfr_set_prec(t, k);
mpfr_set_prec(t2, k);
mpfr_floor(y, x);
mpfr_set(y2, x, MPFR_RNDD);
mpfr_trunc(z, x);
mpfr_set(z2, x, MPFR_RNDZ);
mpfr_ceil(t, x);
mpfr_set(t2, x, MPFR_RNDU);
if (!mpfr_eq(y, y2, k))
{
printf("Error in floor, x = "); mpfr_print_binary(x);
printf("\n");
printf("floor(x) = "); mpfr_print_binary(y);
printf("\n");
printf("round(x, RNDD) = "); mpfr_print_binary(y2);
printf("\n");
exit(1);
}
if (!mpfr_eq(z, z2, k))
{
printf("Error in trunc, x = "); mpfr_print_binary(x);
printf("\n");
printf("trunc(x) = "); mpfr_print_binary(z);
printf("\n");
printf("round(x, RNDZ) = "); mpfr_print_binary(z2);
printf("\n");
exit(1);
}
if (!mpfr_eq(y, y2, k))
{
printf("Error in ceil, x = "); mpfr_print_binary(x);
printf("\n");
printf("ceil(x) = "); mpfr_print_binary(t);
printf("\n");
printf("round(x, RNDU) = "); mpfr_print_binary(t2);
printf("\n");
exit(1);
}
MPFR_EXP(x)++;
}
}
mpfr_clears (x, y, z, t, y2, z2, t2, (mpfr_ptr) 0);
tests_end_mpfr ();
return 0;
}
