// Get integer part, starting search from given lower bound.
void binary_search(mpz_ptr lower) {
while (!mpz_sgn(p->c0)) move_right();
for (;;) {
mpz_set(z0, lower);
mpz_set(z, lower);
int sign = sign_quad();
mpz_set_ui(pow2, 1);
for (;;) {
mpz_add(z, z0, pow2);
if (sign_quad() != sign) break;
mpz_mul_2exp(pow2, pow2, 1);
}
mpz_set(z1, z);
for (;;) {
mpz_add(z, z0, z1);
mpz_div_2exp(z, z, 1);
if (!mpz_cmp(z, z0)) break;
if (sign_quad() == sign) {
mpz_set(z0, z);
} else {
mpz_set(z1, z);
}
}
sign = sign_quad1();
mpz_set(z, z1);
if (sign_quad1() != sign) break;
move_right();
}
}
/*
Left shift if w > 0, right shift if w < 0.
*/
cl_object
ecl_ash(cl_object x, cl_fixnum w)
{
cl_object y;
if (w == 0)
return(x);
y = _ecl_big_register0();
if (w < 0) {
cl_index bits = -w;
if (ECL_FIXNUMP(x)) {
/* The result of shifting a number further than the number
* of digits it has is unpredictable in C. For instance, GCC
* on intel masks out all bits of "bits" beyond the 5 and
* it may happen that a shift of 37 becomes a shift of 5.
* Furthermore, in general, shifting negative numbers leads
* to implementation-specific results :-/
*/
cl_fixnum y = ecl_fixnum(x);
if (bits >= FIXNUM_BITS) {
y = (y < 0)? -1 : 0;
} else {
y >>= bits;
}
return ecl_make_fixnum(y);
}
mpz_div_2exp(y->big.big_num, x->big.big_num, bits);
} else {
/* if expz > target, shift z by (expz-target) bits to the left.
if expz < target, shift z by (target-expz) bits to the right.
Returns target.
*/
static int
mpz_normalize2 (mpz_t rop, mpz_t z, int expz, int target)
{
if (target > expz) mpz_div_2exp(rop, z, target-expz);
else mpz_mul_2exp(rop, z, expz-target);
return target;
}
void mp_linearize_msb_first(unsigned char *buf, unsigned int len, MP_INT * value)
{
unsigned int i;
MP_INT aux;
mpz_init_set(&aux, value);
for (i = len; i >= 4; i -= 4) {
unsigned long limb = mpz_get_ui(&aux);
PUT_32BIT(buf + i - 4, limb);
mpz_div_2exp(&aux, &aux, 32);
}
for (; i > 0; i--) {
buf[i - 1] = mpz_get_ui(&aux);
mpz_div_2exp(&aux, &aux, 8);
}
mpz_clear(&aux);
}
/* FilterRangeFromMP_INT : make a mask for width and offset, AND the given value with the mask
and return that ANDed value shifted right offset bits */
PtrMP_INT FilterRangeFromMP_INT (PtrMP_INT value, Bits width, Bits offset)
{
PtrMP_INT mask = MakeMaskForRange (width, offset);
mpz_and (mask, value, mask); /* mask= value & mask */
mpz_div_2exp (mask, mask, offset); /* mask >>= offset */
return mask;
}
/* 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;
}
void
check_random (int argc, char **argv)
{
gmp_randstate_ptr rands = RANDS;
double d;
mpq_t q;
mpz_t a, t;
int exp;
int test, reps = 100000;
if (argc == 2)
reps = 100 * atoi (argv[1]);
mpq_init (q);
mpz_init (a);
mpz_init (t);
for (test = 0; test < reps; test++)
{
mpz_rrandomb (a, rands, 53);
mpz_urandomb (t, rands, 32);
exp = mpz_get_ui (t) % (2*MAXEXP) - MAXEXP;
d = my_ldexp (mpz_get_d (a), exp);
mpq_set_d (q, d);
/* Check that n/d = a * 2^exp, or
d*a 2^{exp} = n */
mpz_mul (t, a, mpq_denref (q));
if (exp > 0)
mpz_mul_2exp (t, t, exp);
else
{
if (!mpz_divisible_2exp_p (t, -exp))
goto fail;
mpz_div_2exp (t, t, -exp);
}
if (mpz_cmp (t, mpq_numref (q)) != 0)
{
fail:
printf ("ERROR (check_random test %d): bad mpq_set_d results\n", test);
printf ("%.16g\n", d);
gmp_printf ("%Qd\n", q);
abort ();
}
}
mpq_clear (q);
mpz_clear (t);
mpz_clear (a);
}
static cl_fixnum
remove_zeros(cl_object *integer)
{
cl_object buffer = into_bignum(_ecl_big_register0(), *integer);
unsigned long den_twos = mpz_scan1(buffer->big.big_num, 0);
if (den_twos < ULONG_MAX) {
mpz_div_2exp(buffer->big.big_num, buffer->big.big_num, den_twos);
*integer = _ecl_big_register_normalize(buffer);
return -den_twos;
} else {
_ecl_big_register_free(buffer);
return 0;
}
}
/* if k = the number of bits of z > q, divides z by 2^(k-q) and returns k-q.
Otherwise do nothing and return 0.
*/
static mp_exp_t
mpz_normalize (mpz_t rop, mpz_t z, int q)
{
int k;
k = mpz_sizeinbase(z, 2);
if (k > q) {
mpz_div_2exp(rop, z, k-q);
return k-q;
}
else {
if (rop != z) mpz_set(rop, z);
return 0;
}
}
/* if k = the number of bits of z > q, divides z by 2^(k-q) and returns k-q.
Otherwise do nothing and return 0.
*/
static mp_exp_t
mpz_normalize (mpz_t rop, mpz_t z, mp_exp_t q)
{
size_t k;
k = mpz_sizeinbase(z, 2);
MPFR_ASSERTD (k == (mpfr_uexp_t) k);
if (q < 0 || (mpfr_uexp_t) k > (mpfr_uexp_t) q)
{
mpz_div_2exp(rop, z, (unsigned long) ((mpfr_uexp_t) k - q));
return (mp_exp_t) k - q;
}
if (MPFR_UNLIKELY(rop != z))
mpz_set(rop, z);
return 0;
}
uint64 mpz2uint64(mpz_t n)
{
unsigned int lo, hi;
mpz_t tmp;
mpz_init( tmp );
mpz_mod_2exp( tmp, n, 64 );
lo = mpz_get_ui( tmp );
mpz_div_2exp( tmp, tmp, 32 );
hi = mpz_get_ui( tmp );
mpz_clear( tmp );
return (((uint64)hi) << 32) + lo;
}
/***************************************************************
* This function casts an mpz_t to an unsigned long long. We
* need this function in order to return the mpz_t value due to
* the difficulty of passing the value of the mpz_t function.
***************************************************************/
unsigned long long mpz_get_ull(mpz_t n)
{
unsigned int lo, hi;
mpz_t tmp;
mpz_init( tmp );
mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */
lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */
mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */
mpz_clear( tmp );
return (((unsigned long long)hi) << 32) + lo;
}
/* assuming B[0]...B[2(n-1)] are computed, computes and stores B[2n]*(2n+1)!
t/(exp(t)-1) = sum(B[j]*t^j/j!, j=0..infinity)
thus t = (exp(t)-1) * sum(B[j]*t^j/j!, n=0..infinity).
Taking the coefficient of degree n+1 > 1, we get:
0 = sum(1/(n+1-k)!*B[k]/k!, k=0..n)
which gives:
B[n] = -sum(binomial(n+1,k)*B[k], k=0..n-1)/(n+1).
Let C[n] = B[n]*(n+1)!.
Then C[n] = -sum(binomial(n+1,k)*C[k]*n!/(k+1)!, k=0..n-1),
which proves that the C[n] are integers.
*/
static mpz_t *
bernoulli (mpz_t * b, unsigned long n)
{
if (n == 0)
{
b = (mpz_t *) (*__gmp_allocate_func) (sizeof (mpz_t));
mpz_init_set_ui (b[0], 1);
}
else
{
mpz_t t;
unsigned long k;
b = (mpz_t *) (*__gmp_reallocate_func)
(b, n * sizeof (mpz_t), (n + 1) * sizeof (mpz_t));
mpz_init (b[n]);
/* b[n] = -sum(binomial(2n+1,2k)*C[k]*(2n)!/(2k+1)!, k=0..n-1) */
mpz_init_set_ui (t, 2 * n + 1);
mpz_mul_ui (t, t, 2 * n - 1);
mpz_mul_ui (t, t, 2 * n);
mpz_mul_ui (t, t, n);
mpz_div_ui (t, t, 3); /* exact: t=binomial(2*n+1,2*k)*(2*n)!/(2*k+1)!
for k=n-1 */
mpz_mul (b[n], t, b[n - 1]);
for (k = n - 1; k-- > 0;)
{
mpz_mul_ui (t, t, 2 * k + 1);
mpz_mul_ui (t, t, 2 * k + 2);
mpz_mul_ui (t, t, 2 * k + 2);
mpz_mul_ui (t, t, 2 * k + 3);
mpz_div_ui (t, t, 2 * (n - k) + 1);
mpz_div_ui (t, t, 2 * (n - k));
mpz_addmul (b[n], t, b[k]);
}
/* take into account C[1] */
mpz_mul_ui (t, t, 2 * n + 1);
mpz_div_2exp (t, t, 1);
mpz_sub (b[n], b[n], t);
mpz_neg (b[n], b[n]);
mpz_clear (t);
}
return b;
}
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);
}
int
mpc_log10 (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok = 0, loops = 0, check_exact = 0, special_re, special_im,
inex, inex_re, inex_im;
mpfr_prec_t prec;
mpfr_t log10;
mpc_t log;
mpfr_init2 (log10, 2);
mpc_init2 (log, 2);
prec = MPC_MAX_PREC (rop);
/* compute log(op)/log(10) */
while (ok == 0) {
loops ++;
prec += (loops <= 2) ? mpc_ceil_log2 (prec) + 4 : prec / 2;
mpfr_set_prec (log10, prec);
mpc_set_prec (log, prec);
inex = mpc_log (log, op, rnd); /* error <= 1 ulp */
if (!mpfr_number_p (mpc_imagref (log))
|| mpfr_zero_p (mpc_imagref (log))) {
/* no need to divide by log(10) */
special_im = 1;
ok = 1;
}
else {
special_im = 0;
mpfr_const_log10 (log10);
mpfr_div (mpc_imagref (log), mpc_imagref (log), log10, MPFR_RNDN);
ok = mpfr_can_round (mpc_imagref (log), prec - 2,
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM (rnd) == MPFR_RNDN));
}
if (ok) {
if (!mpfr_number_p (mpc_realref (log))
|| mpfr_zero_p (mpc_realref (log)))
special_re = 1;
else {
special_re = 0;
if (special_im)
/* log10 not yet computed */
mpfr_const_log10 (log10);
mpfr_div (mpc_realref (log), mpc_realref (log), log10, MPFR_RNDN);
/* error <= 24/7 ulp < 4 ulp for prec >= 4, see algorithms.tex */
ok = mpfr_can_round (mpc_realref (log), prec - 2,
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
}
/* Special code to deal with cases where the real part of log10(x+i*y)
is exact, like x=3 and y=1. Since Re(log10(x+i*y)) = log10(x^2+y^2)/2
this happens whenever x^2+y^2 is a nonnegative power of 10.
Indeed x^2+y^2 cannot equal 10^(a/2^b) for a, b integers, a odd, b>0,
since x^2+y^2 is rational, and 10^(a/2^b) is irrational.
Similarly, for b=0, x^2+y^2 cannot equal 10^a for a < 0 since x^2+y^2
is a rational with denominator a power of 2.
Now let x^2+y^2 = 10^s. Without loss of generality we can assume
x = u/2^e and y = v/2^e with u, v, e integers: u^2+v^2 = 10^s*2^(2e)
thus u^2+v^2 = 0 mod 2^(2e). By recurrence on e, necessarily
u = v = 0 mod 2^e, thus x and y are necessarily integers.
*/
if (!ok && !check_exact && mpfr_integer_p (mpc_realref (op)) &&
mpfr_integer_p (mpc_imagref (op))) {
mpz_t x, y;
unsigned long s, v;
check_exact = 1;
mpz_init (x);
mpz_init (y);
mpfr_get_z (x, mpc_realref (op), MPFR_RNDN); /* exact */
mpfr_get_z (y, mpc_imagref (op), MPFR_RNDN); /* exact */
mpz_mul (x, x, x);
mpz_mul (y, y, y);
mpz_add (x, x, y); /* x^2+y^2 */
v = mpz_scan1 (x, 0);
/* if x = 10^s then necessarily s = v */
s = mpz_sizeinbase (x, 10);
/* since s is either the number of digits of x or one more,
then x = 10^(s-1) or 10^(s-2) */
if (s == v + 1 || s == v + 2) {
mpz_div_2exp (x, x, v);
mpz_ui_pow_ui (y, 5, v);
if (mpz_cmp (y, x) == 0) {
/* Re(log10(x+i*y)) is exactly v/2
we reset the precision of Re(log) so that v can be
represented exactly */
mpfr_set_prec (mpc_realref (log),
sizeof(unsigned long)*CHAR_BIT);
mpfr_set_ui_2exp (mpc_realref (log), v, -1, MPFR_RNDN);
/* exact */
ok = 1;
}
}
mpz_clear (x);
mpz_clear (y);
}
}
}
inex_re = mpfr_set (mpc_realref(rop), mpc_realref (log), MPC_RND_RE (rnd));
if (special_re)
inex_re = MPC_INEX_RE (inex);
/* recover flag from call to mpc_log above */
inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref (log), MPC_RND_IM (rnd));
if (special_im)
inex_im = MPC_INEX_IM (inex);
mpfr_clear (log10);
mpc_clear (log);
return MPC_INEX(inex_re, inex_im);
}
void rsa_generate_key(RSAPrivateKey *prv, RSAPublicKey *pub,
RandomState *state, unsigned int bits)
{
MP_INT test, aux;
unsigned int pbits, qbits;
int ret;
mpz_init(&prv->q);
mpz_init(&prv->p);
mpz_init(&prv->e);
mpz_init(&prv->d);
mpz_init(&prv->u);
mpz_init(&prv->n);
mpz_init(&test);
mpz_init(&aux);
/* Compute the number of bits in each prime. */
pbits = bits / 2;
qbits = bits - pbits;
#ifndef RSAREF
retry0:
#endif /* !RSAREF */
if (rsa_verbose)
{
fprintf(stderr, "Generating p: ");
}
/* Generate random number p. */
rsa_random_prime(&prv->p, state, pbits);
retry:
if (rsa_verbose)
{
fprintf(stderr, "Generating q: ");
}
/* Generate random number q. */
rsa_random_prime(&prv->q, state, qbits);
/* Sort them so that p < q. */
ret = mpz_cmp(&prv->p, &prv->q);
if (ret == 0)
{
if (rsa_verbose)
fprintf(stderr, "Generated the same prime twice!\n");
goto retry;
}
if (ret > 0)
{
mpz_set(&aux, &prv->p);
mpz_set(&prv->p, &prv->q);
mpz_set(&prv->q, &aux);
}
/* Make sure that p and q are not too close together (I am not sure if this
is important). */
mpz_sub(&aux, &prv->q, &prv->p);
mpz_div_2exp(&test, &prv->q, 10);
if (mpz_cmp(&aux, &test) < 0)
{
if (rsa_verbose)
fprintf(stderr, "The primes are too close together.\n");
goto retry;
}
/* Make certain p and q are relatively prime (in case one or both were false
positives... Though this is quite impossible). */
mpz_gcd(&aux, &prv->p, &prv->q);
if (mpz_cmp_ui(&aux, 1) != 0)
{
if (rsa_verbose)
fprintf(stderr, "The primes are not relatively prime!\n");
goto retry;
}
/* Derive the RSA private key from the primes. */
if (rsa_verbose)
fprintf(stderr, "Computing the keys...\n");
derive_rsa_keys(&prv->n, &prv->e, &prv->d, &prv->u, &prv->p, &prv->q, 5);
prv->bits = bits;
/* Initialize the public key with public data from the private key. */
pub->bits = bits;
mpz_init_set(&pub->n, &prv->n);
mpz_init_set(&pub->e, &prv->e);
#ifndef RSAREF /* I don't want to kludge these to work with RSAREF. */
/* Test that the key really works. This should never fail (I think). */
if (rsa_verbose)
fprintf(stderr, "Testing the keys...\n");
rsa_random_integer(&test, state, bits);
mpz_mod(&test, &test, &pub->n); /* must be less than n. */
rsa_private(&aux, &test, prv);
rsa_public(&aux, &aux, pub);
if (mpz_cmp(&aux, &test) != 0)
{
if (rsa_verbose)
fprintf(stderr, "**** private+public failed to decrypt.\n");
goto retry0;
}
rsa_public(&aux, &test, pub);
rsa_private(&aux, &aux, prv);
if (mpz_cmp(&aux, &test) != 0)
{
if (rsa_verbose)
fprintf(stderr, "**** public+private failed to decrypt.\n");
goto retry0;
}
#endif /* !RSAREF */
mpz_clear(&aux);
mpz_clear(&test);
if (rsa_verbose)
fprintf(stderr, "Key generation complete.\n");
}
void rsa_random_prime(MP_INT *ret, RandomState *state, unsigned int bits)
{
MP_INT start, aux;
unsigned int num_primes;
int *moduli;
long difference;
mpz_init(&start);
mpz_init(&aux);
retry:
/* Pick a random integer of the appropriate size. */
rsa_random_integer(&start, state, bits);
/* Set the two highest bits. */
mpz_set_ui(&aux, 3);
mpz_mul_2exp(&aux, &aux, bits - 2);
mpz_ior(&start, &start, &aux);
/* Set the lowest bit to make it odd. */
mpz_set_ui(&aux, 1);
mpz_ior(&start, &start, &aux);
/* Initialize moduli of the small primes with respect to the given
random number. */
moduli = xmalloc(MAX_PRIMES_IN_TABLE * sizeof(moduli[0]));
if (bits < 16)
num_primes = 0; /* Don\'t use the table for very small numbers. */
else
{
for (num_primes = 0; small_primes[num_primes] != 0; num_primes++)
{
mpz_mod_ui(&aux, &start, small_primes[num_primes]);
moduli[num_primes] = mpz_get_ui(&aux);
}
}
/* Look for numbers that are not evenly divisible by any of the small
primes. */
for (difference = 0; ; difference += 2)
{
unsigned int i;
if (difference > 0x70000000)
{ /* Should never happen, I think... */
if (rsa_verbose)
fprintf(stderr,
"rsa_random_prime: failed to find a prime, retrying.\n");
xfree(moduli);
goto retry;
}
/* Check if it is a multiple of any small prime. Note that this
updates the moduli into negative values as difference grows. */
for (i = 0; i < num_primes; i++)
{
while (moduli[i] + difference >= small_primes[i])
moduli[i] -= small_primes[i];
if (moduli[i] + difference == 0)
break;
}
if (i < num_primes)
continue; /* Multiple of a known prime. */
/* It passed the small prime test (not divisible by any of them). */
if (rsa_verbose)
{
fprintf(stderr, ".");
}
/* Compute the number in question. */
mpz_add_ui(ret, &start, difference);
/* Perform the fermat test for witness 2. This means:
it is not prime if 2^n mod n != 2. */
mpz_set_ui(&aux, 2);
mpz_powm(&aux, &aux, ret, ret);
if (mpz_cmp_ui(&aux, 2) == 0)
{
/* Passed the fermat test for witness 2. */
if (rsa_verbose)
{
fprintf(stderr, "+");
}
/* Perform a more tests. These are probably unnecessary. */
if (mpz_probab_prime_p(ret, 20))
break; /* It is a prime with probability 1 - 2^-40. */
}
}
/* Found a (probable) prime. It is in ret. */
if (rsa_verbose)
{
fprintf(stderr, "+ (distance %ld)\n", difference);
}
/* Free the small prime moduli; they are no longer needed. */
xfree(moduli);
/* Sanity check: does it still have the high bit set (we might have
wrapped around)? */
mpz_div_2exp(&aux, ret, bits - 1);
if (mpz_get_ui(&aux) != 1)
{
if (rsa_verbose)
fprintf(stderr, "rsa_random_prime: high bit not set, retrying.\n");
goto retry;
}
mpz_clear(&start);
mpz_clear(&aux);
/* Return value already set in ret. */
}
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! while MPFR_EXP(r^l/l!)+MPFR_EXPR(r)>-q
using Brent/Kung method with O(sqrt(l)) multiplications.
Return l.
Uses m multiplications of full size and 2l/m of decreasing size,
i.e. a total equivalent to about m+l/m full multiplications,
i.e. 2*sqrt(l) for m=sqrt(l).
Version using mpz. ss must have at least (sizer+1) limbs.
The error is bounded by (l^2+4*l) ulps where l is the return value.
*/
static int
mpfr_exp2_aux2 (mpz_t s, mpfr_srcptr r, int q, int *exps)
{
int expr, l, m, i, sizer, *expR, expt, ql;
unsigned long int c;
mpz_t t, *R, rr, tmp;
TMP_DECL(marker);
/* estimate value of l */
l = q / (-MPFR_EXP(r));
m = (int) _mpfr_isqrt (l);
/* we access R[2], thus we need m >= 2 */
if (m < 2) m = 2;
TMP_MARK(marker);
R = (mpz_t*) TMP_ALLOC((m+1)*sizeof(mpz_t)); /* R[i] stands for r^i */
expR = (int*) TMP_ALLOC((m+1)*sizeof(int)); /* exponent for R[i] */
sizer = 1 + (MPFR_PREC(r)-1)/BITS_PER_MP_LIMB;
mpz_init(tmp);
MY_INIT_MPZ(rr, sizer+2);
MY_INIT_MPZ(t, 2*sizer); /* double size for products */
mpz_set_ui(s, 0); *exps = 1-q; /* initialize s to zero, 1 ulp = 2^(1-q) */
for (i=0;i<=m;i++) MY_INIT_MPZ(R[i], sizer+2);
expR[1] = mpfr_get_z_exp(R[1], r); /* exact operation: no error */
expR[1] = mpz_normalize2(R[1], R[1], expR[1], 1-q); /* error <= 1 ulp */
mpz_mul(t, R[1], R[1]); /* err(t) <= 2 ulps */
mpz_div_2exp(R[2], t, q-1); /* err(R[2]) <= 3 ulps */
expR[2] = 1-q;
for (i=3;i<=m;i++) {
mpz_mul(t, R[i-1], R[1]); /* err(t) <= 2*i-2 */
mpz_div_2exp(R[i], t, q-1); /* err(R[i]) <= 2*i-1 ulps */
expR[i] = 1-q;
}
mpz_set_ui(R[0], 1); mpz_mul_2exp(R[0], R[0], q-1); expR[0]=1-q; /* R[0]=1 */
mpz_set_ui(rr, 1); expr=0; /* rr contains r^l/l! */
/* by induction: err(rr) <= 2*l ulps */
l = 0;
ql = q; /* precision used for current giant step */
do {
/* all R[i] must have exponent 1-ql */
if (l) for (i=0;i<m;i++) {
expR[i] = mpz_normalize2(R[i], R[i], expR[i], 1-ql);
}
/* the absolute error on R[i]*rr is still 2*i-1 ulps */
expt = mpz_normalize2(t, R[m-1], expR[m-1], 1-ql);
/* err(t) <= 2*m-1 ulps */
/* computes t = 1 + r/(l+1) + ... + r^(m-1)*l!/(l+m-1)!
using Horner's scheme */
for (i=m-2;i>=0;i--) {
mpz_div_ui(t, t, l+i+1); /* err(t) += 1 ulp */
mpz_add(t, t, R[i]);
}
/* now err(t) <= (3m-2) ulps */
/* now multiplies t by r^l/l! and adds to s */
mpz_mul(t, t, rr); expt += expr;
expt = mpz_normalize2(t, t, expt, *exps);
/* err(t) <= (3m-1) + err_rr(l) <= (3m-2) + 2*l */
#ifdef DEBUG
if (expt != *exps) {
fprintf(stderr, "Error: expt != exps %d %d\n", expt, *exps); exit(1);
}
#endif
mpz_add(s, s, t); /* no error here */
/* updates rr, the multiplication of the factors l+i could be done
using binary splitting too, but it is not sure it would save much */
mpz_mul(t, rr, R[m]); /* err(t) <= err(rr) + 2m-1 */
expr += expR[m];
mpz_set_ui (tmp, 1);
for (i=1, c=1; i<=m; i++) {
if (l+i > ~((unsigned long int) 0)/c) {
mpz_mul_ui(tmp, tmp, c);
c = l+i;
}
else c *= (unsigned long int) l+i;
}
if (c != 1) mpz_mul_ui (tmp, tmp, c); /* tmp is exact */
mpz_fdiv_q(t, t, tmp); /* err(t) <= err(rr) + 2m */
expr += mpz_normalize(rr, t, ql); /* err_rr(l+1) <= err_rr(l) + 2m+1 */
ql = q - *exps - mpz_sizeinbase(s, 2) + expr + mpz_sizeinbase(rr, 2);
l+=m;
} while (expr+mpz_sizeinbase(rr, 2) > -q);
TMP_FREE(marker);
mpz_clear(tmp);
return l;
}
mp_bitcnt_t
mpz_remove (mpz_ptr dest, mpz_srcptr src, mpz_srcptr f)
{
mpz_t fpow[GMP_LIMB_BITS]; /* Really MP_SIZE_T_BITS */
mpz_t x, rem;
mp_bitcnt_t pwr;
int p;
if (mpz_cmp_ui (f, 1) <= 0)
DIVIDE_BY_ZERO;
if (SIZ (src) == 0)
{
if (src != dest)
mpz_set (dest, src);
return 0;
}
if (mpz_cmp_ui (f, 2) == 0)
{
mp_bitcnt_t s0;
s0 = mpz_scan1 (src, 0);
mpz_div_2exp (dest, src, s0);
return s0;
}
/* We could perhaps compute mpz_scan1(src,0)/mpz_scan1(f,0). It is an
upper bound of the result we're seeking. We could also shift down the
operands so that they become odd, to make intermediate values smaller. */
mpz_init (rem);
mpz_init (x);
pwr = 0;
mpz_init (fpow[0]);
mpz_set (fpow[0], f);
mpz_set (dest, src);
/* Divide by f, f^2, ..., f^(2^k) until we get a remainder for f^(2^k). */
for (p = 0;; p++)
{
mpz_tdiv_qr (x, rem, dest, fpow[p]);
if (SIZ (rem) != 0)
break;
mpz_init (fpow[p + 1]);
mpz_mul (fpow[p + 1], fpow[p], fpow[p]);
mpz_set (dest, x);
}
pwr = (1L << p) - 1;
mpz_clear (fpow[p]);
/* Divide by f^(2^(k-1)), f^(2^(k-2)), ..., f for all divisors that give a
zero remainder. */
while (--p >= 0)
{
mpz_tdiv_qr (x, rem, dest, fpow[p]);
if (SIZ (rem) == 0)
{
pwr += 1L << p;
mpz_set (dest, x);
}
mpz_clear (fpow[p]);
}
mpz_clear (x);
mpz_clear (rem);
return pwr;
}
num_t
num_int_part_sel(pseltype_t op_type, num_t hi, num_t lo, num_t a)
{
num_t r, m;
unsigned long mask_shl, lo_ui;
r = num_new_z(N_TEMP, NULL);
m = num_new_z(N_TEMP, NULL);
a = num_new_z(N_TEMP, a);
hi = num_new_z(N_TEMP, hi);
if (lo != NULL)
lo = num_new_z(N_TEMP, lo);
switch (op_type) {
case PSEL_SINGLE:
lo = num_new_z(N_TEMP, hi);
break;
case PSEL_FRANGE:
break;
case PSEL_DRANGE:
if (mpz_cmp_si(Z(lo), 0L) < 0) {
yyxerror("low index of part select operation must be "
"positive");
return NULL;
}
mpz_sub_ui(Z(lo), Z(lo), 1UL);
mpz_sub(Z(lo), Z(hi), Z(lo));
break;
}
if (mpz_cmp_si(Z(hi), 0L) < 0) {
yyxerror("high index of part select operation must be "
"positive");
return NULL;
}
if (mpz_cmp_si(Z(lo), 0L) < 0) {
yyxerror("low index of part select operation must be "
"positive");
return NULL;
}
if (!mpz_fits_ulong_p(Z(hi))) {
yyxerror("high index of part select operation needs to fit "
"into an unsigned long C datatype");
return NULL;
}
if (!mpz_fits_ulong_p(Z(lo))) {
yyxerror("low index of part select operation needs to fit "
"into an unsigned long C datatype");
return NULL;
}
lo_ui = mpz_get_ui(Z(lo));
mask_shl = 1 + (mpz_get_ui(Z(hi)) - lo_ui);
/*
* We do the part sel by:
* (1) shifting right by 'lo'
* (2) anding with ((1 << mask_shl)-1)
*/
mpz_div_2exp(Z(r), Z(a), lo_ui);
mpz_set_ui(Z(m), 1UL);
mpz_mul_2exp(Z(m), Z(m), mask_shl);
mpz_sub_ui(Z(m), Z(m), 1UL);
mpz_and(Z(r), Z(r), Z(m));
return r;
}
int
mpfr_zeta_ui (mpfr_ptr z, unsigned long m, mp_rnd_t r)
{
MPFR_ZIV_DECL (loop);
if (m == 0)
{
mpfr_set_ui (z, 1, r);
mpfr_div_2ui (z, z, 1, r);
MPFR_CHANGE_SIGN (z);
MPFR_RET (0);
}
else if (m == 1)
{
MPFR_SET_INF (z);
MPFR_SET_POS (z);
return 0;
}
else /* m >= 2 */
{
mp_prec_t p = MPFR_PREC(z);
unsigned long n, k, err, kbits;
mpz_t d, t, s, q;
mpfr_t y;
int inex;
if (m >= p) /* 2^(-m) < ulp(1) = 2^(1-p). This means that
2^(-m) <= 1/2*ulp(1). We have 3^(-m)+4^(-m)+... < 2^(-m)
i.e. zeta(m) < 1+2*2^(-m) for m >= 3 */
{
if (m == 2) /* necessarily p=2 */
return mpfr_set_ui_2exp (z, 13, -3, r);
else if (r == GMP_RNDZ || r == GMP_RNDD || (r == GMP_RNDN && m > p))
{
mpfr_set_ui (z, 1, r);
return -1;
}
else
{
mpfr_set_ui (z, 1, r);
mpfr_nextabove (z);
return 1;
}
}
/* now treat also the case where zeta(m) - (1+1/2^m) < 1/2*ulp(1),
and the result is either 1+2^(-m) or 1+2^(-m)+2^(1-p). */
mpfr_init2 (y, 31);
if (m >= p / 2) /* otherwise 4^(-m) > 2^(-p) */
{
/* the following is a lower bound for log(3)/log(2) */
mpfr_set_str_binary (y, "1.100101011100000000011010001110");
mpfr_mul_ui (y, y, m, GMP_RNDZ); /* lower bound for log2(3^m) */
if (mpfr_cmp_ui (y, p + 2) >= 0)
{
mpfr_clear (y);
mpfr_set_ui (z, 1, GMP_RNDZ);
mpfr_div_2ui (z, z, m, GMP_RNDZ);
mpfr_add_ui (z, z, 1, GMP_RNDZ);
if (r != GMP_RNDU)
return -1;
mpfr_nextabove (z);
return 1;
}
}
mpz_init (s);
mpz_init (d);
mpz_init (t);
mpz_init (q);
p += MPFR_INT_CEIL_LOG2(p); /* account of the n term in the error */
p += MPFR_INT_CEIL_LOG2(p) + 15; /* initial value */
MPFR_ZIV_INIT (loop, p);
for(;;)
{
/* 0.39321985067869744 = log(2)/log(3+sqrt(8)) */
n = 1 + (unsigned long) (0.39321985067869744 * (double) p);
err = n + 4;
mpfr_set_prec (y, p);
/* computation of the d[k] */
mpz_set_ui (s, 0);
mpz_set_ui (t, 1);
mpz_mul_2exp (t, t, 2 * n - 1); /* t[n] */
mpz_set (d, t);
for (k = n; k > 0; k--)
{
count_leading_zeros (kbits, k);
kbits = BITS_PER_MP_LIMB - kbits;
/* if k^m is too large, use mpz_tdiv_q */
if (m * kbits > 2 * BITS_PER_MP_LIMB)
{
/* if we know in advance that k^m > d, then floor(d/k^m) will
be zero below, so there is no need to compute k^m */
kbits = (kbits - 1) * m + 1;
/* k^m has at least kbits bits */
if (kbits > mpz_sizeinbase (d, 2))
mpz_set_ui (q, 0);
else
{
mpz_ui_pow_ui (q, k, m);
mpz_tdiv_q (q, d, q);
}
}
else /* use several mpz_tdiv_q_ui calls */
{
unsigned long km = k, mm = m - 1;
while (mm > 0 && km < ULONG_MAX / k)
{
km *= k;
mm --;
}
mpz_tdiv_q_ui (q, d, km);
while (mm > 0)
{
km = k;
mm --;
while (mm > 0 && km < ULONG_MAX / k)
{
km *= k;
mm --;
}
mpz_tdiv_q_ui (q, q, km);
}
}
if (k % 2)
mpz_add (s, s, q);
else
mpz_sub (s, s, q);
/* we have d[k] = sum(t[i], i=k+1..n)
with t[i] = n*(n+i-1)!*4^i/(n-i)!/(2i)!
t[k-1]/t[k] = k*(2k-1)/(n-k+1)/(n+k-1)/2 */
#if (BITS_PER_MP_LIMB == 32)
#define KMAX 46341 /* max k such that k*(2k-1) < 2^32 */
#elif (BITS_PER_MP_LIMB == 64)
#define KMAX 3037000500
#endif
#ifdef KMAX
if (k <= KMAX)
mpz_mul_ui (t, t, k * (2 * k - 1));
else
#endif
{
mpz_mul_ui (t, t, k);
mpz_mul_ui (t, t, 2 * k - 1);
}
mpz_div_2exp (t, t, 1);
if (n < 1UL << (BITS_PER_MP_LIMB / 2))
/* (n - k + 1) * (n + k - 1) < n^2 */
mpz_divexact_ui (t, t, (n - k + 1) * (n + k - 1));
else
{
mpz_divexact_ui (t, t, n - k + 1);
mpz_divexact_ui (t, t, n + k - 1);
}
mpz_add (d, d, t);
}
/* multiply by 1/(1-2^(1-m)) = 1 + 2^(1-m) + 2^(2-m) + ... */
mpz_div_2exp (t, s, m - 1);
do
{
err ++;
mpz_add (s, s, t);
mpz_div_2exp (t, t, m - 1);
}
while (mpz_cmp_ui (t, 0) > 0);
/* divide by d[n] */
mpz_mul_2exp (s, s, p);
mpz_tdiv_q (s, s, d);
mpfr_set_z (y, s, GMP_RNDN);
mpfr_div_2ui (y, y, p, GMP_RNDN);
err = MPFR_INT_CEIL_LOG2 (err);
if (MPFR_LIKELY(MPFR_CAN_ROUND (y, p - err, MPFR_PREC(z), r)))
break;
MPFR_ZIV_NEXT (loop, p);
}
MPFR_ZIV_FREE (loop);
mpz_clear (d);
mpz_clear (t);
mpz_clear (q);
mpz_clear (s);
inex = mpfr_set (z, y, r);
mpfr_clear (y);
return inex;
}
}
static int
mpfr_rem1 (mpfr_ptr rem, long *quo, mp_rnd_t rnd_q,
mpfr_srcptr x, mpfr_srcptr y, mp_rnd_t rnd)
{
mp_exp_t ex, ey;
int compare, inex, q_is_odd, sign, signx = MPFR_SIGN (x);
mpz_t mx, my, r;
MPFR_ASSERTD (rnd_q == GMP_RNDN || rnd_q == GMP_RNDZ);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x)
|| MPFR_IS_ZERO (y))
{
/* for remquo, quo is undefined */
MPFR_SET_NAN (rem);
MPFR_RET_NAN;
}
else /* either y is Inf and x is 0 or non-special,
or x is 0 and y is non-special,
in both cases the quotient is zero. */
{
if (quo)
*quo = 0;
return mpfr_set (rem, x, rnd);
}
}
/* now neither x nor y is NaN, Inf or zero */
mpz_init (mx);
mpz_init (my);
mpz_init (r);
ex = mpfr_get_z_exp (mx, x); /* x = mx*2^ex */
ey = mpfr_get_z_exp (my, y); /* y = my*2^ey */
/* to get rid of sign problems, we compute it separately:
quo(-x,-y) = quo(x,y), rem(-x,-y) = -rem(x,y)
quo(-x,y) = -quo(x,y), rem(-x,y) = -rem(x,y)
thus quo = sign(x/y)*quo(|x|,|y|), rem = sign(x)*rem(|x|,|y|) */
sign = (signx == MPFR_SIGN (y)) ? 1 : -1;
mpz_abs (mx, mx);
mpz_abs (my, my);
q_is_odd = 0;
/* divide my by 2^k if possible to make operations mod my easier */
{
unsigned long k = mpz_scan1 (my, 0);
ey += k;
mpz_div_2exp (my, my, k);
}
if (ex <= ey)
{
/* q = x/y = mx/(my*2^(ey-ex)) */
mpz_mul_2exp (my, my, ey - ex); /* divide mx by my*2^(ey-ex) */
if (rnd_q == GMP_RNDZ)
/* 0 <= |r| <= |my|, r has the same sign as mx */
mpz_tdiv_qr (mx, r, mx, my);
else
/* 0 <= |r| <= |my|, r has the same sign as my */
mpz_fdiv_qr (mx, r, mx, my);
if (rnd_q == GMP_RNDN)
q_is_odd = mpz_tstbit (mx, 0);
if (quo) /* mx is the quotient */
{
mpz_tdiv_r_2exp (mx, mx, WANTED_BITS);
*quo = mpz_get_si (mx);
}
}
else /* ex > ey */
{
if (quo)
/* for remquo, to get the low WANTED_BITS more bits of the quotient,
we first compute R = X mod Y*2^WANTED_BITS, where X and Y are
defined below. Then the low WANTED_BITS of the quotient are
floor(R/Y). */
mpz_mul_2exp (my, my, WANTED_BITS); /* 2^WANTED_BITS*Y */
else
/* Let X = mx*2^(ex-ey) and Y = my. Then both X and Y are integers.
Assume X = R mod Y, then x = X*2^ey = R*2^ey mod (Y*2^ey=y).
To be able to perform the rounding, we need the least significant
bit of the quotient, i.e., one more bit in the remainder,
which is obtained by dividing by 2Y. */
mpz_mul_2exp (my, my, 1); /* 2Y */
mpz_set_ui (r, 2);
mpz_powm_ui (r, r, ex - ey, my); /* 2^(ex-ey) mod my */
mpz_mul (r, r, mx);
mpz_mod (r, r, my);
if (quo) /* now 0 <= r < 2^WANTED_BITS*Y */
{
mpz_div_2exp (my, my, WANTED_BITS); /* back to Y */
mpz_tdiv_qr (mx, r, r, my);
/* oldr = mx*my + newr */
*quo = mpz_get_si (mx);
q_is_odd = *quo & 1;
}
else /* now 0 <= r < 2Y */
{
mpz_div_2exp (my, my, 1); /* back to Y */
if (rnd_q == GMP_RNDN)
{
/* least significant bit of q */
q_is_odd = mpz_cmpabs (r, my) >= 0;
if (q_is_odd)
mpz_sub (r, r, my);
}
}
/* now 0 <= |r| < |my|, and if needed,
q_is_odd is the least significant bit of q */
}
if (mpz_cmp_ui (r, 0) == 0)
inex = mpfr_set_ui (rem, 0, GMP_RNDN);
else
{
if (rnd_q == GMP_RNDN)
{
/* FIXME: the comparison 2*r < my could be done more efficiently
at the mpn level */
mpz_mul_2exp (r, r, 1);
compare = mpz_cmpabs (r, my);
mpz_div_2exp (r, r, 1);
compare = ((compare > 0) ||
((rnd_q == GMP_RNDN) && (compare == 0) && q_is_odd));
/* if compare != 0, we need to subtract my to r, and add 1 to quo */
if (compare)
{
mpz_sub (r, r, my);
if (quo && (rnd_q == GMP_RNDN))
*quo += 1;
}
}
inex = mpfr_set_z (rem, r, rnd);
/* if ex > ey, rem should be multiplied by 2^ey, else by 2^ex */
MPFR_EXP (rem) += (ex > ey) ? ey : ex;
}
if (quo)
*quo *= sign;
/* take into account sign of x */
if (signx < 0)
{
mpfr_neg (rem, rem, GMP_RNDN);
inex = -inex;
}
mpz_clear (mx);
mpz_clear (my);
mpz_clear (r);
return inex;
}
int
mpfr_cbrt (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpz_t m;
mp_exp_t e, r, sh;
mp_prec_t n, size_m, tmp;
int inexact, negative;
MPFR_SAVE_EXPO_DECL (expo);
/* special values */
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_INF (y);
MPFR_SET_SAME_SIGN (y, x);
MPFR_RET (0);
}
/* case 0: cbrt(+/- 0) = +/- 0 */
else /* x is necessarily 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
MPFR_RET (0);
}
}
/* General case */
MPFR_SAVE_EXPO_MARK (expo);
mpz_init (m);
e = mpfr_get_z_exp (m, x); /* x = m * 2^e */
if ((negative = MPFR_IS_NEG(x)))
mpz_neg (m, m);
r = e % 3;
if (r < 0)
r += 3;
/* x = (m*2^r) * 2^(e-r) = (m*2^r) * 2^(3*q) */
MPFR_MPZ_SIZEINBASE2 (size_m, m);
n = MPFR_PREC (y) + (rnd_mode == GMP_RNDN);
/* we want 3*n-2 <= size_m + 3*sh + r <= 3*n
i.e. 3*sh + size_m + r <= 3*n */
sh = (3 * (mp_exp_t) n - (mp_exp_t) size_m - r) / 3;
sh = 3 * sh + r;
if (sh >= 0)
{
mpz_mul_2exp (m, m, sh);
e = e - sh;
}
else if (r > 0)
{
mpz_mul_2exp (m, m, r);
e = e - r;
}
/* invariant: x = m*2^e, with e divisible by 3 */
/* we reuse the variable m to store the cube root, since it is not needed
any more: we just need to know if the root is exact */
inexact = mpz_root (m, m, 3) == 0;
MPFR_MPZ_SIZEINBASE2 (tmp, m);
sh = tmp - n;
if (sh > 0) /* we have to flush to 0 the last sh bits from m */
{
inexact = inexact || ((mp_exp_t) mpz_scan1 (m, 0) < sh);
mpz_div_2exp (m, m, sh);
e += 3 * sh;
}
if (inexact)
{
if (negative)
rnd_mode = MPFR_INVERT_RND (rnd_mode);
if (rnd_mode == GMP_RNDU
|| (rnd_mode == GMP_RNDN && mpz_tstbit (m, 0)))
inexact = 1, mpz_add_ui (m, m, 1);
else
inexact = -1;
}
/* either inexact is not zero, and the conversion is exact, i.e. inexact
is not changed; or inexact=0, and inexact is set only when
rnd_mode=GMP_RNDN and bit (n+1) from m is 1 */
inexact += mpfr_set_z (y, m, GMP_RNDN);
MPFR_SET_EXP (y, MPFR_GET_EXP (y) + e / 3);
if (negative)
{
MPFR_CHANGE_SIGN (y);
inexact = -inexact;
}
mpz_clear (m);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! while MPFR_EXP(r^l/l!)+MPFR_EXPR(r)>-q
using Brent/Kung method with O(sqrt(l)) multiplications.
Return l.
Uses m multiplications of full size and 2l/m of decreasing size,
i.e. a total equivalent to about m+l/m full multiplications,
i.e. 2*sqrt(l) for m=sqrt(l).
Version using mpz. ss must have at least (sizer+1) limbs.
The error is bounded by (l^2+4*l) ulps where l is the return value.
*/
static unsigned long
mpfr_exp2_aux2 (mpz_t s, mpfr_srcptr r, mp_prec_t q, mp_exp_t *exps)
{
mp_exp_t expr, *expR, expt;
mp_size_t sizer;
mp_prec_t ql;
unsigned long l, m, i;
mpz_t t, *R, rr, tmp;
TMP_DECL(marker);
/* estimate value of l */
MPFR_ASSERTD (MPFR_GET_EXP (r) < 0);
l = q / (- MPFR_GET_EXP (r));
m = __gmpfr_isqrt (l);
/* we access R[2], thus we need m >= 2 */
if (m < 2)
m = 2;
TMP_MARK(marker);
R = (mpz_t*) TMP_ALLOC((m+1)*sizeof(mpz_t)); /* R[i] is r^i */
expR = (mp_exp_t*) TMP_ALLOC((m+1)*sizeof(mp_exp_t)); /* exponent for R[i] */
sizer = 1 + (MPFR_PREC(r)-1)/BITS_PER_MP_LIMB;
mpz_init(tmp);
MY_INIT_MPZ(rr, sizer+2);
MY_INIT_MPZ(t, 2*sizer); /* double size for products */
mpz_set_ui(s, 0);
*exps = 1-q; /* 1 ulp = 2^(1-q) */
for (i = 0 ; i <= m ; i++)
MY_INIT_MPZ(R[i], sizer+2);
expR[1] = mpfr_get_z_exp(R[1], r); /* exact operation: no error */
expR[1] = mpz_normalize2(R[1], R[1], expR[1], 1-q); /* error <= 1 ulp */
mpz_mul(t, R[1], R[1]); /* err(t) <= 2 ulps */
mpz_div_2exp(R[2], t, q-1); /* err(R[2]) <= 3 ulps */
expR[2] = 1-q;
for (i = 3 ; i <= m ; i++)
{
mpz_mul(t, R[i-1], R[1]); /* err(t) <= 2*i-2 */
mpz_div_2exp(R[i], t, q-1); /* err(R[i]) <= 2*i-1 ulps */
expR[i] = 1-q;
}
mpz_set_ui (R[0], 1);
mpz_mul_2exp (R[0], R[0], q-1);
expR[0] = 1-q; /* R[0]=1 */
mpz_set_ui (rr, 1);
expr = 0; /* rr contains r^l/l! */
/* by induction: err(rr) <= 2*l ulps */
l = 0;
ql = q; /* precision used for current giant step */
do
{
/* all R[i] must have exponent 1-ql */
if (l != 0)
for (i = 0 ; i < m ; i++)
expR[i] = mpz_normalize2 (R[i], R[i], expR[i], 1-ql);
/* the absolute error on R[i]*rr is still 2*i-1 ulps */
expt = mpz_normalize2 (t, R[m-1], expR[m-1], 1-ql);
/* err(t) <= 2*m-1 ulps */
/* computes t = 1 + r/(l+1) + ... + r^(m-1)*l!/(l+m-1)!
using Horner's scheme */
for (i = m-1 ; i-- != 0 ; )
{
mpz_div_ui(t, t, l+i+1); /* err(t) += 1 ulp */
mpz_add(t, t, R[i]);
}
/* now err(t) <= (3m-2) ulps */
/* now multiplies t by r^l/l! and adds to s */
mpz_mul(t, t, rr);
expt += expr;
expt = mpz_normalize2(t, t, expt, *exps);
/* err(t) <= (3m-1) + err_rr(l) <= (3m-2) + 2*l */
MPFR_ASSERTD (expt == *exps);
mpz_add(s, s, t); /* no error here */
/* updates rr, the multiplication of the factors l+i could be done
using binary splitting too, but it is not sure it would save much */
mpz_mul(t, rr, R[m]); /* err(t) <= err(rr) + 2m-1 */
expr += expR[m];
mpz_set_ui (tmp, 1);
for (i = 1 ; i <= m ; i++)
mpz_mul_ui (tmp, tmp, l + i);
mpz_fdiv_q(t, t, tmp); /* err(t) <= err(rr) + 2m */
expr += mpz_normalize(rr, t, ql); /* err_rr(l+1) <= err_rr(l) + 2m+1 */
ql = q - *exps - mpz_sizeinbase(s, 2) + expr + mpz_sizeinbase(rr, 2);
l += m;
}
while ((size_t) expr+mpz_sizeinbase(rr, 2) > (size_t)((int)-q));
TMP_FREE(marker);
mpz_clear(tmp);
return l;
}
void
mpz_bin_ui (mpz_ptr r, mpz_srcptr n, unsigned long int k)
{
mpz_t ni;
mp_limb_t i;
mpz_t nacc;
mp_limb_t kacc;
mp_size_t negate;
if (mpz_sgn (n) < 0)
{
/* bin(n,k) = (-1)^k * bin(-n+k-1,k), and set ni = -n+k-1 - k = -n-1 */
mpz_init (ni);
mpz_neg (ni, n);
mpz_sub_ui (ni, ni, 1L);
negate = (k & 1); /* (-1)^k */
}
else
{
/* bin(n,k) == 0 if k>n
(no test for this under the n<0 case, since -n+k-1 >= k there) */
if (mpz_cmp_ui (n, k) < 0)
{
mpz_set_ui (r, 0L);
return;
}
/* set ni = n-k */
mpz_init (ni);
mpz_sub_ui (ni, n, k);
negate = 0;
}
/* Now wanting bin(ni+k,k), with ni positive, and "negate" is the sign (0
for positive, 1 for negative). */
mpz_set_ui (r, 1L);
/* Rewrite bin(n,k) as bin(n,n-k) if that is smaller. In this case it's
whether ni+k-k < k meaning ni<k, and if so change to denominator ni+k-k
= ni, and new ni of ni+k-ni = k. */
if (mpz_cmp_ui (ni, k) < 0)
{
unsigned long tmp;
tmp = k;
k = mpz_get_ui (ni);
mpz_set_ui (ni, tmp);
}
kacc = 1;
mpz_init_set_ui (nacc, 1L);
for (i = 1; i <= k; i++)
{
mp_limb_t k1, k0;
#if 0
mp_limb_t nacclow;
int c;
nacclow = PTR(nacc)[0];
for (c = 0; (((kacc | nacclow) & 1) == 0); c++)
{
kacc >>= 1;
nacclow >>= 1;
}
mpz_div_2exp (nacc, nacc, c);
#endif
mpz_add_ui (ni, ni, 1L);
mpz_mul (nacc, nacc, ni);
umul_ppmm (k1, k0, kacc, i << GMP_NAIL_BITS);
k0 >>= GMP_NAIL_BITS;
if (k1 != 0)
{
/* Accumulator overflow. Perform bignum step. */
mpz_mul (r, r, nacc);
mpz_set_ui (nacc, 1L);
DIVIDE ();
kacc = i;
}
else
{
/* Save new products in accumulators to keep accumulating. */
kacc = k0;
}
}
mpz_mul (r, r, nacc);
DIVIDE ();
SIZ(r) = (SIZ(r) ^ -negate) + negate;
mpz_clear (nacc);
mpz_clear (ni);
}
/* y <- exp(p/2^r) within 1 ulp, using 2^m terms from the series
Assume |p/2^r| < 1.
We use the following binary splitting formula:
P(a,b) = p if a+1=b, P(a,c)*P(c,b) otherwise
Q(a,b) = a*2^r if a+1=b [except Q(0,1)=1], Q(a,c)*Q(c,b) otherwise
T(a,b) = P(a,b) if a+1=b, Q(c,b)*T(a,c)+P(a,c)*T(c,b) otherwise
Then exp(p/2^r) ~ T(0,i)/Q(0,i) for i so that (p/2^r)^i/i! is small enough.
Since P(a,b) = p^(b-a), and we consider only values of b-a of the form 2^j,
we don't need to compute P(), we only precompute p^(2^j) in the ptoj[] array
below.
Since Q(a,b) is divisible by 2^(r*(b-a-1)), we don't compute the power of
two part.
*/
static void
mpfr_exp_rational (mpfr_ptr y, mpz_ptr p, long r, int m,
mpz_t *Q, mp_prec_t *mult)
{
unsigned long n, i, j;
mpz_t *S, *ptoj;
mp_prec_t *log2_nb_terms;
mp_exp_t diff, expo;
mp_prec_t precy = MPFR_PREC(y), prec_i_have, prec_ptoj;
int k, l;
MPFR_ASSERTN ((size_t) m < sizeof (long) * CHAR_BIT - 1);
S = Q + (m+1);
ptoj = Q + 2*(m+1); /* ptoj[i] = mantissa^(2^i) */
log2_nb_terms = mult + (m+1);
/* Normalize p */
MPFR_ASSERTD (mpz_cmp_ui (p, 0) != 0);
n = mpz_scan1 (p, 0); /* number of trailing zeros in p */
mpz_tdiv_q_2exp (p, p, n);
r -= n; /* since |p/2^r| < 1 and p >= 1, r >= 1 */
/* Set initial var */
mpz_set (ptoj[0], p);
for (k = 1; k < m; k++)
mpz_mul (ptoj[k], ptoj[k-1], ptoj[k-1]); /* ptoj[k] = p^(2^k) */
mpz_set_ui (Q[0], 1);
mpz_set_ui (S[0], 1);
k = 0;
mult[0] = 0; /* the multiplier P[k]/Q[k] for the remaining terms
satisfies P[k]/Q[k] <= 2^(-mult[k]) */
log2_nb_terms[0] = 0; /* log2(#terms) [exact in 1st loop where 2^k] */
prec_i_have = 0;
/* Main Loop */
n = 1UL << m;
for (i = 1; (prec_i_have < precy) && (i < n); i++)
{
/* invariant: Q[0]*Q[1]*...*Q[k] equals i! */
k++;
log2_nb_terms[k] = 0; /* 1 term */
mpz_set_ui (Q[k], i + 1);
mpz_set_ui (S[k], i + 1);
j = i + 1; /* we have computed j = i+1 terms so far */
l = 0;
while ((j & 1) == 0) /* combine and reduce */
{
/* invariant: S[k] corresponds to 2^l consecutive terms */
mpz_mul (S[k], S[k], ptoj[l]);
mpz_mul (S[k-1], S[k-1], Q[k]);
/* Q[k] corresponds to 2^l consecutive terms too.
Since it does not contains the factor 2^(r*2^l),
when going from l to l+1 we need to multiply
by 2^(r*2^(l+1))/2^(r*2^l) = 2^(r*2^l) */
mpz_mul_2exp (S[k-1], S[k-1], r << l);
mpz_add (S[k-1], S[k-1], S[k]);
mpz_mul (Q[k-1], Q[k-1], Q[k]);
log2_nb_terms[k-1] ++; /* number of terms in S[k-1]
is a power of 2 by construction */
MPFR_MPZ_SIZEINBASE2 (prec_i_have, Q[k]);
MPFR_MPZ_SIZEINBASE2 (prec_ptoj, ptoj[l]);
mult[k-1] += prec_i_have + (r << l) - prec_ptoj - 1;
prec_i_have = mult[k] = mult[k-1];
/* since mult[k] >= mult[k-1] + nbits(Q[k]),
we have Q[0]*...*Q[k] <= 2^mult[k] = 2^prec_i_have */
l ++;
j >>= 1;
k --;
}
}
/* accumulate all products in S[0] and Q[0]. Warning: contrary to above,
here we do not have log2_nb_terms[k-1] = log2_nb_terms[k]+1. */
l = 0; /* number of accumulated terms in the right part S[k]/Q[k] */
while (k > 0)
{
j = log2_nb_terms[k-1];
mpz_mul (S[k], S[k], ptoj[j]);
mpz_mul (S[k-1], S[k-1], Q[k]);
l += 1 << log2_nb_terms[k];
mpz_mul_2exp (S[k-1], S[k-1], r * l);
mpz_add (S[k-1], S[k-1], S[k]);
mpz_mul (Q[k-1], Q[k-1], Q[k]);
k--;
}
/* Q[0] now equals i! */
MPFR_MPZ_SIZEINBASE2 (prec_i_have, S[0]);
diff = (mp_exp_t) prec_i_have - 2 * (mp_exp_t) precy;
expo = diff;
if (diff >= 0)
mpz_div_2exp (S[0], S[0], diff);
else
mpz_mul_2exp (S[0], S[0], -diff);
MPFR_MPZ_SIZEINBASE2 (prec_i_have, Q[0]);
diff = (mp_exp_t) prec_i_have - (mp_prec_t) precy;
expo -= diff;
if (diff > 0)
mpz_div_2exp (Q[0], Q[0], diff);
else
mpz_mul_2exp (Q[0], Q[0], -diff);
mpz_tdiv_q (S[0], S[0], Q[0]);
mpfr_set_z (y, S[0], GMP_RNDD);
MPFR_SET_EXP (y, MPFR_GET_EXP (y) + expo - r * (i - 1) );
}
void gmpint_rshift(mpz_t *rop, mpz_t *op, mp_bitcnt_t bits) {
mpz_div_2exp(*rop, *op, bits);
}
/* Compute the first 2^m terms from the hypergeometric series
with x = p / 2^r */
static int
GENERIC (mpfr_ptr y, mpz_srcptr p, long r, int m)
{
unsigned long n,i,k,j,l;
int is_p_one;
mpz_t* P,*S;
#ifdef A
mpz_t *T;
#endif
mpz_t* ptoj;
#ifdef R_IS_RATIONAL
mpz_t* qtoj;
mpfr_t tmp;
#endif
mp_exp_t diff, expo;
mp_prec_t precy = MPFR_PREC(y);
MPFR_TMP_DECL(marker);
MPFR_TMP_MARK(marker);
MPFR_CLEAR_FLAGS(y);
n = 1UL << m;
P = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
S = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
ptoj = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t)); /* ptoj[i] = mantissa^(2^i) */
#ifdef A
T = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
#endif
#ifdef R_IS_RATIONAL
qtoj = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
#endif
for (i = 0 ; i <= m ; i++)
{
mpz_init (P[i]);
mpz_init (S[i]);
mpz_init (ptoj[i]);
#ifdef R_IS_RATIONAL
mpz_init (qtoj[i]);
#endif
#ifdef A
mpz_init (T[i]);
#endif
}
mpz_set (ptoj[0], p);
#ifdef C
# if C2 != 1
mpz_mul_ui (ptoj[0], ptoj[0], C2);
# endif
#endif
is_p_one = mpz_cmp_ui(ptoj[0], 1) == 0;
#ifdef A
# ifdef B
mpz_set_ui (T[0], A1 * B1);
# else
mpz_set_ui (T[0], A1);
# endif
#endif
if (!is_p_one)
for (i = 1 ; i < m ; i++)
mpz_mul (ptoj[i], ptoj[i-1], ptoj[i-1]);
#ifdef R_IS_RATIONAL
mpz_set_si (qtoj[0], r);
for (i = 1 ; i <= m ; i++)
mpz_mul(qtoj[i], qtoj[i-1], qtoj[i-1]);
#endif
mpz_set_ui (P[0], 1);
mpz_set_ui (S[0], 1);
k = 0;
for (i = 1 ; i < n ; i++) {
k++;
#ifdef A
# ifdef B
mpz_set_ui (T[k], (A1 + A2*i)*(B1+B2*i));
# else
mpz_set_ui (T[k], A1 + A2*i);
# endif
#endif
#ifdef C
# ifdef NO_FACTORIAL
mpz_set_ui (P[k], (C1 + C2 * (i-1)));
mpz_set_ui (S[k], 1);
# else
mpz_set_ui (P[k], (i+1) * (C1 + C2 * (i-1)));
mpz_set_ui (S[k], i+1);
# endif
#else
# ifdef NO_FACTORIAL
mpz_set_ui (P[k], 1);
# else
mpz_set_ui (P[k], i+1);
# endif
mpz_set (S[k], P[k]);
#endif
for (j = i+1, l = 0 ; (j & 1) == 0 ; l++, j>>=1, k--) {
if (!is_p_one)
mpz_mul (S[k], S[k], ptoj[l]);
#ifdef A
# ifdef B
# if (A2*B2) != 1
mpz_mul_ui (P[k], P[k], A2*B2);
# endif
# else
# if A2 != 1
mpz_mul_ui (P[k], P[k], A2);
# endif
#endif
mpz_mul (S[k], S[k], T[k-1]);
#endif
mpz_mul (S[k-1], S[k-1], P[k]);
#ifdef R_IS_RATIONAL
mpz_mul (S[k-1], S[k-1], qtoj[l]);
#else
mpz_mul_2exp (S[k-1], S[k-1], r*(1<<l));
#endif
mpz_add (S[k-1], S[k-1], S[k]);
mpz_mul (P[k-1], P[k-1], P[k]);
#ifdef A
mpz_mul (T[k-1], T[k-1], T[k]);
#endif
}
}
diff = mpz_sizeinbase(S[0],2) - 2*precy;
expo = diff;
if (diff >= 0)
mpz_div_2exp(S[0],S[0],diff);
else
mpz_mul_2exp(S[0],S[0],-diff);
diff = mpz_sizeinbase(P[0],2) - precy;
expo -= diff;
if (diff >=0)
mpz_div_2exp(P[0],P[0],diff);
else
mpz_mul_2exp(P[0],P[0],-diff);
mpz_tdiv_q(S[0], S[0], P[0]);
mpfr_set_z(y, S[0], GMP_RNDD);
MPFR_SET_EXP (y, MPFR_GET_EXP (y) + expo);
#ifdef R_IS_RATIONAL
/* exact division */
mpz_div_ui (qtoj[m], qtoj[m], r);
mpfr_init2 (tmp, MPFR_PREC(y));
mpfr_set_z (tmp, qtoj[m] , GMP_RNDD);
mpfr_div (y, y, tmp, GMP_RNDD);
mpfr_clear (tmp);
#else
mpfr_div_2ui(y, y, r*(i-1), GMP_RNDN);
#endif
for (i = 0 ; i <= m ; i++)
{
mpz_clear (P[i]);
mpz_clear (S[i]);
mpz_clear (ptoj[i]);
#ifdef R_IS_RATIONAL
mpz_clear (qtoj[i]);
#endif
#ifdef A
mpz_clear (T[i]);
#endif
}
MPFR_TMP_FREE (marker);
return 0;
}
