static void
check_nans (void)
{
mpfr_t x, y;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
/* nan + 2394875 == nan */
mpfr_set_nan (x);
mpfr_add_ui (y, x, 2394875L, GMP_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y));
/* +inf + 2394875 == +inf */
mpfr_set_inf (x, 1);
mpfr_add_ui (y, x, 2394875L, GMP_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) > 0);
/* -inf + 2394875 == -inf */
mpfr_set_inf (x, -1);
mpfr_add_ui (y, x, 2394875L, GMP_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
mpfr_clear (x);
mpfr_clear (y);
}
static void check_intmax (void)
{
#ifdef _MPFR_H_HAVE_INTMAX_T
mpfr_t x;
mpfr_init2 (x, sizeof(uintmax_t)*CHAR_BIT);
/* Check NAN */
mpfr_set_nan(x);
if (mpfr_fits_uintmax_p(x, GMP_RNDN))
ERROR1;
if (mpfr_fits_intmax_p(x, GMP_RNDN))
ERROR1;
/* Check INF */
mpfr_set_inf(x, 1);
if (mpfr_fits_uintmax_p(x, GMP_RNDN))
ERROR1;
if (mpfr_fits_intmax_p(x, GMP_RNDN))
ERROR1;
/* Check Zero */
MPFR_SET_ZERO(x);
if (!mpfr_fits_uintmax_p(x, GMP_RNDN))
ERROR2;
if (!mpfr_fits_intmax_p(x, GMP_RNDN))
ERROR2;
/* Check small op */
mpfr_set_str1 (x, "1@-1");
if (!mpfr_fits_uintmax_p(x, GMP_RNDN))
ERROR2;
if (!mpfr_fits_intmax_p(x, GMP_RNDN))
ERROR2;
/* Check all other values */
mpfr_set_uj (x, UINTMAX_MAX, GMP_RNDN);
mpfr_add_ui (x, x, 1, GMP_RNDN);
if (mpfr_fits_uintmax_p (x, GMP_RNDN))
ERROR1;
mpfr_set_uj (x, UINTMAX_MAX, GMP_RNDN);
if (!mpfr_fits_uintmax_p (x, GMP_RNDN))
ERROR2;
mpfr_set_sj (x, INTMAX_MAX, GMP_RNDN);
mpfr_add_ui (x, x, 1, GMP_RNDN);
if (mpfr_fits_intmax_p (x, GMP_RNDN))
ERROR1;
mpfr_set_sj (x, INTMAX_MAX, GMP_RNDN);
if (!mpfr_fits_intmax_p (x, GMP_RNDN))
ERROR2;
mpfr_set_sj (x, INTMAX_MIN, GMP_RNDN);
if (!mpfr_fits_intmax_p (x, GMP_RNDN))
ERROR2;
mpfr_sub_ui (x, x, 1, GMP_RNDN);
if (mpfr_fits_intmax_p (x, GMP_RNDN))
ERROR1;
mpfr_clear (x);
#endif
}
/* check case when c does not overlap with a, but both b and c count
for rounding */
static void
check_case_1b (void)
{
mpfr_t a, b, c;
unsigned int prec_a, prec_b, prec_c, dif;
mpfr_init (a);
mpfr_init (b);
mpfr_init (c);
{
prec_a = MPFR_PREC_MIN + (randlimb () % 63);
mpfr_set_prec (a, prec_a);
for (prec_b = prec_a + 2; prec_b <= 64; prec_b++)
{
dif = prec_b - prec_a;
mpfr_set_prec (b, prec_b);
/* b = 1 - 2^(-prec_a) + 2^(-prec_b) */
mpfr_set_ui (b, 1, MPFR_RNDN);
mpfr_div_2exp (b, b, dif, MPFR_RNDN);
mpfr_sub_ui (b, b, 1, MPFR_RNDN);
mpfr_div_2exp (b, b, prec_a, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
for (prec_c = dif; prec_c <= 64; prec_c++)
{
/* c = 2^(-prec_a) - 2^(-prec_b) */
mpfr_set_prec (c, prec_c);
mpfr_set_si (c, -1, MPFR_RNDN);
mpfr_div_2exp (c, c, dif, MPFR_RNDN);
mpfr_add_ui (c, c, 1, MPFR_RNDN);
mpfr_div_2exp (c, c, prec_a, MPFR_RNDN);
test_add (a, b, c, MPFR_RNDN);
if (mpfr_cmp_ui (a, 1) != 0)
{
printf ("case (1b) failed for prec_a=%u, prec_b=%u,"
" prec_c=%u\n", prec_a, prec_b, prec_c);
printf ("b=");
mpfr_print_binary(b);
puts ("");
printf ("c=");
mpfr_print_binary(c);
puts ("");
printf ("a=");
mpfr_print_binary(a);
puts ("");
exit (1);
}
}
}
}
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
}
/* check case when c does not overlap with a, but both b and c count
for rounding */
void
check_case_1b (void)
{
mpfr_t a, b, c;
unsigned int prec_a, prec_b, prec_c, dif;
mpfr_init (a);
mpfr_init (b);
mpfr_init (c);
for (prec_a = 2; prec_a <= 64; prec_a++)
{
mpfr_set_prec (a, prec_a);
for (prec_b = prec_a + 2; prec_b <= 64; prec_b++)
{
dif = prec_b - prec_a;
mpfr_set_prec (b, prec_b);
/* b = 1 - 2^(-prec_a) + 2^(-prec_b) */
mpfr_set_ui (b, 1, GMP_RNDN);
mpfr_div_2exp (b, b, dif, GMP_RNDN);
mpfr_sub_ui (b, b, 1, GMP_RNDN);
mpfr_div_2exp (b, b, prec_a, GMP_RNDN);
mpfr_add_ui (b, b, 1, GMP_RNDN);
for (prec_c = dif; prec_c <= 64; prec_c++)
{
/* c = 2^(-prec_a) - 2^(-prec_b) */
mpfr_set_prec (c, prec_c);
mpfr_set_si (c, -1, GMP_RNDN);
mpfr_div_2exp (c, c, dif, GMP_RNDN);
mpfr_add_ui (c, c, 1, GMP_RNDN);
mpfr_div_2exp (c, c, prec_a, GMP_RNDN);
mpfr_add (a, b, c, GMP_RNDN);
if (mpfr_cmp_ui (a, 1) != 0)
{
fprintf (stderr, "case (1b) failed for prec_a=%u, prec_b=%u, prec_c=%u\n", prec_a, prec_b, prec_c);
printf("b="); mpfr_print_binary(b); putchar('\n');
printf("c="); mpfr_print_binary(c); putchar('\n');
printf("a="); mpfr_print_binary(a); putchar('\n');
exit (1);
}
}
}
}
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
}
/* Bug found by Jakub Jelinek
* http://bugzilla.redhat.com/643657
* https://gforge.inria.fr/tracker/index.php?func=detail&aid=11301
* The consequence can be either an assertion failure (i = 2 in the
* testcase below, in debug mode) or an incorrectly rounded value.
*/
static void
bug20101017 (void)
{
mpfr_t a, b, c;
int inex;
int i;
mpfr_init2 (a, GMP_NUMB_BITS * 2);
mpfr_init2 (b, GMP_NUMB_BITS);
mpfr_init2 (c, GMP_NUMB_BITS);
/* a = 2^(2N) + k.2^(2N-1) + 2^N and b = 1
with N = GMP_NUMB_BITS and k = 0 or 1.
c = a - b should round to the same value as a. */
for (i = 2; i <= 3; i++)
{
mpfr_set_ui_2exp (a, i, GMP_NUMB_BITS - 1, MPFR_RNDN);
mpfr_add_ui (a, a, 1, MPFR_RNDN);
mpfr_mul_2ui (a, a, GMP_NUMB_BITS, MPFR_RNDN);
mpfr_set_ui (b, 1, MPFR_RNDN);
inex = mpfr_sub (c, a, b, MPFR_RNDN);
mpfr_set (b, a, MPFR_RNDN);
if (! mpfr_equal_p (c, b))
{
printf ("Error in bug20101017 for i = %d.\n", i);
printf ("Expected ");
mpfr_out_str (stdout, 16, 0, b, MPFR_RNDN);
putchar ('\n');
printf ("Got ");
mpfr_out_str (stdout, 16, 0, c, MPFR_RNDN);
putchar ('\n');
exit (1);
}
if (inex >= 0)
{
printf ("Error in bug20101017 for i = %d: bad inex value.\n", i);
printf ("Expected negative, got %d.\n", inex);
exit (1);
}
}
mpfr_set_prec (a, 64);
mpfr_set_prec (b, 129);
mpfr_set_prec (c, 2);
mpfr_set_str_binary (b, "0.100000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000001E65");
mpfr_set_str_binary (c, "0.10E1");
inex = mpfr_sub (a, b, c, MPFR_RNDN);
if (mpfr_cmp_ui_2exp (a, 1, 64) != 0 || inex >= 0)
{
printf ("Error in mpfr_sub for b-c for b=2^64+1+2^(-64), c=1\n");
printf ("Expected result 2^64 with inex < 0\n");
printf ("Got ");
mpfr_print_binary (a);
printf (" with inex=%d\n", inex);
exit (1);
}
mpfr_clears (a, b, c, (mpfr_ptr) 0);
}
/* 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);
}
mpfr_t* compute_rho_to_z_matrix(unsigned long Lambda_arg, long prec){
/* To avoid writing lambda + 1 so many times...*/
unsigned long Lambda=Lambda_arg+1;
mpfr_t* temps=malloc(sizeof(mpfr_t)*(Lambda));
mpfr_init2(temps[0],prec);
mpfr_set_ui(temps[0],8,MPFR_RNDN);
mpfr_sqrt(temps[0],temps[0],MPFR_RNDN);
mpfr_neg(temps[0],temps[0],MPFR_RNDN);
for(unsigned long j=1;j<Lambda;j++){
mpfr_init2(temps[j],prec);
mpfr_mul_si(temps[j],temps[j-1],2*j-3,MPFR_RNDN);
mpfr_div_ui(temps[j],temps[j],j,MPFR_RNDN);
}
mpfr_sub_ui(temps[1],temps[1],2,MPFR_RNDN);
mpfr_add_ui(temps[0],temps[0],3,MPFR_RNDN);
mpfr_t temp;
mpfr_init2(temp,prec);
mpfr_t temp2;
mpfr_init2(temp2,prec);
mpfr_t* result=malloc(sizeof(mpfr_t)*(Lambda)*(Lambda));
mpfr_init2(result[0],prec);
mpfr_set_ui(result[0],1,MPFR_RNDN);
for(unsigned long j=1; j<(Lambda*Lambda); j++){
mpfr_init2(result[j],prec);
mpfr_set_zero(result[j],1);
}
for(unsigned long j=1;j<Lambda;j++){
mpfr_set_ui(temp,1,MPFR_RNDN);
for(unsigned long k=0;k<=j;k++){
mpfr_mul(temp2,temps[j-k],temp,MPFR_RNDN);
mpfr_add(result[j+Lambda],result[j+Lambda],temp2,MPFR_RNDN);
mpfr_mul_si(temp,temp,-2,MPFR_RNDN);
}
}
for(unsigned long i=2;i<Lambda;i++){
for(unsigned long j=1;j<Lambda;j++){
for(unsigned long k=i-1;k<Lambda-j;k++){
mpfr_mul(temp,result[Lambda*(i-1)+k],result[j+Lambda],MPFR_RNDN);
mpfr_add(result[Lambda*i+k+j],result[Lambda*i+k+j],temp,MPFR_RNDN);
}
}
}
/* transposition */
for(unsigned long i=0;i<Lambda;i++){
for(unsigned long j=0;j<i;j++){
mpfr_swap(result[i+Lambda*j],result[j+Lambda*i]);
}
}
for(unsigned long j=0;j<Lambda;j++){
mpfr_clear(temps[j]);
}
free(temps);
mpfr_clear(temp);
mpfr_clear(temp2);
return result;
}
int
mpfr_sub_si (mpfr_ptr y, mpfr_srcptr x, long int u, mpfr_rnd_t rnd_mode)
{
if (u >= 0)
return mpfr_sub_ui (y, x, u, rnd_mode);
else
return mpfr_add_ui (y, x, -u, rnd_mode);
}
/*
Parameters:
s - the input floating-point number
n, p - parameters from the algorithm
tc - an array of p floating-point numbers tc[1]..tc[p]
Output:
b is the result, i.e.
sum(tc[i]*product((s+2j)*(s+2j-1)/n^2,j=1..i-1), i=1..p)*s*n^(-s-1)
*/
static void
mpfr_zeta_part_b (mpfr_t b, mpfr_srcptr s, int n, int p, mpfr_t *tc)
{
mpfr_t s1, d, u;
unsigned long n2;
int l, t;
MPFR_GROUP_DECL (group);
if (p == 0)
{
MPFR_SET_ZERO (b);
MPFR_SET_POS (b);
return;
}
n2 = n * n;
MPFR_GROUP_INIT_3 (group, MPFR_PREC (b), s1, d, u);
/* t equals 2p-2, 2p-3, ... ; s1 equals s+t */
t = 2 * p - 2;
mpfr_set (d, tc[p], GMP_RNDN);
for (l = 1; l < p; l++)
{
mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l) */
mpfr_mul (d, d, s1, GMP_RNDN);
t = t - 1;
mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l-1) */
mpfr_mul (d, d, s1, GMP_RNDN);
t = t - 1;
mpfr_div_ui (d, d, n2, GMP_RNDN);
mpfr_add (d, d, tc[p-l], GMP_RNDN);
/* since s is positive and the tc[i] have alternate signs,
the following is unlikely */
if (MPFR_UNLIKELY (mpfr_cmpabs (d, tc[p-l]) > 0))
mpfr_set (d, tc[p-l], GMP_RNDN);
}
mpfr_mul (d, d, s, GMP_RNDN);
mpfr_add (s1, s, __gmpfr_one, GMP_RNDN);
mpfr_neg (s1, s1, GMP_RNDN);
mpfr_ui_pow (u, n, s1, GMP_RNDN);
mpfr_mul (b, d, u, GMP_RNDN);
MPFR_GROUP_CLEAR (group);
}
/* return 0 iff both the real and imaginary parts are exact */
int
mpc_add_ui (mpc_ptr a, mpc_srcptr b, unsigned long int c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_add_ui (mpc_realref(a), mpc_realref(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(a), mpc_imagref(b), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
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);
}
/* Return in y an approximation of Ei(x) using the asymptotic expansion:
Ei(x) = exp(x)/x * (1 + 1/x + 2/x^2 + ... + k!/x^k + ...)
Assumes x >= PREC(y) * log(2).
Returns the error bound in terms of ulp(y).
*/
static mp_exp_t
mpfr_eint_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mp_prec_t p = MPFR_PREC(y);
mpfr_t invx, t, err;
unsigned long k;
mp_exp_t err_exp;
mpfr_init2 (t, p);
mpfr_init2 (invx, p);
mpfr_init2 (err, 31); /* error in ulps on y */
mpfr_ui_div (invx, 1, x, GMP_RNDN); /* invx = 1/x*(1+u) with |u|<=2^(1-p) */
mpfr_set_ui (t, 1, GMP_RNDN); /* exact */
mpfr_set (y, t, GMP_RNDN);
mpfr_set_ui (err, 0, GMP_RNDN);
for (k = 1; MPFR_GET_EXP(t) + (mp_exp_t) p > MPFR_GET_EXP(y); k++)
{
mpfr_mul (t, t, invx, GMP_RNDN); /* 2 more roundings */
mpfr_mul_ui (t, t, k, GMP_RNDN); /* 1 more rounding: t = k!/x^k*(1+u)^e
with u=2^{-p} and |e| <= 3*k */
/* we use the fact that |(1+u)^n-1| <= 2*|n*u| for |n*u| <= 1, thus
the error on t is less than 6*k*2^{-p}*t <= 6*k*ulp(t) */
/* err is in terms of ulp(y): transform it in terms of ulp(t) */
mpfr_mul_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add_ui (err, err, 6 * k, GMP_RNDU);
/* transform back in terms of ulp(y) */
mpfr_div_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add (y, y, t, GMP_RNDN);
}
/* add the truncation error bounded by ulp(y): 1 ulp */
mpfr_mul (y, y, invx, GMP_RNDN); /* err <= 2*err + 3/2 */
mpfr_exp (t, x, GMP_RNDN); /* err(t) <= 1/2*ulp(t) */
mpfr_mul (y, y, t, GMP_RNDN); /* again: err <= 2*err + 3/2 */
mpfr_mul_2ui (err, err, 2, GMP_RNDU);
mpfr_add_ui (err, err, 8, GMP_RNDU);
err_exp = MPFR_GET_EXP(err);
mpfr_clear (t);
mpfr_clear (invx);
mpfr_clear (err);
return err_exp;
}
static void
special (void)
{
mpfr_t x, y;
mpfr_init2 (x, 63);
mpfr_init2 (y, 63);
mpfr_set_str_binary (x, "0.110100000000000001110001110010111111000000000101100011100100011");
mpfr_add_ui (y, x, 1, GMP_RNDD);
mpfr_clear (x);
mpfr_clear (y);
}
int
mpfr_si_sub (mpfr_ptr y, long int u, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
if (u >= 0)
return mpfr_ui_sub (y, u, x, rnd_mode);
else
{
int res = -mpfr_add_ui (y, x, -u, MPFR_INVERT_RND (rnd_mode));
MPFR_CHANGE_SIGN (y);
return res;
}
}
/* return add = 1 + floor(log(c^3*(13+m1))/log(2))
where c = (1+eps)*(1+eps*max(8,m1)),
m1 = 1 + max(1/eps,2*sd)*(1+eps),
eps = 2^(-precz-14)
sd = abs(s-1)
*/
static long
compute_add (mpfr_srcptr s, mpfr_prec_t precz)
{
mpfr_t t, u, m1;
long add;
mpfr_inits2 (64, t, u, m1, (mpfr_ptr) 0);
if (mpfr_cmp_ui (s, 1) >= 0)
mpfr_sub_ui (t, s, 1, MPFR_RNDU);
else
mpfr_ui_sub (t, 1, s, MPFR_RNDU);
/* now t = sd = abs(s-1), rounded up */
mpfr_set_ui_2exp (u, 1, - precz - 14, MPFR_RNDU);
/* u = eps */
/* since 1/eps = 2^(precz+14), if EXP(sd) >= precz+14, then
sd >= 1/2*2^(precz+14) thus 2*sd >= 2^(precz+14) >= 1/eps */
if (mpfr_get_exp (t) >= precz + 14)
mpfr_mul_2exp (t, t, 1, MPFR_RNDU);
else
mpfr_set_ui_2exp (t, 1, precz + 14, MPFR_RNDU);
/* now t = max(1/eps,2*sd) */
mpfr_add_ui (u, u, 1, MPFR_RNDU); /* u = 1+eps, rounded up */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = max(1/eps,2*sd)*(1+eps) */
mpfr_add_ui (m1, t, 1, MPFR_RNDU);
if (mpfr_get_exp (m1) <= 3)
mpfr_set_ui (t, 8, MPFR_RNDU);
else
mpfr_set (t, m1, MPFR_RNDU);
/* now t = max(8,m1) */
mpfr_div_2exp (t, t, precz + 14, MPFR_RNDU); /* eps*max(8,m1) */
mpfr_add_ui (t, t, 1, MPFR_RNDU); /* 1+eps*max(8,m1) */
mpfr_mul (t, t, u, MPFR_RNDU); /* t = c */
mpfr_add_ui (u, m1, 13, MPFR_RNDU); /* 13+m1 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c*(13+m1) */
mpfr_sqr (t, t, MPFR_RNDU); /* c^2 */
mpfr_mul (u, u, t, MPFR_RNDU); /* c^3*(13+m1) */
add = mpfr_get_exp (u);
mpfr_clears (t, u, m1, (mpfr_ptr) 0);
return add;
}
int
main (int argc, char *argv[])
{
unsigned long N = atoi (argv[1]), M;
mp_prec_t p;
mpfr_t i, j;
char *lo;
mp_exp_t exp_lo;
int st, st0;
fprintf (stderr, "Using GMP %s and MPFR %s\n", gmp_version, mpfr_version);
st = cputime ();
mpfr_init (i);
mpfr_init (j);
M = N;
do
{
M += 10;
mpfr_set_prec (i, 32);
mpfr_set_d (i, LOG2_10, GMP_RNDU);
mpfr_mul_ui (i, i, M, GMP_RNDU);
mpfr_add_ui (i, i, 3, GMP_RNDU);
p = mpfr_get_ui (i, GMP_RNDU);
fprintf (stderr, "Setting precision to %lu\n", p);
mpfr_set_prec (j, 2);
mpfr_set_prec (i, p);
mpfr_set_ui (j, 1, GMP_RNDN);
mpfr_exp (i, j, GMP_RNDN); /* i = exp(1) */
mpfr_set_prec (j, p);
mpfr_const_pi (j, GMP_RNDN);
mpfr_div (i, i, j, GMP_RNDN);
mpfr_sqrt (i, i, GMP_RNDN);
st0 = cputime ();
lo = mpfr_get_str (NULL, &exp_lo, 10, M, i, GMP_RNDN);
st0 = cputime () - st0;
}
while (can_round (lo, N, M) == 0);
lo[N] = '\0';
printf ("%s\n", lo);
mpfr_clear (i);
mpfr_clear (j);
fprintf (stderr, "Cputime: %dms (output %dms)\n", cputime () - st, st0);
return 0;
}
static void
pow_int (mpfr_rnd_t rnd)
{
mpfr_t ref1, ref2, ref3;
mpfr_t res1;
int i;
#ifdef DEBUG
printf("pow_int\n");
#endif
mpfr_inits2 ((randlimb () % 200) + MPFR_PREC_MIN,
ref1, ref2, res1, (mpfr_ptr) 0);
mpfr_init2 (ref3, 1005);
for (i = 0; i <= 15; i++)
{
mpfr_urandomb (ref2, RANDS);
if (i & 1)
mpfr_neg (ref2, ref2, MPFR_RNDN);
mpfr_set_ui (ref3, 20, MPFR_RNDN);
/* We need to test huge integers because different algorithms/codes
are used for not-too-large integers (mpfr_pow_z) and for general
cases, in particular huge integers (mpfr_pow_general). [r7606] */
if (i & 2)
mpfr_mul_2ui (ref3, ref3, 1000, MPFR_RNDN);
if (i & 4)
mpfr_add_ui (ref3, ref3, 1, MPFR_RNDN); /* odd integer */
/* reference call: pow(a, b, c) */
mpfr_pow (ref1, ref2, ref3, rnd);
/* pow(a, a, c) */
mpfr_set (res1, ref2, rnd); /* exact operation */
mpfr_pow (res1, res1, ref3, rnd);
if (mpfr_compare (res1, ref1))
{
printf ("Error for pow_int(a, a, c) for ");
DISP("a=",ref2); DISP2(", c=",ref3);
printf ("expected "); mpfr_print_binary (ref1); puts ("");
printf ("got "); mpfr_print_binary (res1); puts ("");
exit (1);
}
}
mpfr_clears (ref1, ref2, ref3, res1, (mpfr_ptr) 0);
}
APLVFP PrimFnMonQuoteDotVisV
(APLVFP aplVfpRht,
LPPRIMSPEC lpPrimSpec)
{
APLMPI mpzRes = {0};
APLVFP mpfRes = {0};
// Check for indeterminates: !N for integer N < 0
if (mpfr_integer_p (&aplVfpRht)
&& mpfr_cmp_ui (&aplVfpRht, 0) < 0)
return *mpfr_QuadICValue (&aplVfpRht, // No left arg
ICNDX_QDOTn,
&aplVfpRht,
&mpfRes,
FALSE);
// Check for PosInfinity
if (IsMpfPosInfinity (&aplVfpRht))
return mpfPosInfinity;
// If the arg is an integer,
// and it fits in a ULONG, ...
if (mpfr_integer_p (&aplVfpRht)
&& mpfr_fits_uint_p (&aplVfpRht, MPFR_RNDN))
{
mpz_init (&mpzRes);
mpfr_init0 (&mpfRes);
mpz_fac_ui (&mpzRes, mpfr_get_ui (&aplVfpRht, MPFR_RNDN));
mpfr_set_z (&mpfRes, &mpzRes, MPFR_RNDN);
Myz_clear (&mpzRes);
} else
{
// Initialize the result
mpfr_init_set (&mpfRes, &aplVfpRht, MPFR_RNDN);
mpfr_add_ui (&mpfRes, &mpfRes, 1, MPFR_RNDN);
// Let MPFR handle it
mpfr_gamma (&mpfRes, &mpfRes, MPFR_RNDN);
#ifdef DEBUG
mpfr_free_cache ();
#endif
} // End IF/ELSE
return mpfRes;
} // End PrimFnMonQuoteDotVisV
/* checks that x+y gives the right results with 53 bits of precision */
static void
check3 (const char *xs, unsigned long y, mp_rnd_t rnd_mode, const char *zs)
{
mpfr_t xx, zz;
mpfr_inits2 (53, xx, zz, (void *) 0);
mpfr_set_str1 (xx, xs);
mpfr_add_ui (zz, xx, y, rnd_mode);
if (mpfr_cmp_str1(zz, zs) )
{
printf ("expected sum is %s, got ",zs);
mpfr_out_str(stdout, 10, 0, zz, GMP_RNDN);
printf ("\nmpfr_add_ui failed for x=%s y=%lu with rnd_mode=%s\n",
xs, y, mpfr_print_rnd_mode(rnd_mode));
exit (1);
}
mpfr_clears (xx, zz, (void *) 0);
}
slong
hadamard_2arg(mpfr_t b,const fmpz_mat_t m)
/*
upper bound on log2( 2*abs(m det) )
returns -1 if zero row found, smallest row index otherwise
b on entry is uninitialized
b on exit is initialized iff no zero row found
*/
{
const slong n=m->r;
slong smallest=0,j;
// gcc warning: initialization from incompatible pointer type --- don't know
// how to fix
const fmpz** const rows=m->rows;
mpfr_t v,u;
if(log2_L2_fmpz_3arg( v, rows[0], n ))
return -1;
mpfr_copy_bound(b, v);
// v and b must be freed
for(j=1;j<n;j++)
{
if(log2_L2_fmpz_3arg( u, rows[j], n ))
{
mpfr_clear(b); mpfr_clear(v);
return -1;
}
mpfr_add_bound(b, u);
if( mpfr_cmp(u, v)<0 )
{
smallest=j;
mpfr_swap(v, u);
}
mpfr_clear(u);
// v and b must be freed
}
mpfr_clear(v);
mpfr_div_ui( b, b, 2, MPFR_RNDU ); // instead of taking root
mpfr_add_ui( b, b, 1, MPFR_RNDU ); // instead of multiplying by 2
return smallest;
}
void mpfr_naive_exp(mpfr_t R, mpfr_t x, mpz_t n)
{
assert(mpz_cmp_ui(n, 0) >= 0);
mpfr_t z;
mpfr_init_set(z, x, MPFR_RNDN);
mpfr_div_z(z, z, n, MPFR_RNDN);
mpfr_add_ui(z, z, 1, MPFR_RNDN);
if(mpfr_cmp_ui(z, 0) > 0)
mpfr_squaring_int_exp(R, z, n);
else
{
mpfr_neg(z, z, MPFR_RNDN);
mpfr_squaring_int_exp(R, z, n);
if(mpz_odd_p(n))
mpfr_neg(R, R, MPFR_RNDN);
}
}
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);
}
/* FastTwoSum: if EXP(x) >= EXP(y), u = o(x+y), v = o(u-x), w = o(y-v),
then x + y = u + w
thus if u = o(y-x), v = o(u+x), w = o(v-y), then y-x = u-w */
static void
check_two_sum (mpfr_prec_t p)
{
unsigned int x;
mpfr_t y, u, v, w;
mpfr_rnd_t rnd;
int inexact;
mpfr_inits2 (p, y, u, v, w, (mpfr_ptr) 0);
do
{
x = randlimb ();
}
while (x < 1);
mpfr_urandomb (y, RANDS);
rnd = MPFR_RNDN;
inexact = mpfr_sub_ui (u, y, x, rnd);
mpfr_add_ui (v, u, x, rnd);
mpfr_sub (w, v, y, rnd);
/* as u - (y-x) = w, we should have inexact and w of same sign */
if (((inexact == 0) && mpfr_cmp_ui (w, 0)) ||
((inexact > 0) && (mpfr_cmp_ui (w, 0) <= 0)) ||
((inexact < 0) && (mpfr_cmp_ui (w, 0) >= 0)))
{
printf ("Wrong inexact flag for prec=%u, rnd=%s\n",
(unsigned int) p, mpfr_print_rnd_mode (rnd));
printf ("x=%u\n", x);
printf ("y="); mpfr_print_binary(y); puts ("");
printf ("u="); mpfr_print_binary(u); puts ("");
printf ("v="); mpfr_print_binary(v); puts ("");
printf ("w="); mpfr_print_binary(w); puts ("");
printf ("inexact = %d\n", inexact);
exit (1);
}
mpfr_clears (y, u, v, w, (mpfr_ptr) 0);
}
/* We use the reflection formula
Gamma(1+t) Gamma(1-t) = - Pi t / sin(Pi (1 + t))
in order to treat the case x <= 1,
i.e. with x = 1-t, then Gamma(x) = -Pi*(1-x)/sin(Pi*(2-x))/GAMMA(2-x)
*/
int
mpfr_gamma (mpfr_ptr gamma, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp, GammaTrial, tmp, tmp2;
mpz_t fact;
mpfr_prec_t realprec;
int compared, is_integer;
int inex = 0; /* 0 means: result gamma not set yet */
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("gamma[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (gamma), mpfr_log_prec, gamma, inex));
/* Trivial cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (x))
{
if (MPFR_IS_NEG (x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
else
{
MPFR_SET_INF (gamma);
MPFR_SET_POS (gamma);
MPFR_RET (0); /* exact */
}
}
else /* x is zero */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
MPFR_SET_INF(gamma);
MPFR_SET_SAME_SIGN(gamma, x);
MPFR_SET_DIVBY0 ();
MPFR_RET (0); /* exact */
}
}
/* Check for tiny arguments, where gamma(x) ~ 1/x - euler + ....
We know from "Bound on Runs of Zeros and Ones for Algebraic Functions",
Proceedings of Arith15, T. Lang and J.-M. Muller, 2001, that the maximal
number of consecutive zeroes or ones after the round bit is n-1 for an
input of n bits. But we need a more precise lower bound. Assume x has
n bits, and 1/x is near a floating-point number y of n+1 bits. We can
write x = X*2^e, y = Y/2^f with X, Y integers of n and n+1 bits.
Thus X*Y^2^(e-f) is near from 1, i.e., X*Y is near from 2^(f-e).
Two cases can happen:
(i) either X*Y is exactly 2^(f-e), but this can happen only if X and Y
are themselves powers of two, i.e., x is a power of two;
(ii) or X*Y is at distance at least one from 2^(f-e), thus
|xy-1| >= 2^(e-f), or |y-1/x| >= 2^(e-f)/x = 2^(-f)/X >= 2^(-f-n).
Since ufp(y) = 2^(n-f) [ufp = unit in first place], this means
that the distance |y-1/x| >= 2^(-2n) ufp(y).
Now assuming |gamma(x)-1/x| <= 1, which is true for x <= 1,
if 2^(-2n) ufp(y) >= 2, the error is at most 2^(-2n-1) ufp(y),
and round(1/x) with precision >= 2n+2 gives the correct result.
If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1).
A sufficient condition is thus EXP(x) + 2 <= -2 MAX(PREC(x),PREC(Y)).
*/
if (MPFR_GET_EXP (x) + 2
<= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(gamma)))
{
int sign = MPFR_SIGN (x); /* retrieve sign before possible override */
int special;
MPFR_BLOCK_DECL (flags);
MPFR_SAVE_EXPO_MARK (expo);
/* for overflow cases, see below; this needs to be done
before x possibly gets overridden. */
special =
MPFR_GET_EXP (x) == 1 - MPFR_EMAX_MAX &&
MPFR_IS_POS_SIGN (sign) &&
MPFR_IS_LIKE_RNDD (rnd_mode, sign) &&
mpfr_powerof2_raw (x);
MPFR_BLOCK (flags, inex = mpfr_ui_div (gamma, 1, x, rnd_mode));
if (inex == 0) /* x is a power of two */
{
/* return RND(1/x - euler) = RND(+/- 2^k - eps) with eps > 0 */
if (rnd_mode == MPFR_RNDN || MPFR_IS_LIKE_RNDU (rnd_mode, sign))
inex = 1;
else
{
mpfr_nextbelow (gamma);
inex = -1;
}
}
else if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* Overflow in the division 1/x. This is a real overflow, except
in RNDZ or RNDD when 1/x = 2^emax, i.e. x = 2^(-emax): due to
the "- euler", the rounded value in unbounded exponent range
is 0.111...11 * 2^emax (not an overflow). */
if (!special)
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, flags);
}
MPFR_SAVE_EXPO_FREE (expo);
/* Note: an overflow is possible with an infinite result;
in this case, the overflow flag will automatically be
restored by mpfr_check_range. */
return mpfr_check_range (gamma, inex, rnd_mode);
}
is_integer = mpfr_integer_p (x);
/* gamma(x) for x a negative integer gives NaN */
if (is_integer && MPFR_IS_NEG(x))
{
MPFR_SET_NAN (gamma);
MPFR_RET_NAN;
}
compared = mpfr_cmp_ui (x, 1);
if (compared == 0)
return mpfr_set_ui (gamma, 1, rnd_mode);
/* if x is an integer that fits into an unsigned long, use mpfr_fac_ui
if argument is not too large.
If precision is p, fac_ui costs O(u*p), whereas gamma costs O(p*M(p)),
so for u <= M(p), fac_ui should be faster.
We approximate here M(p) by p*log(p)^2, which is not a bad guess.
Warning: since the generic code does not handle exact cases,
we want all cases where gamma(x) is exact to be treated here.
*/
if (is_integer && mpfr_fits_ulong_p (x, MPFR_RNDN))
{
unsigned long int u;
mpfr_prec_t p = MPFR_PREC(gamma);
u = mpfr_get_ui (x, MPFR_RNDN);
if (u < 44787929UL && bits_fac (u - 1) <= p + (rnd_mode == MPFR_RNDN))
/* bits_fac: lower bound on the number of bits of m,
where gamma(x) = (u-1)! = m*2^e with m odd. */
return mpfr_fac_ui (gamma, u - 1, rnd_mode);
/* if bits_fac(...) > p (resp. p+1 for rounding to nearest),
then gamma(x) cannot be exact in precision p (resp. p+1).
FIXME: remove the test u < 44787929UL after changing bits_fac
to return a mpz_t or mpfr_t. */
}
MPFR_SAVE_EXPO_MARK (expo);
/* check for overflow: according to (6.1.37) in Abramowitz & Stegun,
gamma(x) >= exp(-x) * x^(x-1/2) * sqrt(2*Pi)
>= 2 * (x/e)^x / x for x >= 1 */
if (compared > 0)
{
mpfr_t yp;
mpfr_exp_t expxp;
MPFR_BLOCK_DECL (flags);
/* quick test for the default exponent range */
if (mpfr_get_emax () >= 1073741823UL && MPFR_GET_EXP(x) <= 25)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* 1/e rounded down to 53 bits */
#define EXPM1_STR "0.010111100010110101011000110110001011001110111100111"
mpfr_init2 (xp, 53);
mpfr_init2 (yp, 53);
mpfr_set_str_binary (xp, EXPM1_STR);
mpfr_mul (xp, x, xp, MPFR_RNDZ);
mpfr_sub_ui (yp, x, 2, MPFR_RNDZ);
mpfr_pow (xp, xp, yp, MPFR_RNDZ); /* (x/e)^(x-2) */
mpfr_set_str_binary (yp, EXPM1_STR);
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^(x-1) */
mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^x */
mpfr_mul (xp, xp, x, MPFR_RNDZ); /* lower bound on x^(x-1) / e^x */
MPFR_BLOCK (flags, mpfr_mul_2ui (xp, xp, 1, MPFR_RNDZ));
expxp = MPFR_GET_EXP (xp);
mpfr_clear (xp);
mpfr_clear (yp);
MPFR_SAVE_EXPO_FREE (expo);
return MPFR_OVERFLOW (flags) || expxp > __gmpfr_emax ?
mpfr_overflow (gamma, rnd_mode, 1) :
mpfr_gamma_aux (gamma, x, rnd_mode);
}
/* now compared < 0 */
/* check for underflow: for x < 1,
gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x).
Since gamma(2-x) >= 2 * ((2-x)/e)^(2-x) / (2-x), we have
|gamma(x)| <= Pi*(1-x)*(2-x)/2/((2-x)/e)^(2-x) / |sin(Pi*(2-x))|
<= 12 * ((2-x)/e)^x / |sin(Pi*(2-x))|.
To avoid an underflow in ((2-x)/e)^x, we compute the logarithm.
*/
if (MPFR_IS_NEG(x))
{
int underflow = 0, sgn, ck;
mpfr_prec_t w;
mpfr_init2 (xp, 53);
mpfr_init2 (tmp, 53);
mpfr_init2 (tmp2, 53);
/* we want an upper bound for x * [log(2-x)-1].
since x < 0, we need a lower bound on log(2-x) */
mpfr_ui_sub (xp, 2, x, MPFR_RNDD);
mpfr_log (xp, xp, MPFR_RNDD);
mpfr_sub_ui (xp, xp, 1, MPFR_RNDD);
mpfr_mul (xp, xp, x, MPFR_RNDU);
/* we need an upper bound on 1/|sin(Pi*(2-x))|,
thus a lower bound on |sin(Pi*(2-x))|.
If 2-x is exact, then the error of Pi*(2-x) is (1+u)^2 with u = 2^(-p)
thus the error on sin(Pi*(2-x)) is less than 1/2ulp + 3Pi(2-x)u,
assuming u <= 1, thus <= u + 3Pi(2-x)u */
w = mpfr_gamma_2_minus_x_exact (x); /* 2-x is exact for prec >= w */
w += 17; /* to get tmp2 small enough */
mpfr_set_prec (tmp, w);
mpfr_set_prec (tmp2, w);
MPFR_DBGRES (ck = mpfr_ui_sub (tmp, 2, x, MPFR_RNDN));
MPFR_ASSERTD (ck == 0); /* tmp = 2-x exactly */
mpfr_const_pi (tmp2, MPFR_RNDN);
mpfr_mul (tmp2, tmp2, tmp, MPFR_RNDN); /* Pi*(2-x) */
mpfr_sin (tmp, tmp2, MPFR_RNDN); /* sin(Pi*(2-x)) */
sgn = mpfr_sgn (tmp);
mpfr_abs (tmp, tmp, MPFR_RNDN);
mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDU); /* 3Pi(2-x) */
mpfr_add_ui (tmp2, tmp2, 1, MPFR_RNDU); /* 3Pi(2-x)+1 */
mpfr_div_2ui (tmp2, tmp2, mpfr_get_prec (tmp), MPFR_RNDU);
/* if tmp2<|tmp|, we get a lower bound */
if (mpfr_cmp (tmp2, tmp) < 0)
{
mpfr_sub (tmp, tmp, tmp2, MPFR_RNDZ); /* low bnd on |sin(Pi*(2-x))| */
mpfr_ui_div (tmp, 12, tmp, MPFR_RNDU); /* upper bound */
mpfr_log2 (tmp, tmp, MPFR_RNDU);
mpfr_add (xp, tmp, xp, MPFR_RNDU);
/* The assert below checks that expo.saved_emin - 2 always
fits in a long. FIXME if we want to allow mpfr_exp_t to
be a long long, for instance. */
MPFR_ASSERTN (MPFR_EMIN_MIN - 2 >= LONG_MIN);
underflow = mpfr_cmp_si (xp, expo.saved_emin - 2) <= 0;
}
mpfr_clear (xp);
mpfr_clear (tmp);
mpfr_clear (tmp2);
if (underflow) /* the sign is the opposite of that of sin(Pi*(2-x)) */
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (gamma, (rnd_mode == MPFR_RNDN) ? MPFR_RNDZ : rnd_mode, -sgn);
}
}
realprec = MPFR_PREC (gamma);
/* we want both 1-x and 2-x to be exact */
{
mpfr_prec_t w;
w = mpfr_gamma_1_minus_x_exact (x);
if (realprec < w)
realprec = w;
w = mpfr_gamma_2_minus_x_exact (x);
if (realprec < w)
realprec = w;
}
realprec = realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20;
MPFR_ASSERTD(realprec >= 5);
MPFR_GROUP_INIT_4 (group, realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20,
xp, tmp, tmp2, GammaTrial);
mpz_init (fact);
MPFR_ZIV_INIT (loop, realprec);
for (;;)
{
mpfr_exp_t err_g;
int ck;
MPFR_GROUP_REPREC_4 (group, realprec, xp, tmp, tmp2, GammaTrial);
/* reflection formula: gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x) */
ck = mpfr_ui_sub (xp, 2, x, MPFR_RNDN); /* 2-x, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_gamma (tmp, xp, MPFR_RNDN); /* gamma(2-x), error (1+u) */
mpfr_const_pi (tmp2, MPFR_RNDN); /* Pi, error (1+u) */
mpfr_mul (GammaTrial, tmp2, xp, MPFR_RNDN); /* Pi*(2-x), error (1+u)^2 */
err_g = MPFR_GET_EXP(GammaTrial);
mpfr_sin (GammaTrial, GammaTrial, MPFR_RNDN); /* sin(Pi*(2-x)) */
/* If tmp is +Inf, we compute exp(lngamma(x)). */
if (mpfr_inf_p (tmp))
{
inex = mpfr_explgamma (gamma, x, &expo, tmp, tmp2, rnd_mode);
if (inex)
goto end;
else
goto ziv_next;
}
err_g = err_g + 1 - MPFR_GET_EXP(GammaTrial);
/* let g0 the true value of Pi*(2-x), g the computed value.
We have g = g0 + h with |h| <= |(1+u^2)-1|*g.
Thus sin(g) = sin(g0) + h' with |h'| <= |(1+u^2)-1|*g.
The relative error is thus bounded by |(1+u^2)-1|*g/sin(g)
<= |(1+u^2)-1|*2^err_g. <= 2.25*u*2^err_g for |u|<=1/4.
With the rounding error, this gives (0.5 + 2.25*2^err_g)*u. */
ck = mpfr_sub_ui (xp, x, 1, MPFR_RNDN); /* x-1, exact */
MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */
mpfr_mul (xp, tmp2, xp, MPFR_RNDN); /* Pi*(x-1), error (1+u)^2 */
mpfr_mul (GammaTrial, GammaTrial, tmp, MPFR_RNDN);
/* [1 + (0.5 + 2.25*2^err_g)*u]*(1+u)^2 = 1 + (2.5 + 2.25*2^err_g)*u
+ (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2.
For err_g <= realprec-2, we have (0.5 + 2.25*2^err_g)*u <=
0.5*u + 2.25/4 <= 0.6875 and u^2 <= u/4, thus
(0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2 <= 0.6875*(2u+u/4) + u/4
<= 1.8*u, thus the rel. error is bounded by (4.5 + 2.25*2^err_g)*u. */
mpfr_div (GammaTrial, xp, GammaTrial, MPFR_RNDN);
/* the error is of the form (1+u)^3/[1 + (4.5 + 2.25*2^err_g)*u].
For realprec >= 5 and err_g <= realprec-2, [(4.5 + 2.25*2^err_g)*u]^2
<= 0.71, and for |y|<=0.71, 1/(1-y) can be written 1+a*y with a<=4.
(1+u)^3 * (1+4*(4.5 + 2.25*2^err_g)*u)
= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (55+27*2^err_g)*u^3
+ (18+9*2^err_g)*u^4
<= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (56+28*2^err_g)*u^3
<= 1 + (21 + 9*2^err_g)*u + (59+28*2^err_g)*u^2
<= 1 + (23 + 10*2^err_g)*u.
The final error is thus bounded by (23 + 10*2^err_g) ulps,
which is <= 2^6 for err_g<=2, and <= 2^(err_g+4) for err_g >= 2. */
err_g = (err_g <= 2) ? 6 : err_g + 4;
if (MPFR_LIKELY (MPFR_CAN_ROUND (GammaTrial, realprec - err_g,
MPFR_PREC(gamma), rnd_mode)))
break;
ziv_next:
MPFR_ZIV_NEXT (loop, realprec);
}
end:
MPFR_ZIV_FREE (loop);
if (inex == 0)
inex = mpfr_set (gamma, GammaTrial, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpz_clear (fact);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (gamma, inex, rnd_mode);
}
int
main (int argc, char *argv[])
{
mpfr_t x;
long k, z, d, N;
unsigned long zl, dl;
int inex;
int r;
mpfr_exp_t emin, emax;
int flag;
tests_start_mpfr ();
mpfr_init2 (x, 100);
N = (argc==1) ? 100000 : atol (argv[1]);
for (k = 1; k <= N; k++)
{
z = (long) (randlimb () & LONG_MAX) + LONG_MIN / 2;
inex = mpfr_set_si (x, z, MPFR_RNDZ);
d = mpfr_get_si (x, MPFR_RNDZ);
if (d != z)
{
printf ("Error in mpfr_set_si: expected %ld got %ld\n", z, d);
exit (1);
}
if (inex)
{
printf ("Error in mpfr_set_si: inex value incorrect for %ld: %d\n",
z, inex);
exit (1);
}
}
for (k = 1; k <= N; k++)
{
zl = randlimb ();
inex = mpfr_set_ui (x, zl, MPFR_RNDZ);
dl = mpfr_get_ui (x, MPFR_RNDZ);
if (dl != zl)
{
printf ("Error in mpfr_set_ui: expected %lu got %lu\n", zl, dl);
exit (1);
}
if (inex)
{
printf ("Error in mpfr_set_ui: inex value incorrect for %lu: %d\n",
zl, inex);
exit (1);
}
}
mpfr_set_prec (x, 2);
if (mpfr_set_si (x, 5, MPFR_RNDZ) >= 0)
{
printf ("Wrong inexact flag for x=5, rnd=MPFR_RNDZ\n");
exit (1);
}
mpfr_set_prec (x, 2);
if (mpfr_set_si (x, -5, MPFR_RNDZ) <= 0)
{
printf ("Wrong inexact flag for x=-5, rnd=MPFR_RNDZ\n");
exit (1);
}
mpfr_set_prec (x, 3);
inex = mpfr_set_si (x, 77617, MPFR_RNDD); /* should be 65536 */
if (MPFR_MANT(x)[0] != ((mp_limb_t)1 << (mp_bits_per_limb-1))
|| inex >= 0)
{
printf ("Error in mpfr_set_si(x:3, 77617, MPFR_RNDD)\n");
mpfr_print_binary (x);
puts ("");
exit (1);
}
inex = mpfr_set_ui (x, 77617, MPFR_RNDD); /* should be 65536 */
if (MPFR_MANT(x)[0] != ((mp_limb_t)1 << (mp_bits_per_limb-1))
|| inex >= 0)
{
printf ("Error in mpfr_set_ui(x:3, 77617, MPFR_RNDD)\n");
mpfr_print_binary (x);
puts ("");
exit (1);
}
mpfr_set_prec (x, 2);
inex = mpfr_set_si (x, 33096, MPFR_RNDU);
if (mpfr_get_si (x, MPFR_RNDZ) != 49152 || inex <= 0)
{
printf ("Error in mpfr_set_si, exp. 49152, got %ld, inex %d\n",
mpfr_get_si (x, MPFR_RNDZ), inex);
exit (1);
}
inex = mpfr_set_ui (x, 33096, MPFR_RNDU);
if (mpfr_get_si (x, MPFR_RNDZ) != 49152)
{
printf ("Error in mpfr_set_ui, exp. 49152, got %ld, inex %d\n",
mpfr_get_si (x, MPFR_RNDZ), inex);
exit (1);
}
/* Also test the mpfr_set_ui function (instead of macro). */
inex = (mpfr_set_ui) (x, 33096, MPFR_RNDU);
if (mpfr_get_si (x, MPFR_RNDZ) != 49152)
{
printf ("Error in mpfr_set_ui function, exp. 49152, got %ld, inex %d\n",
mpfr_get_si (x, MPFR_RNDZ), inex);
exit (1);
}
for (r = 0 ; r < MPFR_RND_MAX ; r++)
{
mpfr_set_si (x, -1, (mpfr_rnd_t) r);
mpfr_set_ui (x, 0, (mpfr_rnd_t) r);
if (MPFR_IS_NEG (x) || mpfr_get_ui (x, (mpfr_rnd_t) r) != 0)
{
printf ("mpfr_set_ui (x, 0) gives -0 for %s\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r));
exit (1);
}
mpfr_set_si (x, -1, (mpfr_rnd_t) r);
mpfr_set_si (x, 0, (mpfr_rnd_t) r);
if (MPFR_IS_NEG (x) || mpfr_get_si (x, (mpfr_rnd_t) r) != 0)
{
printf ("mpfr_set_si (x, 0) gives -0 for %s\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r));
exit (1);
}
}
/* check potential bug in case mp_limb_t is unsigned */
emax = mpfr_get_emax ();
set_emax (0);
mpfr_set_si (x, -1, MPFR_RNDN);
if (mpfr_sgn (x) >= 0)
{
printf ("mpfr_set_si (x, -1) fails\n");
exit (1);
}
set_emax (emax);
emax = mpfr_get_emax ();
set_emax (5);
mpfr_set_prec (x, 2);
mpfr_set_si (x, -31, MPFR_RNDN);
if (mpfr_sgn (x) >= 0)
{
printf ("mpfr_set_si (x, -31) fails\n");
exit (1);
}
set_emax (emax);
/* test for get_ui */
mpfr_set_ui (x, 0, MPFR_RNDN);
MPFR_ASSERTN(mpfr_get_ui (x, MPFR_RNDN) == 0);
mpfr_set_ui (x, ULONG_MAX, MPFR_RNDU);
mpfr_nextabove (x);
mpfr_get_ui (x, MPFR_RNDU);
/* another test for get_ui */
mpfr_set_prec (x, 10);
mpfr_set_str_binary (x, "10.101");
dl = mpfr_get_ui (x, MPFR_RNDN);
MPFR_ASSERTN (dl == 3);
mpfr_set_str_binary (x, "-1.0");
mpfr_get_ui (x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1");
dl = mpfr_get_ui (x, MPFR_RNDN);
MPFR_ASSERTN (dl == 0);
dl = mpfr_get_ui (x, MPFR_RNDZ);
MPFR_ASSERTN (dl == 0);
dl = mpfr_get_ui (x, MPFR_RNDD);
MPFR_ASSERTN (dl == 0);
dl = mpfr_get_ui (x, MPFR_RNDU);
MPFR_ASSERTN (dl == 1);
/* coverage tests */
mpfr_set_prec (x, 2);
mpfr_set_si (x, -7, MPFR_RNDD);
MPFR_ASSERTN(mpfr_cmp_si (x, -8) == 0);
mpfr_set_prec (x, 2);
mpfr_set_ui (x, 7, MPFR_RNDU);
MPFR_ASSERTN(mpfr_cmp_ui (x, 8) == 0);
emax = mpfr_get_emax ();
set_emax (3);
mpfr_set_ui (x, 7, MPFR_RNDU);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
set_emax (1);
MPFR_ASSERTN( mpfr_set_ui (x, 7, MPFR_RNDU) );
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
set_emax (emax);
mpfr_set_ui_2exp (x, 17, -50, MPFR_RNDN);
MPFR_ASSERTN (mpfr_get_ui (x, MPFR_RNDD) == 0);
MPFR_ASSERTN (mpfr_get_si (x, MPFR_RNDD) == 0);
/* Test for ERANGE flag + correct behaviour if overflow */
mpfr_set_prec (x, 256);
mpfr_set_ui (x, ULONG_MAX, MPFR_RNDN);
mpfr_clear_erangeflag ();
dl = mpfr_get_ui (x, MPFR_RNDN);
if (dl != ULONG_MAX || mpfr_erangeflag_p ())
{
printf ("ERROR for get_ui + ERANGE + ULONG_MAX (1)\n");
exit (1);
}
mpfr_add_ui (x, x, 1, MPFR_RNDN);
dl = mpfr_get_ui (x, MPFR_RNDN);
if (dl != ULONG_MAX || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_ui + ERANGE + ULONG_MAX (2)\n");
exit (1);
}
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_clear_erangeflag ();
dl = mpfr_get_ui (x, MPFR_RNDN);
if (dl != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_ui + ERANGE + -1 \n");
exit (1);
}
mpfr_set_si (x, LONG_MAX, MPFR_RNDN);
mpfr_clear_erangeflag ();
d = mpfr_get_si (x, MPFR_RNDN);
if (d != LONG_MAX || mpfr_erangeflag_p ())
{
printf ("ERROR for get_si + ERANGE + LONG_MAX (1): %ld\n", d);
exit (1);
}
mpfr_add_ui (x, x, 1, MPFR_RNDN);
d = mpfr_get_si (x, MPFR_RNDN);
if (d != LONG_MAX || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_si + ERANGE + LONG_MAX (2)\n");
exit (1);
}
mpfr_set_si (x, LONG_MIN, MPFR_RNDN);
mpfr_clear_erangeflag ();
d = mpfr_get_si (x, MPFR_RNDN);
if (d != LONG_MIN || mpfr_erangeflag_p ())
{
printf ("ERROR for get_si + ERANGE + LONG_MIN (1)\n");
exit (1);
}
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
d = mpfr_get_si (x, MPFR_RNDN);
if (d != LONG_MIN || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_si + ERANGE + LONG_MIN (2)\n");
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_erangeflag ();
d = mpfr_get_ui (x, MPFR_RNDN);
if (d != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_ui + NaN\n");
exit (1);
}
mpfr_clear_erangeflag ();
d = mpfr_get_si (x, MPFR_RNDN);
if (d != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_si + NaN\n");
exit (1);
}
emin = mpfr_get_emin ();
mpfr_set_prec (x, 2);
mpfr_set_emin (4);
mpfr_clear_flags ();
mpfr_set_ui (x, 7, MPFR_RNDU);
flag = mpfr_underflow_p ();
mpfr_set_emin (emin);
if (mpfr_cmp_ui (x, 8) != 0)
{
printf ("Error for mpfr_set_ui (x, 7, MPFR_RNDU), prec = 2, emin = 4\n");
exit (1);
}
if (flag)
{
printf ("mpfr_set_ui (x, 7, MPFR_RNDU) should not underflow "
"with prec = 2, emin = 4\n");
exit (1);
}
mpfr_set_emin (4);
mpfr_clear_flags ();
mpfr_set_si (x, -7, MPFR_RNDD);
flag = mpfr_underflow_p ();
mpfr_set_emin (emin);
if (mpfr_cmp_si (x, -8) != 0)
{
printf ("Error for mpfr_set_si (x, -7, MPFR_RNDD), prec = 2, emin = 4\n");
exit (1);
}
if (flag)
{
printf ("mpfr_set_si (x, -7, MPFR_RNDD) should not underflow "
"with prec = 2, emin = 4\n");
exit (1);
}
mpfr_clear (x);
test_2exp ();
test_macros ();
test_macros_keyword ();
tests_end_mpfr ();
return 0;
}
int
mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_t x, t, te;
mpfr_prec_t Nx, Ny, Nt;
mpfr_exp_t err;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
/* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
between -1 and 1 */
if (MPFR_IS_NAN (xt) || MPFR_IS_INF (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else /* necessarily xt is 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* atanh(0) = 0 */
MPFR_SET_SAME_SIGN (y,xt);
MPFR_RET (0);
}
}
/* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0))
{
if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
mpfr_set_divby0 ();
MPFR_RET (0);
}
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
/* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
Nx = MPFR_PREC (xt);
MPFR_TMP_INIT_ABS (x, xt);
Ny = MPFR_PREC (y);
Nt = MAX (Nx, Ny);
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
mpfr_init2 (te, Nt);
/* First computation of cosh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute atanh */
mpfr_ui_sub (te, 1, x, MPFR_RNDU); /* (1-xt)*/
mpfr_add_ui (t, x, 1, MPFR_RNDD); /* (xt+1)*/
mpfr_div (t, t, te, MPFR_RNDN); /* (1+xt)/(1-xt)*/
mpfr_log (t, t, MPFR_RNDN); /* ln((1+xt)/(1-xt))*/
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/
/* error estimate: see algorithms.tex */
/* FIXME: this does not correspond to the value in algorithms.tex!!! */
/* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/
err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);
if (MPFR_LIKELY (MPFR_IS_ZERO (t)
|| MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* reactualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
mpfr_set_prec (te, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
mpfr_clear(t);
mpfr_clear(te);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
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;
}
static void
check_erange (void)
{
mpfr_t x;
uintmax_t dl;
intmax_t d;
/* Test for ERANGE flag + correct behaviour if overflow */
mpfr_init2 (x, 256);
mpfr_set_uj (x, MPFR_UINTMAX_MAX, MPFR_RNDN);
mpfr_clear_erangeflag ();
dl = mpfr_get_uj (x, MPFR_RNDN);
if (dl != MPFR_UINTMAX_MAX || mpfr_erangeflag_p ())
{
printf ("ERROR for get_uj + ERANGE + UINTMAX_MAX (1)\n");
exit (1);
}
mpfr_add_ui (x, x, 1, MPFR_RNDN);
dl = mpfr_get_uj (x, MPFR_RNDN);
if (dl != MPFR_UINTMAX_MAX || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_uj + ERANGE + UINTMAX_MAX (2)\n");
exit (1);
}
mpfr_set_sj (x, -1, MPFR_RNDN);
mpfr_clear_erangeflag ();
dl = mpfr_get_uj (x, MPFR_RNDN);
if (dl != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_uj + ERANGE + -1 \n");
exit (1);
}
mpfr_set_sj (x, MPFR_INTMAX_MAX, MPFR_RNDN);
mpfr_clear_erangeflag ();
d = mpfr_get_sj (x, MPFR_RNDN);
if (d != MPFR_INTMAX_MAX || mpfr_erangeflag_p ())
{
printf ("ERROR for get_sj + ERANGE + INTMAX_MAX (1)\n");
exit (1);
}
mpfr_add_ui (x, x, 1, MPFR_RNDN);
d = mpfr_get_sj (x, MPFR_RNDN);
if (d != MPFR_INTMAX_MAX || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_sj + ERANGE + INTMAX_MAX (2)\n");
exit (1);
}
mpfr_set_sj (x, MPFR_INTMAX_MIN, MPFR_RNDN);
mpfr_clear_erangeflag ();
d = mpfr_get_sj (x, MPFR_RNDN);
if (d != MPFR_INTMAX_MIN || mpfr_erangeflag_p ())
{
printf ("ERROR for get_sj + ERANGE + INTMAX_MIN (1)\n");
exit (1);
}
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
d = mpfr_get_sj (x, MPFR_RNDN);
if (d != MPFR_INTMAX_MIN || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_sj + ERANGE + INTMAX_MIN (2)\n");
exit (1);
}
mpfr_set_nan (x);
mpfr_clear_erangeflag ();
d = mpfr_get_uj (x, MPFR_RNDN);
if (d != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_uj + NaN\n");
exit (1);
}
mpfr_clear_erangeflag ();
d = mpfr_get_sj (x, MPFR_RNDN);
if (d != 0 || !mpfr_erangeflag_p ())
{
printf ("ERROR for get_sj + NaN\n");
exit (1);
}
mpfr_clear (x);
}
/* hard test of rounding */
static void
check_rounding (void)
{
mpfr_t a, b, c, res;
mpfr_prec_t p;
long k, l;
int i;
#define MAXKL (2 * GMP_NUMB_BITS)
for (p = MPFR_PREC_MIN; p <= GMP_NUMB_BITS; p++)
{
mpfr_init2 (a, p);
mpfr_init2 (res, p);
mpfr_init2 (b, p + 1 + MAXKL);
mpfr_init2 (c, MPFR_PREC_MIN);
/* b = 2^p + 1 + 2^(-k), c = 2^(-l) */
for (k = 0; k <= MAXKL; k++)
for (l = 0; l <= MAXKL; l++)
{
mpfr_set_ui_2exp (b, 1, p, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
mpfr_mul_2ui (b, b, k, MPFR_RNDN);
mpfr_add_ui (b, b, 1, MPFR_RNDN);
mpfr_div_2ui (b, b, k, MPFR_RNDN);
mpfr_set_ui_2exp (c, 1, -l, MPFR_RNDN);
i = mpfr_sub (a, b, c, MPFR_RNDN);
/* b - c = 2^p + 1 + 2^(-k) - 2^(-l), should be rounded to
2^p for l <= k, and 2^p+2 for l < k */
if (l <= k)
{
if (mpfr_cmp_ui_2exp (a, 1, p) != 0)
{
printf ("Wrong result in check_rounding\n");
printf ("p=%lu k=%ld l=%ld\n", p, k, l);
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected 2^%lu\n", p);
printf ("Got "); mpfr_print_binary (a); puts ("");
exit (1);
}
if (i >= 0)
{
printf ("Wrong ternary value in check_rounding\n");
printf ("p=%lu k=%ld l=%ld\n", p, k, l);
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("a="); mpfr_print_binary (a); puts ("");
printf ("Expected < 0, got %d\n", i);
exit (1);
}
}
else /* l < k */
{
mpfr_set_ui_2exp (res, 1, p, MPFR_RNDN);
mpfr_add_ui (res, res, 2, MPFR_RNDN);
if (mpfr_cmp (a, res) != 0)
{
printf ("Wrong result in check_rounding\n");
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected "); mpfr_print_binary (res); puts ("");
printf ("Got "); mpfr_print_binary (a); puts ("");
exit (1);
}
if (i <= 0)
{
printf ("Wrong ternary value in check_rounding\n");
printf ("b="); mpfr_print_binary (b); puts ("");
printf ("c="); mpfr_print_binary (c); puts ("");
printf ("Expected > 0, got %d\n", i);
exit (1);
}
}
}
mpfr_clear (a);
mpfr_clear (res);
mpfr_clear (b);
mpfr_clear (c);
}
}
static void
special (void)
{
mpfr_t x, y;
int inex;
int sign;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lgamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
{
printf ("Error for lgamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != -1)
{
printf ("Error for lgamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lgamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
{
printf ("Error for lgamma(2)\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"
mpfr_set_str (x, CHECK_X1, 10, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, GMP_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X1") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
mpfr_set_str (x, CHECK_X2, 10, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, GMP_RNDN);
if (mpfr_equal_p (y, x) == 0 || sign != 1)
{
printf ("mpfr_lgamma("CHECK_X2") is wrong:\n"
"expected ");
mpfr_print_binary (x); putchar ('\n');
printf ("got ");
mpfr_print_binary (y); putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 175);
mpfr_set_ui (x, 33, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, GMP_RNDN);
sign = -17;
mpfr_lgamma (x, &sign, y, GMP_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (120)\n");
printf ("Expected "); mpfr_print_binary (y); puts ("");
printf ("Got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 206);
mpfr_set_str_binary (x, "0.110e10");
sign = -17;
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error in mpfr_lgamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lgamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(0.1100E-66)\n");
printf ("Expected ");
mpfr_dump (x);
printf ("Got ");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, GMP_RNDN);
mpfr_add_ui (x, x, 1, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != 1)
{
printf ("Error for lgamma(-2^199+0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, GMP_RNDN);
mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_div_2ui (x, x, 1, GMP_RNDN);
sign = -17;
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (mpfr_equal_p (x, y) == 0 || sign != -1)
{
printf ("Error for lgamma(-2^199-0.5)\n");
printf ("Got ");
mpfr_dump (y);
printf ("with sign %d instead of ", sign);
mpfr_dump (x);
printf ("with sign -1.\n");
exit (1);
}
mpfr_set_prec (x, 10);
mpfr_set_prec (y, 10);
mpfr_set_str_binary (x, "-0.1101111000E-3");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "10.01001011");
if (mpfr_equal_p (x, y) == 0 || sign != -1 || inex >= 0)
{
printf ("Error for lgamma(-0.1101111000E-3)\n");
printf ("Got ");
mpfr_dump (y);
printf ("instead of ");
mpfr_dump (x);
printf ("with sign %d instead of -1 (inex=%d).\n", sign, inex);
exit (1);
}
mpfr_set_prec (x, 18);
mpfr_set_prec (y, 28);
mpfr_set_str_binary (x, "-1.10001101010001101e-196");
inex = mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_prec (x, 28);
mpfr_set_str_binary (x, "0.100001110110101011011010011E8");
MPFR_ASSERTN (mpfr_equal_p (x, y) && inex < 0);
/* values reported by Kaveh Ghazi on 14 Jul 2007, where mpfr_lgamma()
takes forever */
#define VAL1 "-0.11100001001010110111001010001001001011110100110000110E-55"
#define OUT1 "100110.01000000010111001110110101110101001001100110111"
#define VAL2 "-0.11100001001010110111001010001001001011110011111111100E-55"
#define OUT2 "100110.0100000001011100111011010111010100100110011111"
#define VAL3 "-0.11100001001010110111001010001001001001110101101010100E-55"
#define OUT3 "100110.01000000010111001110110101110101001011110111011"
#define VAL4 "-0.10001111110110110100100100000000001111110001001001011E-57"
#define OUT4 "101000.0001010111110011101101000101111111010001100011"
#define VAL5 "-0.10001111110110110100100100000000001111011111100001000E-57"
#define OUT5 "101000.00010101111100111011010001011111110100111000001"
#define VAL6 "-0.10001111110110110100100100000000001111011101100011001E-57"
#define OUT6 "101000.0001010111110011101101000101111111010011101111"
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, VAL1);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT1);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p(x, y));
mpfr_set_str_binary (x, VAL2);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT2);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL3);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT3);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL4);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT4);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL5);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT5);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_set_str_binary (x, VAL6);
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, OUT6);
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
/* further test from Kaveh Ghazi */
mpfr_set_str_binary (x, "-0.10011010101001010010001110010111010111011101010111001E-53");
mpfr_lgamma (y, &sign, x, GMP_RNDN);
mpfr_set_str_binary (x, "100101.00111101101010000000101010111010001111001101111");
MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));
mpfr_clear (x);
mpfr_clear (y);
}
