static void
check_nans (void)
{
mpfr_t x, y;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
/* nan - 1 == nan */
mpfr_set_nan (x);
mpfr_sub_ui (y, x, 1L, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (y));
/* +inf - 1 == +inf */
mpfr_set_inf (x, 1);
mpfr_sub_ui (y, x, 1L, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) > 0);
/* -inf - 1 == -inf */
mpfr_set_inf (x, -1);
mpfr_sub_ui (y, x, 1L, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (y));
MPFR_ASSERTN (mpfr_sgn (y) < 0);
mpfr_clear (x);
mpfr_clear (y);
}
void Compute(gmp_randstate_t r) const {
// The algorithm is sample x and z from the exponential distribution; if
// (x-1)^2 < 2*z, return (random sign)*x; otherwise repeat. Probability
// of acceptance is sqrt(pi/2) * exp(-1/2) = 0.7602.
while (true) {
_edist(_x, r);
_edist(_z, r);
for (mp_size_t k = 1; ; ++k) {
_x.ExpandTo(r, k - 1);
_z.ExpandTo(r, k - 1);
mpfr_prec_t prec = std::max(mpfr_prec_t(MPFR_PREC_MIN), k * bits);
mpfr_set_prec(_xf, prec);
mpfr_set_prec(_zf, prec);
// Try for acceptance first; so compute upper limit on (y-1)^2 and
// lower limit on 2*z.
if (_x.UInteger() == 0) {
_x(_xf, MPFR_RNDD);
mpfr_ui_sub(_xf, 1u, _xf, MPFR_RNDU);
} else {
_x(_xf, MPFR_RNDU);
mpfr_sub_ui(_xf, _xf, 1u, MPFR_RNDU);
}
mpfr_sqr(_xf, _xf, MPFR_RNDU);
_z(_zf, MPFR_RNDD);
mpfr_mul_2ui(_zf, _zf, 1u, MPFR_RNDD);
if (mpfr_cmp(_xf, _zf) < 0) { // (y-1)^2 < 2*z, so accept
if (_x.Boolean(r)) _x.Negate(); // include a random sign
return;
}
// Try for rejection; so compute lower limit on (y-1)^2 and upper
// limit on 2*z.
if (_x.UInteger() == 0) {
_x(_xf, MPFR_RNDU);
mpfr_ui_sub(_xf, 1u, _xf, MPFR_RNDD);
} else {
_x(_xf, MPFR_RNDD);
mpfr_sub_ui(_xf, _xf, 1u, MPFR_RNDD);
}
mpfr_sqr(_xf, _xf, MPFR_RNDD);
_z(_zf, MPFR_RNDU);
mpfr_mul_2ui(_zf, _zf, 1u, MPFR_RNDU);
if (mpfr_cmp(_xf, _zf) > 0) // (y-1)^2 > 2*z, so reject
break;
// Otherwise repeat with more precision
}
// Reject and start over with a new y and z
}
}
mp_limb_t
cramer_rule(const mpfr_t den_bound,
mpz_square_mat_t A, mpfr_prec_t pr, slong k)
// returns log2(Cramer bound on numerator) rounded up
{
mp_limb_t bI;
const slong n=A->r;
mpfr_t u,v,w;
mpfr_init2(w,pr);
mpfr_init2(u,pr);
log2_L2_norm_4arg(u, A, k, n);
//mpfr_printf("k=%d row norm=%10Rf\n",k,u);
mpfr_sub(w, den_bound, u, MPFR_RNDU); // w=den_bound / min row norm
mpfr_sub_ui(u, w, 1, MPFR_RNDU); // u=den_bound/2/min row norm
// vector norm = square root of n
mpfr_init(v);
mpfr_set_ui(v, n, MPFR_RNDU);
mpfr_log2(w, v, MPFR_RNDU); // w=b norm * 2
mpfr_clear(v);
mpfr_div_ui(w, w, 2, MPFR_RNDU); // w=b norm
mpfr_add(w, w, u, MPFR_RNDU); // w=b norm*(...)
mpfr_clear(u);
bI=mpfr_get_uj(w, MPFR_RNDU);
mpfr_clear(w);
if(bI<FLINT_BITS)
bI=FLINT_BITS;
return bI;
}
/* Test case bk == 0 in add1.c (b has entirely been read and
c hasn't been taken into account). */
static void
coverage_bk_eq_0 (void)
{
mpfr_t a, b, c;
int inex;
mpfr_init2 (a, GMP_NUMB_BITS);
mpfr_init2 (b, 2 * GMP_NUMB_BITS);
mpfr_init2 (c, GMP_NUMB_BITS);
mpfr_set_ui_2exp (b, 1, 2 * GMP_NUMB_BITS, MPFR_RNDN);
mpfr_sub_ui (b, b, 1, MPFR_RNDN);
/* b = 111...111 (in base 2) where the 1's fit 2 whole limbs */
mpfr_set_ui_2exp (c, 1, -1, MPFR_RNDN); /* c = 1/2 */
inex = mpfr_add (a, b, c, MPFR_RNDU);
mpfr_set_ui_2exp (c, 1, 2 * GMP_NUMB_BITS, MPFR_RNDN);
if (! mpfr_equal_p (a, c))
{
printf ("Error in coverage_bk_eq_0\n");
printf ("Expected ");
mpfr_dump (c);
printf ("Got ");
mpfr_dump (a);
exit (1);
}
MPFR_ASSERTN (inex > 0);
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
}
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
}
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);
}
/* return 0 iff both the real and imaginary parts are exact */
int
mpc_sub_ui (mpc_ptr a, mpc_srcptr b, unsigned long int c, mpc_rnd_t rnd)
{
int inex_re, inex_im;
inex_re = mpfr_sub_ui (MPC_RE(a), MPC_RE(b), c, MPC_RND_RE(rnd));
inex_im = mpfr_set (MPC_IM(a), MPC_IM(b), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
/* 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);
}
static void
compare_exp2_exp3 (int n)
{
mpfr_t x, y, z; int prec; mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
for (prec = 20; prec <= n; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
mpfr_random (x);
rnd = (mp_rnd_t) RND_RAND();
mpfr_exp_2 (y, x, rnd);
mpfr_exp_3 (z, x, rnd);
if (mpfr_cmp (y,z))
{
printf ("mpfr_exp_2 and mpfr_exp_3 disagree for rnd=%s and\nx=",
mpfr_print_rnd_mode (rnd));
mpfr_print_binary (x);
puts ("");
printf ("mpfr_exp_2 gives ");
mpfr_print_binary (y);
puts ("");
printf ("mpfr_exp_3 gives ");
mpfr_print_binary (z);
puts ("");
exit (1);
}
}
/* bug found by Patrick Pe'lissier on 7 Jun 2004 */
prec = 203780;
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_d (x, 3.0, GMP_RNDN);
mpfr_sqrt (x, x, GMP_RNDN);
mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_exp_3 (z, x, GMP_RNDN);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
/* Check that hardware rounding doesn't make mpfr_get_d_2exp return a value
outside its defined range. */
static void
check_round (void)
{
static const unsigned long data[] = { 1, 32, 53, 54, 64, 128, 256, 512 };
mpfr_t f;
double got;
long got_exp;
int i, rnd_mode, neg;
mpfr_init2 (f, 1024L);
for (rnd_mode = 0; rnd_mode < MPFR_RND_MAX ; rnd_mode++)
{
for (i = 0; i < (int) numberof (data); i++)
{
mpfr_set_ui (f, 1L, MPFR_RNDZ);
mpfr_mul_2exp (f, f, data[i], MPFR_RNDZ);
mpfr_sub_ui (f, f, 1L, MPFR_RNDZ);
for (neg = 0; neg <= 1; neg++)
{
got = mpfr_get_d_2exp (&got_exp, f, (mpfr_rnd_t) rnd_mode);
if (neg == 0
? (got < 0.5 || got >= 1.0)
: (got <= -1.0 || got > -0.5))
{
printf ("mpfr_get_d_2exp wrong on 2**%lu-1\n", data[i]);
printf ("result out of range, expect 0.5 <= got < 1.0\n");
printf (" rnd_mode = %d\n", rnd_mode);
printf (" data[i] = %lu\n", data[i]);
printf (" f ");
mpfr_out_str (stdout, 2, 0, f, MPFR_RNDN);
printf ("\n");
d_trace (" got ", got);
printf (" got exp %ld\n", got_exp);
exit(1);
}
mpfr_neg (f, f, MPFR_RNDZ);
}
}
}
mpfr_clear (f);
}
static void
check_large (void)
{
mpfr_t x, z;
mpfr_prec_t prec;
/* bug found by Patrick Pe'lissier on 7 Jun 2004 */
prec = 203780;
mpfr_init2 (x, prec);
mpfr_init2 (z, prec);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_sqrt (x, x, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_exp_3 (z, x, MPFR_RNDN);
mpfr_clear (x);
mpfr_clear (z);
}
/* checks that x-y gives the right results with 53 bits of precision */
static void
check3 (const char *xs, unsigned long y, mpfr_rnd_t rnd_mode, const char *zs)
{
mpfr_t xx,zz;
mpfr_inits2 (53, xx, zz, (mpfr_ptr) 0);
mpfr_set_str1 (xx, xs);
mpfr_sub_ui (zz, xx, y, rnd_mode);
if (mpfr_cmp_str1(zz, zs))
{
printf ("expected sum is %s, got ", zs);
mpfr_print_binary(zz);
printf ("\nmpfr_sub_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, (mpfr_ptr) 0);
}
/* 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;
}
/* 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);
}
int
main (int argc, char *argv[])
{
int n, prec, st, st2, N, i;
mpfr_t x, y, z;
if (argc != 2 && argc != 3)
{
fprintf(stderr, "Usage: timing digits \n");
exit(1);
}
printf ("Using MPFR-%s with GMP-%s\n", mpfr_version, gmp_version);
n = atoi(argv[1]);
prec = (int) ( n * log(10.0) / log(2.0) + 1.0 );
printf("[precision is %u bits]\n", prec);
mpfr_init2(x, prec); mpfr_init2(y, prec); mpfr_init2(z, prec);
mpfr_set_d(x, 3.0, GMP_RNDN); mpfr_sqrt(x, x, GMP_RNDN); mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_set_d(y, 5.0, GMP_RNDN); mpfr_sqrt(y, y, GMP_RNDN);
mpfr_log (z, x, GMP_RNDN);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_mul(z, x, y, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x*y took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_mul(z, x, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x*x took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_div(z, x, y, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x/y took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_sqrt(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("sqrt(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_exp(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("exp(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_log(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("log(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_sin(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("sin(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_cos(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("cos(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_acos(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("arccos(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_atan(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("arctan(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
mpfr_clear(x); mpfr_clear(y); mpfr_clear(z);
return 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);
}
APLVFP PrimFnMonDownStileVisV
(APLVFP aplVfpRht,
LPPRIMSPEC lpPrimSpec)
{
APLVFP mpfRes = {0},
mpfFloor = {0},
mpfCeil = {0},
mpfTmp1 = {0},
mpfTmp2 = {0},
mpfNear = {0};
// Check for PoM infinity
if (IsMpfInfinity (&aplVfpRht))
// Copy to the result
mpfr_init_copy (&mpfRes, &aplVfpRht);
else
{
#ifdef DEBUG
//// WCHAR wszTemp[512];
#endif
// Initialize the temps
mpfr_init0 (&mpfRes);
mpfr_init0 (&mpfFloor);
mpfr_init0 (&mpfCeil );
mpfr_init0 (&mpfTmp1);
mpfr_init0 (&mpfTmp2);
mpfr_init0 (&mpfNear);
// Get the exact floor and ceiling
mpfr_floor (&mpfFloor, &aplVfpRht);
mpfr_ceil (&mpfCeil , &aplVfpRht);
// Calculate the integer nearest the right arg
mpfr_sub (&mpfTmp1, &aplVfpRht, &mpfFloor, MPFR_RNDN);
mpfr_sub (&mpfTmp2, &mpfCeil , &aplVfpRht, MPFR_RNDN);
// Split cases based upon the signum of the difference between
// (the number and its floor) and (the ceiling and the number)
switch (signumint (mpfr_cmp (&mpfTmp1, &mpfTmp2)))
{
case 1:
mpfr_set (&mpfNear, &mpfCeil, MPFR_RNDN);
break;
case 0:
mpfr_abs (&mpfTmp1, &mpfFloor, MPFR_RNDN);
mpfr_abs (&mpfTmp2, &mpfFloor, MPFR_RNDN);
// They are equal, so use the one with the larger absolute value
mpfr_set (&mpfNear,
((mpfr_cmp (&mpfTmp1, &mpfTmp2) > 0) ? &mpfFloor
: &mpfCeil),
MPFR_RNDN);
break;
case -1:
mpfr_set (&mpfNear, &mpfFloor, MPFR_RNDN);
break;
defstop
break;
} // End SWITCH
#ifdef DEBUG
//// strcpyW (wszTemp, L"Floor: "); *FormatAplVfp (&wszTemp[lstrlenW (wszTemp)], mpfFloor, 0) = WC_EOS; DbgMsgW (wszTemp);
//// strcpyW (wszTemp, L"Near: "); *FormatAplVfp (&wszTemp[lstrlenW (wszTemp)], mpfNear , 0) = WC_EOS; DbgMsgW (wszTemp);
//// strcpyW (wszTemp, L"Ceil: "); *FormatAplVfp (&wszTemp[lstrlenW (wszTemp)], mpfCeil , 0) = WC_EOS; DbgMsgW (wszTemp);
#endif
// If Near is < Rht, return Near
if (mpfr_cmp (&mpfNear, &aplVfpRht) < 0)
mpfr_set (&mpfRes, &mpfNear, MPFR_RNDN);
else
{
// If Near is non-zero, and
// Rht is tolerantly-equal to Near,
// return Near; otherwise, return Near - 1
if (mpfr_sgn (&mpfNear) NE 0)
{
mpfr_set (&mpfRes, &mpfNear, MPFR_RNDN);
if (!PrimFnDydEqualBisVvV (aplVfpRht,
mpfNear,
NULL))
mpfr_sub_ui (&mpfRes, &mpfRes, 1, MPFR_RNDN);
} else
{
// aplNear is zero
// Get -[]CT as a VFP
mpfr_set_d (&mpfTmp1, -GetQuadCT (), MPFR_RNDN);
// If Rht is between (-[]CT) and 0 (inclusive),
// return 0; otherwise, return -1
if (mpfr_cmp (&mpfTmp1, &aplVfpRht) <= 0
&& mpfr_sgn (&aplVfpRht) <= 0)
mpfr_set_si (&mpfRes, 0, MPFR_RNDN);
else
mpfr_set_si (&mpfRes, -1, MPFR_RNDN);
} // End IF/ELSE
} // End IF/ELSE
// We no longer need this storage
Myf_clear (&mpfNear);
Myf_clear (&mpfTmp2);
Myf_clear (&mpfTmp1);
Myf_clear (&mpfCeil);
Myf_clear (&mpfFloor);
} // End IF/ELSE
return mpfRes;
} // End PrimFnMonDownStileVisV
int
main (int argc, char *argv[])
{
mpfr_t x, y, r;
long q[1];
if (argc == 3) /* usage: tremquo x y (rnd=MPFR_RNDN implicit) */
{
mpfr_init2 (x, GMP_NUMB_BITS);
mpfr_init2 (y, GMP_NUMB_BITS);
mpfr_init2 (r, GMP_NUMB_BITS);
mpfr_set_str (x, argv[1], 10, MPFR_RNDN);
mpfr_set_str (y, argv[2], 10, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
printf ("r=");
mpfr_out_str (stdout, 10, 0, r, MPFR_RNDN);
printf (" q=%ld\n", q[0]);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
return 0;
}
tests_start_mpfr ();
bug20090227 ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (r);
/* special values */
mpfr_set_nan (x);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (r));
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_nan (y);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_POS (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN); /* -0 */
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_NEG (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp (r, x) == 0);
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_POS (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_NEG (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
/* check four possible sign combinations */
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 8) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_si (x, -42, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -8) == 0);
MPFR_ASSERTN (q[0] == (long) -2);
mpfr_set_si (x, -42, MPFR_RNDN);
mpfr_set_si (y, -17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -8) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_si (y, -17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 8) == 0);
MPFR_ASSERTN (q[0] == (long) -2);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 50);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_nextabove (x); /* 42 + 2^(-94) */
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -94) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 100);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_nextabove (x); /* 42 + 2^(-44) */
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -44) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 50);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_nextabove (y); /* 21 + 2^(-45) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* r should be 42 - 2*(21 + 2^(-45)) = -2^(-44) */
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -44) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 100);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_nextabove (y); /* 21 + 2^(-95) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* r should be 42 - 2*(21 + 2^(-95)) = -2^(-94) */
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -94) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
/* exercise large quotient */
mpfr_set_ui_2exp (x, 1, 65, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
/* quotient is 2^65 */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, 0) == 0);
MPFR_ASSERTN (q[0] % 1073741824L == 0L);
/* another large quotient */
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_const_pi (x, MPFR_RNDN);
mpfr_mul_2exp (x, x, 63, MPFR_RNDN);
mpfr_const_log2 (y, MPFR_RNDN);
mpfr_set_prec (r, 10);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* q should be 41803643793084085130, r should be 605/2048 */
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 605, -11) == 0);
MPFR_ASSERTN ((q[0] > 0) && ((q[0] % 1073741824L) == 733836170L));
/* check cases where quotient is 1.5 +/- eps */
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_set_prec (r, 63);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5, quotient should be 2 (even rule), remainder should be -1 */
MPFR_ASSERTN (mpfr_cmp_si (r, -1) == 0);
MPFR_ASSERTN (q[0] == 2L);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_nextabove (x); /* 3 + 2^(-63) */
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5 + 2^(-64), quo should be 2, r should be -1 + 2^(-63) */
MPFR_ASSERTN (mpfr_add_ui (r, r, 1, MPFR_RNDN) == 0);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -63) == 0);
MPFR_ASSERTN (q[0] == 2L);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_nextabove (y); /* 2 + 2^(-63) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5 - eps, quo should be 1, r should be 1 - 2^(-63) */
MPFR_ASSERTN (mpfr_sub_ui (r, r, 1, MPFR_RNDN) == 0);
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -63) == 0);
MPFR_ASSERTN (q[0] == 1L);
/* bug founds by Kaveh Ghazi, 3 May 2007 */
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_set_ui (y, 3, MPFR_RNDN);
mpfr_remainder (r, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -1) == 0);
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remainder (r, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, 0) == 0 && MPFR_SIGN (r) < 0);
/* check argument reuse */
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remainder (x, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (x, 0) == 0 && MPFR_SIGN (x) < 0);
mpfr_set_ui_2exp (x, 1, mpfr_get_emax () - 1, MPFR_RNDN);
mpfr_set_ui_2exp (y, 1, mpfr_get_emin (), MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_zero_p (r) && MPFR_SIGN (r) > 0);
MPFR_ASSERTN (q[0] == 0);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
tests_end_mpfr ();
return 0;
}
int
mpfr_exp (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_exp_t expx;
mpfr_prec_t precy;
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(x) ))
{
if (MPFR_IS_NAN(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF(x))
{
if (MPFR_IS_POS(x))
MPFR_SET_INF(y);
else
MPFR_SET_ZERO(y);
MPFR_SET_POS(y);
MPFR_RET(0);
}
else
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
/* First, let's detect most overflow and underflow cases. */
{
mpfr_t e, bound;
/* We must extended the exponent range and save the flags now. */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (e, sizeof (mpfr_exp_t) * CHAR_BIT);
mpfr_init2 (bound, 32);
inexact = mpfr_set_exp_t (e, expo.saved_emax, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
mpfr_const_log2 (bound, expo.saved_emax < 0 ? MPFR_RNDD : MPFR_RNDU);
mpfr_mul (bound, bound, e, MPFR_RNDU);
if (MPFR_UNLIKELY (mpfr_cmp (x, bound) >= 0))
{
/* x > log(2^emax), thus exp(x) > 2^emax */
mpfr_clears (e, bound, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd_mode, 1);
}
inexact = mpfr_set_exp_t (e, expo.saved_emin, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
inexact = mpfr_sub_ui (e, e, 2, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
mpfr_const_log2 (bound, expo.saved_emin < 0 ? MPFR_RNDU : MPFR_RNDD);
mpfr_mul (bound, bound, e, MPFR_RNDD);
if (MPFR_UNLIKELY (mpfr_cmp (x, bound) <= 0))
{
/* x < log(2^(emin - 2)), thus exp(x) < 2^(emin - 2) */
mpfr_clears (e, bound, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (y, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
1);
}
/* Other overflow/underflow cases must be detected
by the generic routines. */
mpfr_clears (e, bound, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
}
expx = MPFR_GET_EXP (x);
precy = MPFR_PREC (y);
/* if x < 2^(-precy), then exp(x) i.e. gives 1 +/- 1 ulp(1) */
if (MPFR_UNLIKELY (expx < 0 && (mpfr_uexp_t) (-expx) > precy))
{
mpfr_exp_t emin = __gmpfr_emin;
mpfr_exp_t emax = __gmpfr_emax;
int signx = MPFR_SIGN (x);
MPFR_SET_POS (y);
if (MPFR_IS_NEG_SIGN (signx) && (rnd_mode == MPFR_RNDD ||
rnd_mode == MPFR_RNDZ))
{
__gmpfr_emin = 0;
__gmpfr_emax = 0;
mpfr_setmax (y, 0); /* y = 1 - epsilon */
inexact = -1;
}
else
{
__gmpfr_emin = 1;
__gmpfr_emax = 1;
mpfr_setmin (y, 1); /* y = 1 */
if (MPFR_IS_POS_SIGN (signx) && (rnd_mode == MPFR_RNDU ||
rnd_mode == MPFR_RNDA))
{
mp_size_t yn;
int sh;
yn = 1 + (MPFR_PREC(y) - 1) / GMP_NUMB_BITS;
sh = (mpfr_prec_t) yn * GMP_NUMB_BITS - MPFR_PREC(y);
MPFR_MANT(y)[0] += MPFR_LIMB_ONE << sh;
inexact = 1;
}
else
inexact = -MPFR_FROM_SIGN_TO_INT(signx);
}
__gmpfr_emin = emin;
__gmpfr_emax = emax;
}
else /* General case */
{
if (MPFR_UNLIKELY (precy >= MPFR_EXP_THRESHOLD))
/* mpfr_exp_3 saves the exponent range and flags itself, otherwise
the flag changes in mpfr_exp_3 are lost */
inexact = mpfr_exp_3 (y, x, rnd_mode); /* O(M(n) log(n)^2) */
else
{
MPFR_SAVE_EXPO_MARK (expo);
inexact = mpfr_exp_2 (y, x, rnd_mode); /* O(n^(1/3) M(n)) */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
}
}
return mpfr_check_range (y, inexact, rnd_mode);
}
int
main (void)
{
mpfr_prec_t prec;
mpfr_t x, y;
intmax_t s;
uintmax_t u;
tests_start_mpfr ();
for (u = MPFR_UINTMAX_MAX, prec = 0; u != 0; u /= 2, prec++)
{ }
mpfr_init2 (x, prec + 4);
mpfr_init2 (y, prec + 4);
mpfr_set_ui (x, 0, MPFR_RNDN);
check_sj (0, x);
check_uj (0, x);
mpfr_set_ui (x, 1, MPFR_RNDN);
check_sj (1, x);
check_uj (1, x);
mpfr_neg (x, x, MPFR_RNDN);
check_sj (-1, x);
mpfr_set_si_2exp (x, 1, prec, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN); /* UINTMAX_MAX */
mpfr_div_ui (y, x, 2, MPFR_RNDZ);
mpfr_trunc (y, y); /* INTMAX_MAX */
for (s = MPFR_INTMAX_MAX; s != 0; s /= 17)
{
check_sj (s, y);
mpfr_div_ui (y, y, 17, MPFR_RNDZ);
mpfr_trunc (y, y);
}
mpfr_div_ui (y, x, 2, MPFR_RNDZ);
mpfr_trunc (y, y); /* INTMAX_MAX */
mpfr_neg (y, y, MPFR_RNDN);
if (MPFR_INTMAX_MIN + MPFR_INTMAX_MAX != 0)
mpfr_sub_ui (y, y, 1, MPFR_RNDN); /* INTMAX_MIN */
for (s = MPFR_INTMAX_MIN; s != 0; s /= 17)
{
check_sj (s, y);
mpfr_div_ui (y, y, 17, MPFR_RNDZ);
mpfr_trunc (y, y);
}
for (u = MPFR_UINTMAX_MAX; u != 0; u /= 17)
{
check_uj (u, x);
mpfr_div_ui (x, x, 17, MPFR_RNDZ);
mpfr_trunc (x, x);
}
mpfr_clear (x);
mpfr_clear (y);
check_erange ();
tests_end_mpfr ();
return 0;
}
/* The computation of z = pow(x,y) is done by
z = exp(y * log(x)) = x^y
For the special cases, see Section F.9.4.4 of the C standard:
_ pow(±0, y) = ±inf for y an odd integer < 0.
_ pow(±0, y) = +inf for y < 0 and not an odd integer.
_ pow(±0, y) = ±0 for y an odd integer > 0.
_ pow(±0, y) = +0 for y > 0 and not an odd integer.
_ pow(-1, ±inf) = 1.
_ pow(+1, y) = 1 for any y, even a NaN.
_ pow(x, ±0) = 1 for any x, even a NaN.
_ pow(x, y) = NaN for finite x < 0 and finite non-integer y.
_ pow(x, -inf) = +inf for |x| < 1.
_ pow(x, -inf) = +0 for |x| > 1.
_ pow(x, +inf) = +0 for |x| < 1.
_ pow(x, +inf) = +inf for |x| > 1.
_ pow(-inf, y) = -0 for y an odd integer < 0.
_ pow(-inf, y) = +0 for y < 0 and not an odd integer.
_ pow(-inf, y) = -inf for y an odd integer > 0.
_ pow(-inf, y) = +inf for y > 0 and not an odd integer.
_ pow(+inf, y) = +0 for y < 0.
_ pow(+inf, y) = +inf for y > 0. */
int
mpfr_pow (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode)
{
int inexact;
int cmp_x_1;
int y_is_integer;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x,
mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (z), mpfr_log_prec, z, inexact));
if (MPFR_ARE_SINGULAR (x, y))
{
/* pow(x, 0) returns 1 for any x, even a NaN. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (y)))
return mpfr_set_ui (z, 1, rnd_mode);
else if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_NAN (y))
{
/* pow(+1, NaN) returns 1. */
if (mpfr_cmp_ui (x, 1) == 0)
return mpfr_set_ui (z, 1, rnd_mode);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (y))
{
if (MPFR_IS_INF (x))
{
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int cmp;
cmp = mpfr_cmpabs (x, __gmpfr_one) * MPFR_INT_SIGN (y);
MPFR_SET_POS (z);
if (cmp > 0)
{
/* Return +inf. */
MPFR_SET_INF (z);
MPFR_RET (0);
}
else if (cmp < 0)
{
/* Return +0. */
MPFR_SET_ZERO (z);
MPFR_RET (0);
}
else
{
/* Return 1. */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
}
else if (MPFR_IS_INF (x))
{
int negative;
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG (x) && is_odd (y);
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int negative;
MPFR_ASSERTD (MPFR_IS_ZERO (x));
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG(x) && is_odd (y);
if (MPFR_IS_NEG (y))
{
MPFR_ASSERTD (! MPFR_IS_INF (y));
MPFR_SET_INF (z);
mpfr_set_divby0 ();
}
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* x^y for x < 0 and y not an integer is not defined */
y_is_integer = mpfr_integer_p (y);
if (MPFR_IS_NEG (x) && ! y_is_integer)
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
/* now the result cannot be NaN:
(1) either x > 0
(2) or x < 0 and y is an integer */
cmp_x_1 = mpfr_cmpabs (x, __gmpfr_one);
if (cmp_x_1 == 0)
return mpfr_set_si (z, MPFR_IS_NEG (x) && is_odd (y) ? -1 : 1, rnd_mode);
/* now we have:
(1) either x > 0
(2) or x < 0 and y is an integer
and in addition |x| <> 1.
*/
/* detect overflow: an overflow is possible if
(a) |x| > 1 and y > 0
(b) |x| < 1 and y < 0.
FIXME: this assumes 1 is always representable.
FIXME2: maybe we can test overflow and underflow simultaneously.
The idea is the following: first compute an approximation to
y * log2|x|, using rounding to nearest. If |x| is not too near from 1,
this approximation should be accurate enough, and in most cases enable
one to prove that there is no underflow nor overflow.
Otherwise, it should enable one to check only underflow or overflow,
instead of both cases as in the present case.
*/
if (cmp_x_1 * MPFR_SIGN (y) > 0)
{
mpfr_t t;
int negative, overflow;
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (t, 53);
/* we want a lower bound on y*log2|x|:
(i) if x > 0, it suffices to round log2(x) toward zero, and
to round y*o(log2(x)) toward zero too;
(ii) if x < 0, we first compute t = o(-x), with rounding toward 1,
and then follow as in case (1). */
if (MPFR_SIGN (x) > 0)
mpfr_log2 (t, x, MPFR_RNDZ);
else
{
mpfr_neg (t, x, (cmp_x_1 > 0) ? MPFR_RNDZ : MPFR_RNDU);
mpfr_log2 (t, t, MPFR_RNDZ);
}
mpfr_mul (t, t, y, MPFR_RNDZ);
overflow = mpfr_cmp_si (t, __gmpfr_emax) > 0;
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
if (overflow)
{
MPFR_LOG_MSG (("early overflow detection\n", 0));
negative = MPFR_SIGN(x) < 0 && is_odd (y);
return mpfr_overflow (z, rnd_mode, negative ? -1 : 1);
}
}
/* Basic underflow checking. One has:
* - if y > 0, |x^y| < 2^(EXP(x) * y);
* - if y < 0, |x^y| <= 2^((EXP(x) - 1) * y);
* so that one can compute a value ebound such that |x^y| < 2^ebound.
* If we have ebound <= emin - 2 (emin - 1 in directed rounding modes),
* then there is an underflow and we can decide the return value.
*/
if (MPFR_IS_NEG (y) ? (MPFR_GET_EXP (x) > 1) : (MPFR_GET_EXP (x) < 0))
{
mpfr_t tmp;
mpfr_eexp_t ebound;
int inex2;
/* We must restore the flags. */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, sizeof (mpfr_exp_t) * CHAR_BIT);
inex2 = mpfr_set_exp_t (tmp, MPFR_GET_EXP (x), MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
if (MPFR_IS_NEG (y))
{
inex2 = mpfr_sub_ui (tmp, tmp, 1, MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
}
mpfr_mul (tmp, tmp, y, MPFR_RNDU);
if (MPFR_IS_NEG (y))
mpfr_nextabove (tmp);
/* tmp doesn't necessarily fit in ebound, but that doesn't matter
since we get the minimum value in such a case. */
ebound = mpfr_get_exp_t (tmp, MPFR_RNDU);
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
if (MPFR_UNLIKELY (ebound <=
__gmpfr_emin - (rnd_mode == MPFR_RNDN ? 2 : 1)))
{
/* warning: mpfr_underflow rounds away from 0 for MPFR_RNDN */
MPFR_LOG_MSG (("early underflow detection\n", 0));
return mpfr_underflow (z,
rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
MPFR_SIGN (x) < 0 && is_odd (y) ? -1 : 1);
}
}
/* If y is an integer, we can use mpfr_pow_z (based on multiplications),
but if y is very large (I'm not sure about the best threshold -- VL),
we shouldn't use it, as it can be very slow and take a lot of memory
(and even crash or make other programs crash, as several hundred of
MBs may be necessary). Note that in such a case, either x = +/-2^b
(this case is handled below) or x^y cannot be represented exactly in
any precision supported by MPFR (the general case uses this property).
*/
if (y_is_integer && (MPFR_GET_EXP (y) <= 256))
{
mpz_t zi;
MPFR_LOG_MSG (("special code for y not too large integer\n", 0));
mpz_init (zi);
mpfr_get_z (zi, y, MPFR_RNDN);
inexact = mpfr_pow_z (z, x, zi, rnd_mode);
mpz_clear (zi);
return inexact;
}
/* Special case (+/-2^b)^Y which could be exact. If x is negative, then
necessarily y is a large integer. */
{
mpfr_exp_t b = MPFR_GET_EXP (x) - 1;
MPFR_ASSERTN (b >= LONG_MIN && b <= LONG_MAX); /* FIXME... */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), b) == 0)
{
mpfr_t tmp;
int sgnx = MPFR_SIGN (x);
MPFR_LOG_MSG (("special case (+/-2^b)^Y\n", 0));
/* now x = +/-2^b, so x^y = (+/-1)^y*2^(b*y) is exact whenever b*y is
an integer */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_PREC (y) + sizeof (long) * CHAR_BIT);
inexact = mpfr_mul_si (tmp, y, b, MPFR_RNDN); /* exact */
MPFR_ASSERTN (inexact == 0);
/* Note: as the exponent range has been extended, an overflow is not
possible (due to basic overflow and underflow checking above, as
the result is ~ 2^tmp), and an underflow is not possible either
because b is an integer (thus either 0 or >= 1). */
MPFR_CLEAR_FLAGS ();
inexact = mpfr_exp2 (z, tmp, rnd_mode);
mpfr_clear (tmp);
if (sgnx < 0 && is_odd (y))
{
mpfr_neg (z, z, rnd_mode);
inexact = -inexact;
}
/* Without the following, the overflows3 test in tpow.c fails. */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Case where |y * log(x)| is very small. Warning: x can be negative, in
that case y is a large integer. */
{
mpfr_t t;
mpfr_exp_t err;
/* We need an upper bound on the exponent of y * log(x). */
mpfr_init2 (t, 16);
if (MPFR_IS_POS(x))
mpfr_log (t, x, cmp_x_1 < 0 ? MPFR_RNDD : MPFR_RNDU); /* away from 0 */
else
{
/* if x < -1, round to +Inf, else round to zero */
mpfr_neg (t, x, (mpfr_cmp_si (x, -1) < 0) ? MPFR_RNDU : MPFR_RNDD);
mpfr_log (t, t, (mpfr_cmp_ui (t, 1) < 0) ? MPFR_RNDD : MPFR_RNDU);
}
MPFR_ASSERTN (MPFR_IS_PURE_FP (t));
err = MPFR_GET_EXP (y) + MPFR_GET_EXP (t);
mpfr_clear (t);
MPFR_CLEAR_FLAGS ();
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (z, __gmpfr_one, - err, 0,
(MPFR_SIGN (y) > 0) ^ (cmp_x_1 < 0),
rnd_mode, expo, {});
}
/* General case */
inexact = mpfr_pow_general (z, x, y, rnd_mode, y_is_integer, &expo);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
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);
}
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);
}
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;
}
static void
check_diverse (void)
{
mpfr_t x, y, z;
int inexact;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
/* check corner case cancel=0, but add_exp=1 */
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 4);
mpfr_set_prec (z, 2);
mpfr_setmax (y, __gmpfr_emax);
mpfr_set_str_binary (z, "0.1E-10"); /* tiny */
test_sub (x, y, z, MPFR_RNDN); /* should round to 2^emax, i.e. overflow */
if (!mpfr_inf_p (x) || mpfr_sgn (x) < 0)
{
printf ("Error in mpfr_sub(a,b,c,RNDN) for b=maxfloat, prec(a)<prec(b), c tiny\n");
exit (1);
}
/* other coverage test */
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 2);
mpfr_set_prec (z, 2);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_set_si (z, -2, MPFR_RNDN);
test_sub (x, y, z, MPFR_RNDD);
if (mpfr_cmp_ui (x, 3))
{
printf ("Error in mpfr_sub(1,-2,RNDD)\n");
exit (1);
}
mpfr_set_prec (x, 288);
mpfr_set_prec (y, 288);
mpfr_set_prec (z, 288);
mpfr_set_str_binary (y, "0.111000110011000001000111101010111011110011101001101111111110000011100101000001001010110010101010011001010100000001110011110001010101101010001011101110100100001011110100110000101101100011010001001011011010101010000010001101001000110010010111111011110001111101001000101101001100101100101000E80");
mpfr_set_str_binary (z, "0.100001111111101001011010001100110010100111001110000110011101001011010100001000000100111011010110110010000000000010101101011000010000110001110010100001100101011100100100001011000100011110000001010101000100011101001000010111100000111000111011001000100100011000100000010010111000000100100111E-258");
inexact = test_sub (x, y, z, MPFR_RNDN);
if (inexact <= 0)
{
printf ("Wrong inexact flag for prec=288\n");
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 63);
mpfr_set_prec (z, 63);
mpfr_set_str_binary (x, "0.101101111011011100100100100111E31");
mpfr_set_str_binary (y, "0.111110010010100100110101101010001001100101110001000101110111111E-1");
test_sub (z, x, y, MPFR_RNDN);
mpfr_set_str_binary (y, "0.1011011110110111001001001001101100000110110101101100101001011E31");
if (mpfr_cmp (z, y))
{
printf ("Error in mpfr_sub (5)\n");
printf ("expected "); mpfr_print_binary (y); puts ("");
printf ("got "); mpfr_print_binary (z); puts ("");
exit (1);
}
mpfr_set_prec (y, 63);
mpfr_set_prec (z, 63);
mpfr_set_str_binary (y, "0.1011011110110111001001001001101100000110110101101100101001011E31");
mpfr_sub_ui (z, y, 1541116494, MPFR_RNDN);
mpfr_set_str_binary (y, "-0.11111001001010010011010110101E-1");
if (mpfr_cmp (z, y))
{
printf ("Error in mpfr_sub (7)\n");
printf ("expected "); mpfr_print_binary (y); puts ("");
printf ("got "); mpfr_print_binary (z); puts ("");
exit (1);
}
mpfr_set_prec (y, 63);
mpfr_set_prec (z, 63);
mpfr_set_str_binary (y, "0.1011011110110111001001001001101100000110110101101100101001011E31");
mpfr_sub_ui (z, y, 1541116494, MPFR_RNDN);
mpfr_set_str_binary (y, "-0.11111001001010010011010110101E-1");
if (mpfr_cmp (z, y))
{
printf ("Error in mpfr_sub (6)\n");
printf ("expected "); mpfr_print_binary (y); puts ("");
printf ("got "); mpfr_print_binary (z); puts ("");
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "0.10110111101001110100100101111000E0");
mpfr_set_str_binary (y, "0.10001100100101000100110111000100E0");
if ((inexact = test_sub (x, x, y, MPFR_RNDN)))
{
printf ("Wrong inexact flag (2): got %d instead of 0\n", inexact);
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "0.11111000110111011000100111011010E0");
mpfr_set_str_binary (y, "0.10011111101111000100001000000000E-3");
if ((inexact = test_sub (x, x, y, MPFR_RNDN)))
{
printf ("Wrong inexact flag (1): got %d instead of 0\n", inexact);
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 33);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_str_binary (y, "-0.1E-32");
mpfr_add (x, x, y, MPFR_RNDN);
mpfr_set_str_binary (y, "0.111111111111111111111111111111111E0");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_sub (1 - 1E-33) with prec=33\n");
printf ("Expected "); mpfr_print_binary (y); puts ("");
printf ("got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 33);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_str_binary (y, "-0.1E-32");
mpfr_add (x, x, y, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in mpfr_sub (1 - 1E-33) with prec=32\n");
printf ("Expected 1.0, got "); mpfr_print_binary (x); puts ("");
exit (1);
}
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_set_prec (z, 64);
mpfr_set_str_binary (x, "1.1110111011110001110111011111111111101000011001011100101100101101");
mpfr_set_str_binary (y, "0.1110111011110001110111011111111111101000011001011100101100101100");
test_sub (z, x, y, MPFR_RNDZ);
if (mpfr_cmp_ui (z, 1))
{
printf ("Error in mpfr_sub (1)\n");
exit (1);
}
test_sub (z, x, y, MPFR_RNDU);
mpfr_set_str_binary (x, "1.000000000000000000000000000000000000000000000000000000000000001");
if (mpfr_cmp (z, x))
{
printf ("Error in mpfr_sub (2)\n");
printf ("Expected "); mpfr_print_binary (x); puts ("");
printf ("Got "); mpfr_print_binary (z); puts ("");
exit (1);
}
mpfr_set_str_binary (x, "1.1110111011110001110111011111111111101000011001011100101100101101");
test_sub (z, x, y, MPFR_RNDN);
if (mpfr_cmp_ui (z, 1))
{
printf ("Error in mpfr_sub (3)\n");
exit (1);
}
inexact = test_sub (z, x, y, MPFR_RNDA);
mpfr_set_str_binary (x, "1.000000000000000000000000000000000000000000000000000000000000001");
if (mpfr_cmp (z, x) || inexact <= 0)
{
printf ("Error in mpfr_sub (4)\n");
exit (1);
}
mpfr_set_prec (x, 66);
mpfr_set_str_binary (x, "1.11101110111100011101110111111111111010000110010111001011001010111");
test_sub (z, x, y, MPFR_RNDN);
if (mpfr_cmp_ui (z, 1))
{
printf ("Error in mpfr_sub (5)\n");
exit (1);
}
/* check in-place operations */
mpfr_set_ui (x, 1, MPFR_RNDN);
test_sub (x, x, x, MPFR_RNDN);
if (mpfr_cmp_ui(x, 0))
{
printf ("Error for mpfr_sub (x, x, x, MPFR_RNDN) with x=1.0\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_prec (z, 53);
mpfr_set_str1 (x, "1.229318102e+09");
mpfr_set_str1 (y, "2.32221184180698677665e+05");
test_sub (z, x, y, MPFR_RNDN);
if (mpfr_cmp_str1 (z, "1229085880.815819263458251953125"))
{
printf ("Error in mpfr_sub (1.22e9 - 2.32e5)\n");
printf ("expected 1229085880.815819263458251953125, got ");
mpfr_out_str(stdout, 10, 0, z, MPFR_RNDN);
putchar('\n');
exit (1);
}
mpfr_set_prec (x, 112);
mpfr_set_prec (y, 98);
mpfr_set_prec (z, 54);
mpfr_set_str_binary (x, "0.11111100100000000011000011100000101101010001000111E-401");
mpfr_set_str_binary (y, "0.10110000100100000101101100011111111011101000111000101E-464");
test_sub (z, x, y, MPFR_RNDN);
if (mpfr_cmp (z, x)) {
printf ("mpfr_sub(z, x, y) failed for prec(x)=112, prec(y)=98\n");
printf ("expected "); mpfr_print_binary (x); puts ("");
printf ("got "); mpfr_print_binary (z); puts ("");
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_div_2exp (x, x, 32, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_set_prec (x, 5);
mpfr_set_prec (y, 5);
mpfr_set_str_binary (x, "1e-12");
mpfr_set_ui (y, 1, MPFR_RNDN);
test_sub (x, y, x, MPFR_RNDD);
mpfr_set_str_binary (y, "0.11111");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_sub (x, y, x, MPFR_RNDD) for x=2^(-12), y=1\n");
exit (1);
}
mpfr_set_prec (x, 24);
mpfr_set_prec (y, 24);
mpfr_set_str_binary (x, "-0.100010000000000000000000E19");
mpfr_set_str_binary (y, "0.100000000000000000000100E15");
mpfr_add (x, x, y, MPFR_RNDD);
mpfr_set_str_binary (y, "-0.1E19");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_add (2)\n");
exit (1);
}
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 10);
mpfr_set_prec (z, 10);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_set_str_binary (z, "0.10001");
if (test_sub (x, y, z, MPFR_RNDN) <= 0)
{
printf ("Wrong inexact flag in x=mpfr_sub(0,z) for prec(z)>prec(x)\n");
exit (1);
}
if (test_sub (x, z, y, MPFR_RNDN) >= 0)
{
printf ("Wrong inexact flag in x=mpfr_sub(z,0) for prec(z)>prec(x)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
int
mpfr_tanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
/****** Declaration ******/
mpfr_t x;
int inexact;
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 value checking */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
/* tanh(inf) = 1 && tanh(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (xt), rnd_mode);
}
else /* tanh (0) = 0 and xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO(xt));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* tanh(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, 0,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, te;
mpfr_exp_t d;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
long int err; /* error */
int sign = MPFR_SIGN (xt);
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL (group);
/* First check for BIG overflow of exp(2*x):
For x > 0, exp(2*x) > 2^(2*x)
If 2 ^(2*x) > 2^emax or x>emax/2, there is an overflow */
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax/2) >= 0)) {
/* initialise of intermediary variables
since 'set_one' label assumes the variables have been
initialize */
MPFR_GROUP_INIT_2 (group, MPFR_PREC_MIN, t, te);
goto set_one;
}
/* Compute the precision of intermediary variable */
/* The optimal number of bits: see algorithms.tex */
Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 4;
/* if x is small, there will be a cancellation in exp(2x)-1 */
if (MPFR_GET_EXP (x) < 0)
Nt += -MPFR_GET_EXP (x);
/* initialise of intermediary variable */
MPFR_GROUP_INIT_2 (group, Nt, t, te);
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* tanh = (exp(2x)-1)/(exp(2x)+1) */
mpfr_mul_2ui (te, x, 1, MPFR_RNDN); /* 2x */
/* since x > 0, we can only have an overflow */
mpfr_exp (te, te, MPFR_RNDN); /* exp(2x) */
if (MPFR_UNLIKELY (MPFR_IS_INF (te))) {
set_one:
inexact = MPFR_FROM_SIGN_TO_INT (sign);
mpfr_set4 (y, __gmpfr_one, MPFR_RNDN, sign);
if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG_SIGN (sign)))
{
inexact = -inexact;
mpfr_nexttozero (y);
}
break;
}
d = MPFR_GET_EXP (te); /* For Error calculation */
mpfr_add_ui (t, te, 1, MPFR_RNDD); /* exp(2x) + 1*/
mpfr_sub_ui (te, te, 1, MPFR_RNDU); /* exp(2x) - 1*/
d = d - MPFR_GET_EXP (te);
mpfr_div (t, te, t, MPFR_RNDN); /* (exp(2x)-1)/(exp(2x)+1)*/
/* Calculation of the error */
d = MAX(3, d + 1);
err = Nt - (d + 1);
if (MPFR_LIKELY ((d <= Nt / 2) && MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, sign);
break;
}
/* if t=1, we still can round since |sinh(x)| < 1 */
if (MPFR_GET_EXP (t) == 1)
goto set_one;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, te);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
inexact = mpfr_check_range (y, inexact, rnd_mode);
return inexact;
}
int
main (int argc, char *argv[])
{
mpfr_t x;
mpfr_prec_t ret;
unsigned long i;
tests_start_mpfr ();
mpfr_init2 (x, 53);
/* Check special values */
mpfr_set_nan (x);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 0);
mpfr_set_inf (x, 1);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 0);
mpfr_set_inf (x, -1);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 0);
/* Some constants */
mpfr_set_ui (x, 1, MPFR_RNDN);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 1);
mpfr_set_ui (x, 17, MPFR_RNDN);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 5);
mpfr_set_ui (x, 42, MPFR_RNDN);
ret = mpfr_min_prec (x);
MPFR_ASSERTN (ret == 5);
mpfr_set_prec (x, 256);
for (i = 0; i <= 255; i++)
{
mpfr_set_ui_2exp (x, 1, i, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
ret = mpfr_min_prec (x);
if (ret != i + 1)
{
printf ("Error for x = 2^%lu + 1\n", i);
printf ("Expected %lu, got %lu\n", i + 1, (unsigned long) ret);
exit (1);
}
}
for (i = MPFR_PREC_MIN; i <= 255; i++)
{
mpfr_set_prec (x, i);
mpfr_set_ui_2exp (x, 1, i, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
ret = mpfr_min_prec (x);
if (ret != i)
{
printf ("Error for x = 2^%lu - 1\n", i);
printf ("Expected %lu, got %lu\n", i, (unsigned long) ret);
exit (1);
}
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
static void
special (void)
{
mpfr_t x, y;
int inex;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(NaN)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-Inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lngamma(+Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for lngamma(+0)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-0)\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y))
{
printf ("Error for lngamma(1)\n");
exit (1);
}
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-1)\n");
exit (1);
}
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y))
{
printf ("Error for lngamma(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, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y1, 10, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp (y, x))
{
printf ("mpfr_lngamma("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, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str (x, CHECK_Y2, 10, MPFR_RNDN);
if (MPFR_IS_NAN (y) || mpfr_cmp (y, x))
{
printf ("mpfr_lngamma("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, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDU);
mpfr_set_prec (x, 175);
mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (1)\n");
exit (1);
}
mpfr_set_prec (x, 21);
mpfr_set_prec (y, 8);
mpfr_set_ui (y, 120, MPFR_RNDN);
mpfr_lngamma (x, y, MPFR_RNDZ);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (y, "0.111000101000001100101E9");
if (MPFR_IS_NAN (x) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (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");
inex = mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_prec (x, 206);
mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error in mpfr_lngamma (768)\n");
exit (1);
}
if (inex >= 0)
{
printf ("Wrong flag for mpfr_lngamma (768)\n");
exit (1);
}
mpfr_set_prec (x, 4);
mpfr_set_prec (y, 4);
mpfr_set_str_binary (x, "0.1100E-66");
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100E6");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error for lngamma(0.1100E-66)\n");
exit (1);
}
mpfr_set_prec (x, 256);
mpfr_set_prec (y, 32);
mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
mpfr_set_prec (x, 32);
mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
if (MPFR_IS_NAN (y) || mpfr_cmp (x, y))
{
printf ("Error for lngamma(-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, MPFR_RNDN);
mpfr_sub_ui (x, x, 1, MPFR_RNDN);
mpfr_div_2ui (x, x, 1, MPFR_RNDN);
mpfr_lngamma (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for lngamma(-2^199-0.5)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
