/* idem than check for mpfr_add(x, y, x) */
void
check4 (double x, double y, mp_rnd_t rnd_mode)
{
double z1, z2;
mpfr_t xx, yy;
int neg;
neg = LONG_RAND() % 2;
mpfr_init2(xx, 53);
mpfr_init2(yy, 53);
mpfr_set_d(xx, x, rnd_mode);
mpfr_set_d(yy, y, rnd_mode);
if (neg) mpfr_sub(xx, yy, xx, rnd_mode);
else mpfr_add(xx, yy, xx, rnd_mode);
mpfr_set_machine_rnd_mode(rnd_mode);
z1 = (neg) ? y-x : x+y;
z2 = mpfr_get_d1 (xx);
mpfr_set_d (yy, z2, GMP_RNDN);
/* check that xx is representable as a double and no overflow occurred */
if ((mpfr_cmp (xx, yy) == 0) && (z1 != z2)) {
printf("expected result is %1.20e, got %1.20e\n", z1, z2);
printf("mpfr_%s(x,y,x) failed for x=%1.20e y=%1.20e with rnd_mode=%s\n",
(neg) ? "sub" : "add", x, y, mpfr_print_rnd_mode(rnd_mode));
exit(1);
}
mpfr_clear(xx); mpfr_clear(yy);
}
/* checks that x+y gives the same results in double
and with mpfr with 53 bits of precision */
void
_check (double x, double y, double z1, mp_rnd_t rnd_mode, unsigned int px,
unsigned int py, unsigned int pz)
{
double z2; mpfr_t xx,yy,zz; int cert=0;
mpfr_init2(xx, px);
mpfr_init2(yy, py);
mpfr_init2(zz, pz);
mpfr_set_d(xx, x, rnd_mode);
mpfr_set_d(yy, y, rnd_mode);
mpfr_add(zz, xx, yy, rnd_mode);
#ifdef MPFR_HAVE_FESETROUND
mpfr_set_machine_rnd_mode(rnd_mode);
if (px==53 && py==53 && pz==53) cert=1;
#endif
if (z1==0.0) z1=x+y; else cert=1;
z2 = mpfr_get_d1 (zz);
mpfr_set_d (yy, z2, GMP_RNDN);
if (!mpfr_cmp (zz, yy) && cert && z1!=z2 && !(isnan(z1) && isnan(z2))) {
printf("expected sum is %1.20e, got %1.20e\n",z1,z2);
printf("mpfr_add failed for x=%1.20e y=%1.20e with rnd_mode=%s\n",
x, y, mpfr_print_rnd_mode(rnd_mode));
exit(1);
}
mpfr_clear(xx); mpfr_clear(yy); mpfr_clear(zz);
}
/* idem than check for mpfr_add(x, x, x) */
void
check5 (double x, mp_rnd_t rnd_mode)
{
double z1,z2; mpfr_t xx, yy; int neg;
mpfr_init2(xx, 53);
mpfr_init2(yy, 53);
neg = LONG_RAND() % 2;
mpfr_set_d(xx, x, rnd_mode);
if (neg) mpfr_sub(xx, xx, xx, rnd_mode);
else mpfr_add(xx, xx, xx, rnd_mode);
mpfr_set_machine_rnd_mode(rnd_mode);
z1 = (neg) ? x-x : x+x;
z2 = mpfr_get_d1 (xx);
mpfr_set_d (yy, z2, GMP_RNDN);
/* check NaNs first since mpfr_cmp does not like them */
if (!(isnan(z1) && isnan(z2)) && !mpfr_cmp (xx, yy) && z1!=z2)
{
printf ("expected result is %1.20e, got %1.20e\n",z1,z2);
printf ("mpfr_%s(x,x,x) failed for x=%1.20e with rnd_mode=%s\n",
(neg) ? "sub" : "add", x, mpfr_print_rnd_mode (rnd_mode));
exit (1);
}
mpfr_clear(xx);
mpfr_clear(yy);
}
int
main (int argc, char *argv[])
{
mpfr_t x;
int p;
mp_rnd_t rnd;
p = (argc>1) ? atoi(argv[1]) : 53;
rnd = (argc>2) ? atoi(argv[2]) : GMP_RNDZ;
mpfr_init (x);
check (2, 1000);
/* check precision of 2 bits */
mpfr_set_prec (x, 2);
mpfr_const_log2 (x, GMP_RNDN);
if (mpfr_get_d1 (x) != 0.75)
{
fprintf (stderr, "mpfr_const_log2 failed for prec=2, rnd=GMP_RNDN\n");
fprintf (stderr, "expected 0.75, got %f\n", mpfr_get_d1 (x));
exit (1);
}
if (argc>=2)
{
mpfr_set_prec (x, p);
mpfr_const_log2 (x, rnd);
printf ("log(2)=");
mpfr_out_str (stdout, 10, 0, x, rnd);
putchar('\n');
}
mpfr_set_prec (x, 53);
mpfr_const_log2 (x, rnd);
if (mpfr_get_d1 (x) != 6.9314718055994530941e-1)
{
fprintf (stderr, "mpfr_const_log2 failed for prec=53\n");
exit (1);
}
mpfr_clear(x);
return 0;
}
void
check53 (double x, double sin_x, mp_rnd_t rnd_mode)
{
mpfr_t xx, s;
mpfr_init2 (xx, 53);
mpfr_init2 (s, 53);
mpfr_set_d (xx, x, rnd_mode); /* should be exact */
mpfr_sin (s, xx, rnd_mode);
if (mpfr_get_d1 (s) != sin_x && (!isnan(sin_x) || !mpfr_nan_p(s)))
{
fprintf (stderr, "mpfr_sin failed for x=%1.20e, rnd=%s\n", x,
mpfr_print_rnd_mode (rnd_mode));
fprintf (stderr, "mpfr_sin gives sin(x)=%1.20e, expected %1.20e\n",
mpfr_get_d1 (s), sin_x);
exit(1);
}
mpfr_clear (xx);
mpfr_clear (s);
}
/* checks when source and destination are equal */
void
check_same (void)
{
mpfr_t x;
mpfr_init(x); mpfr_set_d(x, 1.0, GMP_RNDZ);
mpfr_add(x, x, x, GMP_RNDZ);
if (mpfr_get_d1 (x) != 2.0) {
printf("Error when all 3 operands are equal\n"); exit(1);
}
mpfr_clear(x);
}
int
main (int argc, char *argv[])
{
double x, z; mpfr_t w; unsigned long k;
mpfr_init2(w, 53);
mpfr_set_inf (w, 1);
mpfr_mul_2exp (w, w, 10, GMP_RNDZ);
if (!MPFR_IS_INF(w)) { fprintf(stderr, "Inf != Inf"); exit(-1); }
mpfr_set_nan (w);
mpfr_mul_2exp (w, w, 10, GMP_RNDZ);
if (!MPFR_IS_NAN(w)) { fprintf(stderr, "NaN != NaN"); exit(-1); }
SEED_RAND (time(NULL));
for (k = 0; k < 100000; k++) {
x = DBL_RAND ();
mpfr_set_d (w, x, 0);
mpfr_mul_2exp (w, w, 10, GMP_RNDZ);
if (x != (z = mpfr_get_d1 (w)/1024))
{
fprintf(stderr, "%f != %f\n", x, z);
return -1;
}
mpfr_set_d(w, x, 0);
mpfr_div_2exp(w, w, 10, GMP_RNDZ);
if (x != (z = mpfr_get_d1 (w)*1024))
{
fprintf(stderr, "%f != %f\n", x, z);
mpfr_clear(w);
return -1;
}
}
mpfr_clear(w);
return 0;
}
int
main (int argc, char *argv[])
{
mpfr_t x;
#ifdef HAVE_INFS
check53 (DBL_NAN, DBL_NAN, GMP_RNDN);
check53 (DBL_POS_INF, DBL_NAN, GMP_RNDN);
check53 (DBL_NEG_INF, DBL_NAN, GMP_RNDN);
#endif
/* worst case from PhD thesis of Vincent Lefe`vre: x=8980155785351021/2^54 */
check53 (4.984987858808754279e-1, 4.781075595393330379e-1, GMP_RNDN);
check53 (4.984987858808754279e-1, 4.781075595393329824e-1, GMP_RNDD);
check53 (4.984987858808754279e-1, 4.781075595393329824e-1, GMP_RNDZ);
check53 (4.984987858808754279e-1, 4.781075595393330379e-1, GMP_RNDU);
check53 (1.00031274099908640274, 8.416399183372403892e-1, GMP_RNDN);
check53 (1.00229256850978698523, 8.427074524447979442e-1, GMP_RNDZ);
check53 (1.00288304857059840103, 8.430252033025980029e-1, GMP_RNDZ);
check53 (1.00591265847407274059, 8.446508805292128885e-1, GMP_RNDN);
check53 (1.00591265847407274059, 8.446508805292128885e-1, GMP_RNDN);
mpfr_init2 (x, 2);
mpfr_set_d (x, 0.5, GMP_RNDN);
mpfr_sin (x, x, GMP_RNDD);
if (mpfr_get_d1 (x) != 0.375)
{
fprintf (stderr, "mpfr_sin(0.5, GMP_RNDD) failed with precision=2\n");
exit (1);
}
/* bug found by Kevin Ryde */
mpfr_const_pi (x, GMP_RNDN);
mpfr_mul_ui (x, x, 3L, GMP_RNDN);
mpfr_div_ui (x, x, 2L, GMP_RNDN);
mpfr_sin (x, x, GMP_RNDN);
if (mpfr_cmp_ui (x, 0) >= 0)
{
fprintf (stderr, "Error: wrong sign for sin(3*Pi/2)\n");
exit (1);
}
mpfr_clear (x);
test_generic (2, 100, 80);
return 0;
}
static void
check_min(void)
{
double d, e;
mpfr_t u;
d = 1.0; while (d > (DBL_MIN * 2.0)) d /= 2.0;
mpfr_init(u);
if (mpfr_set_d(u, d, MPFR_RNDN) == 0)
{
/* If setting is exact */
e = mpfr_get_d1(u);
if (e != d)
{
printf("get_d(set_d)(2): %1.20e != %1.20e\n", d, e);
exit(1);
}
}
mpfr_clear(u);
}
void
checknan (double x, double y, mp_rnd_t rnd_mode, unsigned int px,
unsigned int py, unsigned int pz)
{
double z2; mpfr_t xx, yy, zz;
mpfr_init2(xx, px);
mpfr_init2(yy, py);
mpfr_init2(zz, pz);
mpfr_set_d(xx, x, rnd_mode);
mpfr_set_d(yy, y, rnd_mode);
mpfr_add(zz, xx, yy, rnd_mode);
#ifdef MPFR_HAVE_FESETROUND
mpfr_set_machine_rnd_mode(rnd_mode);
#endif
if (MPFR_IS_NAN(zz) == 0) { printf("Error, not an MPFR_NAN for xx = %1.20e, y = %1.20e\n", x, y); exit(1); }
z2 = mpfr_get_d1 (zz);
if (!isnan(z2)) { printf("Error, not a NaN after conversion, xx = %1.20e yy = %1.20e, got %1.20e\n", x, y, z2); exit(1); }
mpfr_clear(xx); mpfr_clear(yy); mpfr_clear(zz);
}
void
check2 (double x, int px, double y, int py, int pz, mp_rnd_t rnd_mode)
{
mpfr_t xx, yy, zz; double z,z2; int u;
mpfr_init2(xx,px); mpfr_init2(yy,py); mpfr_init2(zz,pz);
mpfr_set_d(xx, x, rnd_mode);
mpfr_set_d(yy, y, rnd_mode);
mpfr_add(zz, xx, yy, rnd_mode);
mpfr_set_machine_rnd_mode(rnd_mode);
z = x+y; z2=mpfr_get_d1 (zz); u=ulp(z,z2);
/* one ulp difference is possible due to composed rounding */
if (px>=53 && py>=53 && pz>=53 && ABS(u)>1) {
printf("x=%1.20e,%d y=%1.20e,%d pz=%d,rnd=%s\n",
x,px,y,py,pz,mpfr_print_rnd_mode(rnd_mode));
printf("got %1.20e\n",z2);
printf("result should be %1.20e (diff=%d ulp)\n",z,u);
mpfr_set_d(zz, z, rnd_mode);
printf("i.e."); mpfr_print_binary(zz); putchar('\n');
exit(1); }
mpfr_clear(xx); mpfr_clear(yy); mpfr_clear(zz);
}
/* idem than check for mpfr_add(x, x, y) */
void
check3 (double x, double y, mp_rnd_t rnd_mode)
{
double z1,z2; mpfr_t xx,yy; int neg;
neg = LONG_RAND() % 2;
mpfr_init2(xx, 53);
mpfr_init2(yy, 53);
mpfr_set_d(xx, x, rnd_mode);
mpfr_set_d(yy, y, rnd_mode);
if (neg) mpfr_sub(xx, xx, yy, rnd_mode);
else mpfr_add(xx, xx, yy, rnd_mode);
mpfr_set_machine_rnd_mode(rnd_mode);
z1 = (neg) ? x-y : x+y;
z2 = mpfr_get_d1 (xx);
mpfr_set_d (yy, z2, GMP_RNDN);
if (!mpfr_cmp (xx, yy) && z1!=z2 && !(isnan(z1) && isnan(z2))) {
printf("expected result is %1.20e, got %1.20e\n",z1,z2);
printf("mpfr_%s(x,x,y) failed for x=%1.20e y=%1.20e with rnd_mode=%u\n",
(neg) ? "sub" : "add",x,y,rnd_mode);
exit(1);
}
mpfr_clear(xx); mpfr_clear(yy);
}
/* use Brent's formula exp(x) = (1+r+r^2/2!+r^3/3!+...)^(2^K)*2^n
where x = n*log(2)+(2^K)*r
together with Brent-Kung O(t^(1/2)) algorithm for the evaluation of
power series. The resulting complexity is O(n^(1/3)*M(n)).
*/
int
mpfr_exp_2 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
long n;
unsigned long K, k, l, err; /* FIXME: Which type ? */
int error_r;
mp_exp_t exps;
mp_prec_t q, precy;
int inexact;
mpfr_t r, s, t;
mpz_t ss;
TMP_DECL(marker);
precy = MPFR_PREC(y);
MPFR_TRACE ( printf("Py=%d Px=%d", MPFR_PREC(y), MPFR_PREC(x)) );
MPFR_TRACE ( MPFR_DUMP (x) );
n = (long) (mpfr_get_d1 (x) / LOG2);
/* error bounds the cancelled bits in x - n*log(2) */
if (MPFR_UNLIKELY(n == 0))
error_r = 0;
else
count_leading_zeros (error_r, (mp_limb_t) (n < 0) ? -n : n);
error_r = BITS_PER_MP_LIMB - error_r + 2;
/* for the O(n^(1/2)*M(n)) method, the Taylor series computation of
n/K terms costs about n/(2K) multiplications when computed in fixed
point */
K = (precy < SWITCH) ? __gmpfr_isqrt ((precy + 1) / 2)
: __gmpfr_cuberoot (4*precy);
l = (precy - 1) / K + 1;
err = K + MPFR_INT_CEIL_LOG2 (2 * l + 18);
/* add K extra bits, i.e. failure probability <= 1/2^K = O(1/precy) */
q = precy + err + K + 5;
/*q = ( (q-1)/BITS_PER_MP_LIMB + 1) * BITS_PER_MP_LIMB; */
mpfr_init2 (r, q + error_r);
mpfr_init2 (s, q + error_r);
mpfr_init2 (t, q);
/* the algorithm consists in computing an upper bound of exp(x) using
a precision of q bits, and see if we can round to MPFR_PREC(y) taking
into account the maximal error. Otherwise we increase q. */
for (;;)
{
MPFR_TRACE ( printf("n=%d K=%d l=%d q=%d\n",n,K,l,q) );
/* if n<0, we have to get an upper bound of log(2)
in order to get an upper bound of r = x-n*log(2) */
mpfr_const_log2 (s, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* s is within 1 ulp of log(2) */
mpfr_mul_ui (r, s, (n < 0) ? -n : n, (n >= 0) ? GMP_RNDZ : GMP_RNDU);
/* r is within 3 ulps of n*log(2) */
if (n < 0)
mpfr_neg (r, r, GMP_RNDD); /* exact */
/* r = floor(n*log(2)), within 3 ulps */
MPFR_TRACE ( MPFR_DUMP (x) );
MPFR_TRACE ( MPFR_DUMP (r) );
mpfr_sub (r, x, r, GMP_RNDU);
/* possible cancellation here: the error on r is at most
3*2^(EXP(old_r)-EXP(new_r)) */
while (MPFR_IS_NEG (r))
{ /* initial approximation n was too large */
n--;
mpfr_add (r, r, s, GMP_RNDU);
}
mpfr_prec_round (r, q, GMP_RNDU);
MPFR_TRACE ( MPFR_DUMP (r) );
MPFR_ASSERTD (MPFR_IS_POS (r));
mpfr_div_2ui (r, r, K, GMP_RNDU); /* r = (x-n*log(2))/2^K, exact */
TMP_MARK(marker);
MY_INIT_MPZ(ss, 3 + 2*((q-1)/BITS_PER_MP_LIMB));
exps = mpfr_get_z_exp (ss, s);
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! */
l = (precy < SWITCH) ?
mpfr_exp2_aux (ss, r, q, &exps) /* naive method */
: mpfr_exp2_aux2 (ss, r, q, &exps); /* Brent/Kung method */
MPFR_TRACE(printf("l=%d q=%d (K+l)*q^2=%1.3e\n", l, q, (K+l)*(double)q*q));
for (k = 0; k < K; k++)
{
mpz_mul (ss, ss, ss);
exps <<= 1;
exps += mpz_normalize (ss, ss, q);
}
mpfr_set_z (s, ss, GMP_RNDN);
MPFR_SET_EXP(s, MPFR_GET_EXP (s) + exps);
TMP_FREE(marker); /* don't need ss anymore */
if (n>0)
mpfr_mul_2ui(s, s, n, GMP_RNDU);
else
mpfr_div_2ui(s, s, -n, GMP_RNDU);
/* error is at most 2^K*(3l*(l+1)) ulp for mpfr_exp2_aux */
l = (precy < SWITCH) ? 3*l*(l+1) : l*(l+4) ;
k = MPFR_INT_CEIL_LOG2 (l);
/* k = 0; while (l) { k++; l >>= 1; } */
/* now k = ceil(log(error in ulps)/log(2)) */
K += k;
MPFR_TRACE ( printf("after mult. by 2^n:\n") );
MPFR_TRACE ( MPFR_DUMP (s) );
MPFR_TRACE ( printf("err=%d bits\n", K) );
if (mpfr_can_round (s, q - K, GMP_RNDN, GMP_RNDZ,
precy + (rnd_mode == GMP_RNDN)) )
break;
MPFR_TRACE (printf("prec++, use %d\n", q+BITS_PER_MP_LIMB) );
MPFR_TRACE (printf("q=%d q-K=%d precy=%d\n",q,q-K,precy) );
q += BITS_PER_MP_LIMB;
mpfr_set_prec (r, q);
mpfr_set_prec (s, q);
mpfr_set_prec (t, q);
}
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
mpfr_clear (t);
return inexact;
}
static void
test_urandom (long nbtests, mpfr_prec_t prec, mpfr_rnd_t rnd, long bit_index,
int verbose)
{
mpfr_t x;
int *tab, size_tab, k, sh, xn;
double d, av = 0, var = 0, chi2 = 0, th;
mpfr_exp_t emin;
mp_size_t limb_index = 0;
mp_limb_t limb_mask = 0;
long count = 0;
int i;
int inex = 1;
size_tab = (nbtests >= 1000 ? nbtests / 50 : 20);
tab = (int *) calloc (size_tab, sizeof(int));
if (tab == NULL)
{
fprintf (stderr, "trandom: can't allocate memory in test_urandom\n");
exit (1);
}
mpfr_init2 (x, prec);
xn = 1 + (prec - 1) / mp_bits_per_limb;
sh = xn * mp_bits_per_limb - prec;
if (bit_index >= 0 && bit_index < prec)
{
/* compute the limb index and limb mask to fetch the bit #bit_index */
limb_index = (prec - bit_index) / mp_bits_per_limb;
i = 1 + bit_index - (bit_index / mp_bits_per_limb) * mp_bits_per_limb;
limb_mask = MPFR_LIMB_ONE << (mp_bits_per_limb - i);
}
for (k = 0; k < nbtests; k++)
{
i = mpfr_urandom (x, RANDS, rnd);
inex = (i != 0) && inex;
/* check that lower bits are zero */
if (MPFR_MANT(x)[0] & MPFR_LIMB_MASK(sh) && !MPFR_IS_ZERO (x))
{
printf ("Error: mpfr_urandom() returns invalid numbers:\n");
mpfr_print_binary (x); puts ("");
exit (1);
}
/* check that the value is in [0,1] */
if (mpfr_cmp_ui (x, 0) < 0 || mpfr_cmp_ui (x, 1) > 0)
{
printf ("Error: mpfr_urandom() returns number outside [0, 1]:\n");
mpfr_print_binary (x); puts ("");
exit (1);
}
d = mpfr_get_d1 (x); av += d; var += d*d;
i = (int)(size_tab * d);
if (d == 1.0) i --;
tab[i]++;
if (limb_mask && (MPFR_MANT (x)[limb_index] & limb_mask))
count ++;
}
if (inex == 0)
{
/* one call in the loop pretended to return an exact number! */
printf ("Error: mpfr_urandom() returns a zero ternary value.\n");
exit (1);
}
/* coverage test */
emin = mpfr_get_emin ();
for (k = 0; k < 5; k++)
{
set_emin (k+1);
inex = mpfr_urandom (x, RANDS, rnd);
if (( (rnd == MPFR_RNDZ || rnd == MPFR_RNDD)
&& (!MPFR_IS_ZERO (x) || inex != -1))
|| ((rnd == MPFR_RNDU || rnd == MPFR_RNDA)
&& (mpfr_cmp_ui (x, 1 << k) != 0 || inex != +1))
|| (rnd == MPFR_RNDN
&& (k > 0 || mpfr_cmp_ui (x, 1 << k) != 0 || inex != +1)
&& (!MPFR_IS_ZERO (x) || inex != -1)))
{
printf ("Error: mpfr_urandom() do not handle correctly a restricted"
" exponent range.\nrounding mode: %s\nternary value: %d\n"
"random value: ", mpfr_print_rnd_mode (rnd), inex);
mpfr_print_binary (x); puts ("");
exit (1);
}
}
set_emin (emin);
mpfr_clear (x);
if (!verbose)
{
free(tab);
return;
}
av /= nbtests;
var = (var / nbtests) - av * av;
th = (double)nbtests / size_tab;
printf ("Average = %.5f\nVariance = %.5f\n", av, var);
printf ("Repartition for urandom with rounding mode %s. "
"Each integer should be close to %d.\n",
mpfr_print_rnd_mode (rnd), (int)th);
for (k = 0; k < size_tab; k++)
{
chi2 += (tab[k] - th) * (tab[k] - th) / th;
printf("%d ", tab[k]);
if (((k+1) & 7) == 0)
printf("\n");
}
printf("\nChi2 statistics value (with %d degrees of freedom) : %.5f\n",
size_tab - 1, chi2);
if (limb_mask)
printf ("Bit #%ld is set %ld/%ld = %.1f %% of time\n",
bit_index, count, nbtests, count * 100.0 / nbtests);
puts ("");
free(tab);
return;
}
int
main (int argc, char *argv[])
{
mpfr_t x;
long k, z, d;
unsigned long zl, dl, N;
int inex;
mpfr_init2(x, 100);
SEED_RAND (time(NULL));
N = (argc==1) ? 1000000 : atoi(argv[1]);
for (k = 1; k <= N; k++)
{
z = random() - (1 << 30);
inex = mpfr_set_si(x, z, GMP_RNDZ);
d = (long) mpfr_get_d1 (x);
if (d != z) {
fprintf(stderr, "Error in mpfr_set_si: expected %ld got %ld\n", z, d);
exit(1);
}
if (inex)
{
fprintf(stderr,
"Error in mpfr_set_si: inex value incorrect for %ld: %d\n",
z, inex);
exit(1);
}
}
for (k = 1; k <= N; k++)
{
zl = random();
inex = mpfr_set_ui (x, zl, GMP_RNDZ);
dl = (unsigned long) mpfr_get_d1 (x);
if (dl != zl) {
fprintf(stderr, "Error in mpfr_set_ui: expected %lu got %lu\n", zl, dl);
exit(1);
}
if (inex)
{
fprintf(stderr,
"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, GMP_RNDZ) >= 0)
{
fprintf (stderr, "Wrong inexact flag for x=5, rnd=GMP_RNDZ\n");
exit (1);
}
mpfr_set_prec (x, 2);
if (mpfr_set_si (x, -5, GMP_RNDZ) <= 0)
{
fprintf (stderr, "Wrong inexact flag for x=-5, rnd=GMP_RNDZ\n");
exit (1);
}
mpfr_set_prec (x, 3);
inex = mpfr_set_si(x, 77617, GMP_RNDD); /* should be 65536 */
if (MPFR_MANT(x)[0] != ((mp_limb_t)1 << (mp_bits_per_limb-1))
|| inex >= 0)
{
fprintf(stderr, "Error in mpfr_set_si(x:3, 77617, GMP_RNDD)\n");
mpfr_print_binary(x);
putchar('\n');
exit(1);
}
inex = mpfr_set_ui(x, 77617, GMP_RNDD); /* should be 65536 */
if (MPFR_MANT(x)[0] != ((mp_limb_t)1 << (mp_bits_per_limb-1))
|| inex >= 0)
{
fprintf(stderr, "Error in mpfr_set_ui(x:3, 77617, GMP_RNDD)\n");
mpfr_print_binary(x);
putchar('\n');
exit(1);
}
mpfr_set_prec(x, 2);
inex = mpfr_set_si(x, 33096, GMP_RNDU);
if (mpfr_get_d1 (x) != 49152.0 || inex <= 0)
{
fprintf(stderr, "Error in mpfr_set_si, expected 49152, got %lu, inex %d\n",
(unsigned long) mpfr_get_d1 (x), inex);
exit(1);
}
inex = mpfr_set_ui(x, 33096, GMP_RNDU);
if (mpfr_get_d1 (x) != 49152.0)
{
fprintf(stderr, "Error in mpfr_set_ui, expected 49152, got %lu, inex %d\n",
(unsigned long) mpfr_get_d1 (x), inex);
exit(1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_set_ui (x, 0, GMP_RNDN);
if (MPFR_SIGN (x) < 0)
{
fprintf (stderr, "mpfr_set_ui (x, 0) gives -0\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_set_si (x, 0, GMP_RNDN);
if (MPFR_SIGN (x) < 0)
{
fprintf (stderr, "mpfr_set_si (x, 0) gives -0\n");
exit (1);
}
/* check potential bug in case mp_limb_t is unsigned */
mpfr_set_emax (0);
mpfr_set_si (x, -1, GMP_RNDN);
if (mpfr_sgn (x) >= 0)
{
fprintf (stderr, "mpfr_set_si (x, -1) fails\n");
exit (1);
}
mpfr_set_emax (5);
mpfr_set_prec (x, 2);
mpfr_set_si (x, -31, GMP_RNDN);
if (mpfr_sgn (x) >= 0)
{
fprintf (stderr, "mpfr_set_si (x, -31) fails\n");
exit (1);
}
mpfr_clear(x);
return 0;
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, z;
unsigned long k, n;
volatile double d;
double dd;
tests_start_mpfr ();
mpfr_test_init ();
#ifndef MPFR_DOUBLE_SPEC
printf ("Warning! The MPFR_DOUBLE_SPEC macro is not defined. This means\n"
"that you do not have a conforming C implementation and problems\n"
"may occur with conversions between MPFR numbers and standard\n"
"floating-point types. Please contact the MPFR team.\n");
#elif MPFR_DOUBLE_SPEC == 0
/*
printf ("The type 'double' of your C implementation does not seem to\n"
"correspond to the IEEE-754 double precision. Though code has\n"
"been written to support such implementations, tests have been\n"
"done only on IEEE-754 double-precision implementations and\n"
"conversions between MPFR numbers and standard floating-point\n"
"types may be inaccurate. You may wish to contact the MPFR team\n"
"for further testing.\n");
*/
printf ("The type 'double' of your C implementation does not seem to\n"
"correspond to the IEEE-754 double precision. Such particular\n"
"implementations are not supported yet, and conversions between\n"
"MPFR numbers and standard floating-point types may be very\n"
"inaccurate.\n");
printf ("FLT_RADIX = %ld\n", (long) FLT_RADIX);
printf ("DBL_MANT_DIG = %ld\n", (long) DBL_MANT_DIG);
printf ("DBL_MIN_EXP = %ld\n", (long) DBL_MIN_EXP);
printf ("DBL_MAX_EXP = %ld\n", (long) DBL_MAX_EXP);
#endif
mpfr_init (x);
mpfr_set_nan (x);
d = mpfr_get_d (x, MPFR_RNDN);
if (! DOUBLE_ISNAN (d))
{
printf ("ERROR for NAN (1)\n");
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_d (x, d, MPFR_RNDN);
if (! mpfr_nan_p (x))
{
printf ("ERROR for NAN (2)\n");
#ifdef MPFR_NANISNAN
printf ("The reason is that NAN == NAN. Please look at the configure "
"output\nand Section \"In case of problem\" of the INSTALL "
"file.\n");
#endif
exit (1);
}
d = 0.0;
mpfr_set_d (x, d, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
d = -d;
mpfr_set_d (x, d, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) != 0 || MPFR_IS_POS(x))
{
printf ("Error in mpfr_set_d on -0\n");
exit (1);
}
mpfr_set_inf (x, 1);
d = mpfr_get_d (x, MPFR_RNDN);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_d (x, d, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_inf (x, -1);
d = mpfr_get_d (x, MPFR_RNDN);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_d (x, d, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_prec (x, 2);
/* checks that denormalized are not flushed to zero */
d = DBL_MIN; /* 2^(-1022) */
for (n=0; n<52; n++, d /= 2.0)
if (d != 0.0) /* should be 2^(-1022-n) */
{
mpfr_set_d (x, d, MPFR_RNDN);
if (mpfr_cmp_ui_2exp (x, 1, -1022-n))
{
printf ("Wrong result for d=2^(%ld), ", -1022-n);
printf ("got ");
mpfr_out_str (stdout, 10, 10, x, MPFR_RNDN);
printf ("\n");
mpfr_print_binary (x);
puts ("");
exit (1);
}
}
/* checks that rounds to nearest sets the last
bit to zero in case of equal distance */
mpfr_set_d (x, 5.0, MPFR_RNDN);
if (mpfr_cmp_ui (x, 4))
{
printf ("Error in tset_d: expected 4.0, got ");
mpfr_print_binary (x); putchar('\n');
exit (1);
}
mpfr_set_d (x, -5.0, MPFR_RNDN);
if (mpfr_cmp_si (x, -4))
{
printf ("Error in tset_d: expected -4.0, got ");
mpfr_print_binary (x); putchar('\n');
exit (1);
}
mpfr_set_d (x, 9.84891017624509146344e-01, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in tset_d: expected 1.0, got ");
mpfr_print_binary (x); putchar('\n');
exit (1);
}
mpfr_init2 (z, 32);
mpfr_set_d (z, 1.0, (mpfr_rnd_t) 0);
if (mpfr_cmp_ui (z, 1))
{
mpfr_print_binary (z); puts ("");
printf ("Error: 1.0 != 1.0\n");
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_init2 (y, 53);
mpfr_set_d (x, d=-1.08007920352320089721e+150, (mpfr_rnd_t) 0);
if (mpfr_get_d1 (x) != d)
{
mpfr_print_binary (x); puts ("");
printf ("Error: get_d o set_d <> identity for d = %1.20e %1.20e\n",
d, mpfr_get_d1 (x));
exit (1);
}
mpfr_set_d (x, 8.06294740693074521573e-310, (mpfr_rnd_t) 0);
d = -6.72658901114033715233e-165;
mpfr_set_d (x, d, (mpfr_rnd_t) 0);
if (d != mpfr_get_d1 (x))
{
mpfr_print_binary (x);
puts ("");
printf ("Error: get_d o set_d <> identity for d = %1.20e %1.20e\n",
d, mpfr_get_d1 (x));
exit (1);
}
n = (argc==1) ? 500000 : atoi(argv[1]);
for (k = 1; k <= n; k++)
{
do
{
d = DBL_RAND ();
}
#ifdef HAVE_DENORMS
while (0);
#else
while (ABS(d) < DBL_MIN);
#endif
mpfr_set_d (x, d, (mpfr_rnd_t) 0);
dd = mpfr_get_d1 (x);
if (d != dd && !(Isnan(d) && Isnan(dd)))
{
printf ("Mismatch on : %1.18g != %1.18g\n", d, mpfr_get_d1 (x));
mpfr_print_binary (x);
puts ("");
exit (1);
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
tests_end_mpfr ();
return 0;
}
void
check64 (void)
{
mpfr_t x, t, u;
mpfr_init (x);
mpfr_init (t);
mpfr_init (u);
mpfr_set_prec (x, 29);
mpfr_set_str_raw (x, "1.1101001000101111011010010110e-3");
mpfr_set_prec (t, 58);
mpfr_set_str_raw (t, "0.11100010011111001001100110010111110110011000000100101E-1");
mpfr_set_prec (u, 29);
mpfr_add (u, x, t, GMP_RNDD);
mpfr_set_str_raw (t, "1.0101011100001000011100111110e-1");
if (mpfr_cmp (u, t))
{
fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=29, prec(t)=58\n");
printf ("expected "); mpfr_out_str (stdout, 2, 29, t, GMP_RNDN);
putchar ('\n');
printf ("got "); mpfr_out_str (stdout, 2, 29, u, GMP_RNDN);
putchar ('\n');
exit(1);
}
mpfr_set_prec (x, 4);
mpfr_set_str_raw (x, "-1.0E-2");
mpfr_set_prec (t, 2);
mpfr_set_str_raw (t, "-1.1e-2");
mpfr_set_prec (u, 2);
mpfr_add (u, x, t, GMP_RNDN);
if (MPFR_MANT(u)[0] << 2)
{
fprintf (stderr, "result not normalized for prec=2\n");
mpfr_print_binary (u); putchar ('\n');
exit (1);
}
mpfr_set_str_raw (t, "-1.0e-1");
if (mpfr_cmp (u, t))
{
fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=4, prec(t)=2\n");
printf ("expected -1.0e-1\n");
printf ("got "); mpfr_out_str (stdout, 2, 4, u, GMP_RNDN);
putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_str_raw (x, "-0.10011010"); /* -77/128 */
mpfr_set_prec (t, 4);
mpfr_set_str_raw (t, "-1.110e-5"); /* -7/128 */
mpfr_set_prec (u, 4);
mpfr_add (u, x, t, GMP_RNDN); /* should give -5/8 */
mpfr_set_str_raw (t, "-1.010e-1");
if (mpfr_cmp (u, t)) {
fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=8, prec(t)=4\n");
printf ("expected -1.010e-1\n");
printf ("got "); mpfr_out_str (stdout, 2, 4, u, GMP_RNDN);
putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 112); mpfr_set_prec (t, 98); mpfr_set_prec (u, 54);
mpfr_set_str_raw (x, "-0.11111100100000000011000011100000101101010001000111E-401");
mpfr_set_str_raw (t, "0.10110000100100000101101100011111111011101000111000101E-464");
mpfr_add (u, x, t, GMP_RNDN);
if (mpfr_cmp (u, x)) {
fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=112, prec(t)=98\n");
exit (1);
}
mpfr_set_prec (x, 92); mpfr_set_prec (t, 86); mpfr_set_prec (u, 53);
mpfr_set_d (x, -5.03525136761487735093e-74, GMP_RNDN);
mpfr_set_d (t, 8.51539046314262304109e-91, GMP_RNDN);
mpfr_add (u, x, t, GMP_RNDN);
if (mpfr_get_d1 (u) != -5.0352513676148773509283672e-74) {
fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=92, prec(t)=86\n");
exit (1);
}
mpfr_set_prec(x, 53); mpfr_set_prec(t, 76); mpfr_set_prec(u, 76);
mpfr_set_str_raw(x, "-0.10010010001001011011110000000000001010011011011110001E-32");
mpfr_set_str_raw(t, "-0.1011000101110010000101111111011111010001110011110111100110101011110010011111");
mpfr_sub(u, x, t, GMP_RNDU);
mpfr_set_str_raw(t, "0.1011000101110010000101111111011100111111101010011011110110101011101000000100");
if (mpfr_cmp(u,t)) {
printf("expect "); mpfr_print_binary(t); putchar('\n');
fprintf (stderr, "mpfr_add failed for precisions 53-76\n"); exit(1);
}
mpfr_set_prec(x, 53); mpfr_set_prec(t, 108); mpfr_set_prec(u, 108);
mpfr_set_str_raw(x, "-0.10010010001001011011110000000000001010011011011110001E-32");
mpfr_set_str_raw(t, "-0.101100010111001000010111111101111101000111001111011110011010101111001001111000111011001110011000000000111111");
mpfr_sub(u, x, t, GMP_RNDU);
mpfr_set_str_raw(t, "0.101100010111001000010111111101110011111110101001101111011010101110100000001011000010101110011000000000111111");
if (mpfr_cmp(u,t)) {
printf("expect "); mpfr_print_binary(t); putchar('\n');
fprintf(stderr, "mpfr_add failed for precisions 53-108\n"); exit(1);
}
mpfr_set_prec(x, 97); mpfr_set_prec(t, 97); mpfr_set_prec(u, 97);
mpfr_set_str_raw(x, "0.1111101100001000000001011000110111101000001011111000100001000101010100011111110010000000000000000E-39");
mpfr_set_ui(t, 1, GMP_RNDN);
mpfr_add(u, x, t, GMP_RNDN);
mpfr_set_str_raw(x, "0.1000000000000000000000000000000000000000111110110000100000000101100011011110100000101111100010001E1");
if (mpfr_cmp(u,x)) {
fprintf(stderr, "mpfr_add failed for precision 97\n"); exit(1);
}
mpfr_set_prec(x, 128); mpfr_set_prec(t, 128); mpfr_set_prec(u, 128);
mpfr_set_str_raw(x, "0.10101011111001001010111011001000101100111101000000111111111011010100001100011101010001010111111101111010100110111111100101100010E-4");
mpfr_set(t, x, GMP_RNDN);
mpfr_sub(u, x, t, GMP_RNDN);
mpfr_set_prec(x, 96); mpfr_set_prec(t, 96); mpfr_set_prec(u, 96);
mpfr_set_str_raw(x, "0.111000000001110100111100110101101001001010010011010011100111100011010100011001010011011011000010E-4");
mpfr_set(t, x, GMP_RNDN);
mpfr_sub(u, x, t, GMP_RNDN);
mpfr_set_prec(x, 85); mpfr_set_prec(t, 85); mpfr_set_prec(u, 85);
mpfr_set_str_raw(x, "0.1111101110100110110110100010101011101001100010100011110110110010010011101100101111100E-4");
mpfr_set_str_raw(t, "0.1111101110100110110110100010101001001000011000111000011101100101110100001110101010110E-4");
mpfr_sub(u, x, t, GMP_RNDU);
mpfr_sub(x, x, t, GMP_RNDU);
if (mpfr_cmp(x, u) != 0) {
printf("Error in mpfr_sub: u=x-t and x=x-t give different results\n");
exit(1);
}
if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] &
((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
printf("Error in mpfr_sub: result is not msb-normalized (1)\n"); exit(1);
}
mpfr_set_prec(x, 65); mpfr_set_prec(t, 65); mpfr_set_prec(u, 65);
mpfr_set_str_raw(x, "0.10011010101000110101010000000011001001001110001011101011111011101E623");
mpfr_set_str_raw(t, "0.10011010101000110101010000000011001001001110001011101011111011100E623");
mpfr_sub(u, x, t, GMP_RNDU);
if (mpfr_get_d1 (u) != 9.4349060620538533806e167) { /* 2^558 */
printf("Error (1) in mpfr_sub\n"); exit(1);
}
mpfr_set_prec(x, 64); mpfr_set_prec(t, 64); mpfr_set_prec(u, 64);
mpfr_set_str_raw(x, "0.1000011110101111011110111111000011101011101111101101101100000100E-220");
mpfr_set_str_raw(t, "0.1000011110101111011110111111000011101011101111101101010011111101E-220");
mpfr_add(u, x, t, GMP_RNDU);
if ((MPFR_MANT(u)[0] & 1) != 1) {
printf("error in mpfr_add with rnd_mode=GMP_RNDU\n");
printf("b= "); mpfr_print_binary(x); putchar('\n');
printf("c= "); mpfr_print_binary(t); putchar('\n');
printf("b+c="); mpfr_print_binary(u); putchar('\n');
exit(1);
}
/* bug found by Norbert Mueller, 14 Sep 2000 */
mpfr_set_prec(x, 56); mpfr_set_prec(t, 83); mpfr_set_prec(u, 10);
mpfr_set_str_raw(x, "0.10001001011011001111101100110100000101111010010111010111E-7");
mpfr_set_str_raw(t, "0.10001001011011001111101100110100000101111010010111010111000000000111110110110000100E-7");
mpfr_sub(u, x, t, GMP_RNDU);
/* array bound write found by Norbert Mueller, 26 Sep 2000 */
mpfr_set_prec(x, 109); mpfr_set_prec(t, 153); mpfr_set_prec(u, 95);
mpfr_set_str_raw(x,"0.1001010000101011101100111000110001111111111111111111111111111111111111111111111111111111111111100000000000000E33");
mpfr_set_str_raw(t,"-0.100101000010101110110011100011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011100101101000000100100001100110111E33");
mpfr_add(u, x, t, GMP_RNDN);
/* array bound writes found by Norbert Mueller, 27 Sep 2000 */
mpfr_set_prec(x, 106); mpfr_set_prec(t, 53); mpfr_set_prec(u, 23);
mpfr_set_str_raw(x, "-0.1000011110101111111001010001000100001011000000000000000000000000000000000000000000000000000000000000000000E-59");
mpfr_set_str_raw(t, "-0.10000111101011111110010100010001101100011100110100000E-59");
mpfr_sub(u, x, t, GMP_RNDN);
mpfr_set_prec(x, 177); mpfr_set_prec(t, 217); mpfr_set_prec(u, 160);
mpfr_set_str_raw(x, "-0.111010001011010000111001001010010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000E35");
mpfr_set_str_raw(t, "0.1110100010110100001110010010100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111011010011100001111001E35");
mpfr_add(u, x, t, GMP_RNDN);
mpfr_set_prec(x, 214); mpfr_set_prec(t, 278); mpfr_set_prec(u, 207);
mpfr_set_str_raw(x, "0.1000100110100110101101101101000000010000100111000001001110001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000E66");
mpfr_set_str_raw(t, "-0.10001001101001101011011011010000000100001001110000010011100010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111011111001001100011E66");
mpfr_add(u, x, t, GMP_RNDN);
mpfr_set_prec(x, 32); mpfr_set_prec(t, 247); mpfr_set_prec(u, 223);
mpfr_set_str_raw(x, "0.10000000000000000000000000000000E1");
mpfr_set_str_raw(t, "0.1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111100000110001110100000100011110000101110110011101110100110110111111011010111100100000000000000000000000000E0");
mpfr_sub(u, x, t, GMP_RNDN);
if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] &
((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
printf("Error in mpfr_sub: result is not msb-normalized (2)\n"); exit(1);
}
/* bug found by Nathalie Revol, 21 March 2001 */
mpfr_set_prec (x, 65);
mpfr_set_prec (t, 65);
mpfr_set_prec (u, 65);
mpfr_set_str_raw (x, "0.11100100101101001100111011111111110001101001000011101001001010010E-35");
mpfr_set_str_raw (t, "0.10000000000000000000000000000000000001110010010110100110011110000E1");
mpfr_sub (u, t, x, GMP_RNDU);
if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] &
((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
fprintf(stderr, "Error in mpfr_sub: result is not msb-normalized (3)\n");
exit (1);
}
/* bug found by Fabrice Rouillier, 27 Mar 2001 */
mpfr_set_prec (x, 107);
mpfr_set_prec (t, 107);
mpfr_set_prec (u, 107);
mpfr_set_str_raw (x, "0.10111001001111010010001000000010111111011011011101000001001000101000000000000000000000000000000000000000000E315");
mpfr_set_str_raw (t, "0.10000000000000000000000000000000000101110100100101110110000001100101011111001000011101111100100100111011000E350");
mpfr_sub (u, x, t, GMP_RNDU);
if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] &
((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
fprintf(stderr, "Error in mpfr_sub: result is not msb-normalized (4)\n");
exit (1);
}
/* checks that NaN flag is correctly reset */
mpfr_set_d (t, 1.0, GMP_RNDN);
mpfr_set_d (u, 1.0, GMP_RNDN);
mpfr_set_nan (x);
mpfr_add (x, t, u, GMP_RNDN);
if (mpfr_cmp_ui (x, 2)) {
fprintf (stderr, "Error in mpfr_add: 1+1 gives %e\n", mpfr_get_d1 (x));
exit (1);
}
mpfr_clear(x); mpfr_clear(t); mpfr_clear(u);
}
static void
test_urandomb (long nbtests, mpfr_prec_t prec, int verbose)
{
mpfr_t x;
int *tab, size_tab, k, sh, xn;
double d, av = 0, var = 0, chi2 = 0, th;
mpfr_exp_t emin;
size_tab = (nbtests >= 1000 ? nbtests / 50 : 20);
tab = (int *) calloc (size_tab, sizeof(int));
if (tab == NULL)
{
fprintf (stderr, "trandom: can't allocate memory in test_urandomb\n");
exit (1);
}
mpfr_init2 (x, prec);
xn = 1 + (prec - 1) / mp_bits_per_limb;
sh = xn * mp_bits_per_limb - prec;
for (k = 0; k < nbtests; k++)
{
mpfr_urandomb (x, RANDS);
/* check that lower bits are zero */
if (MPFR_MANT(x)[0] & MPFR_LIMB_MASK(sh))
{
printf ("Error: mpfr_urandomb() returns invalid numbers:\n");
mpfr_print_binary (x); puts ("");
exit (1);
}
d = mpfr_get_d1 (x); av += d; var += d*d;
tab[(int)(size_tab * d)]++;
}
/* coverage test */
emin = mpfr_get_emin ();
set_emin (1); /* the generated number in [0,1[ is not in the exponent
range, except if it is zero */
k = mpfr_urandomb (x, RANDS);
if (MPFR_IS_ZERO(x) == 0 && (k == 0 || mpfr_nan_p (x) == 0))
{
printf ("Error in mpfr_urandomb, expected NaN, got ");
mpfr_dump (x);
exit (1);
}
set_emin (emin);
mpfr_clear (x);
if (!verbose)
{
free(tab);
return;
}
av /= nbtests;
var = (var / nbtests) - av * av;
th = (double)nbtests / size_tab;
printf("Average = %.5f\nVariance = %.5f\n", av, var);
printf("Repartition for urandomb. Each integer should be close to %d.\n",
(int)th);
for (k = 0; k < size_tab; k++)
{
chi2 += (tab[k] - th) * (tab[k] - th) / th;
printf("%d ", tab[k]);
if (((k+1) & 7) == 0)
printf("\n");
}
printf("\nChi2 statistics value (with %d degrees of freedom) : %.5f\n\n",
size_tab - 1, chi2);
free(tab);
return;
}
/* use Brent's formula exp(x) = (1+r+r^2/2!+r^3/3!+...)^(2^K)*2^n
where x = n*log(2)+(2^K)*r
together with Brent-Kung O(t^(1/2)) algorithm for the evaluation of
power series. The resulting complexity is O(n^(1/3)*M(n)).
*/
int
mpfr_exp_2 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int n, K, precy, q, k, l, err, exps, inexact;
mpfr_t r, s, t; mpz_t ss;
TMP_DECL(marker);
precy = MPFR_PREC(y);
n = (int) (mpfr_get_d1 (x) / LOG2);
/* for the O(n^(1/2)*M(n)) method, the Taylor series computation of
n/K terms costs about n/(2K) multiplications when computed in fixed
point */
K = (precy<SWITCH) ? _mpfr_isqrt((precy + 1) / 2) : _mpfr_cuberoot (4*precy);
l = (precy-1)/K + 1;
err = K + (int) _mpfr_ceil_log2 (2.0 * (double) l + 18.0);
/* add K extra bits, i.e. failure probability <= 1/2^K = O(1/precy) */
q = precy + err + K + 3;
mpfr_init2 (r, q);
mpfr_init2 (s, q);
mpfr_init2 (t, q);
/* the algorithm consists in computing an upper bound of exp(x) using
a precision of q bits, and see if we can round to MPFR_PREC(y) taking
into account the maximal error. Otherwise we increase q. */
do {
#ifdef DEBUG
printf("n=%d K=%d l=%d q=%d\n",n,K,l,q);
#endif
/* if n<0, we have to get an upper bound of log(2)
in order to get an upper bound of r = x-n*log(2) */
mpfr_const_log2 (s, (n>=0) ? GMP_RNDZ : GMP_RNDU);
#ifdef DEBUG
printf("n=%d log(2)=",n); mpfr_print_binary(s); putchar('\n');
#endif
mpfr_mul_ui (r, s, (n<0) ? -n : n, (n>=0) ? GMP_RNDZ : GMP_RNDU);
if (n<0) mpfr_neg(r, r, GMP_RNDD);
/* r = floor(n*log(2)) */
#ifdef DEBUG
printf("x=%1.20e\n", mpfr_get_d1 (x));
printf(" ="); mpfr_print_binary(x); putchar('\n');
printf("r=%1.20e\n", mpfr_get_d1 (r));
printf(" ="); mpfr_print_binary(r); putchar('\n');
#endif
mpfr_sub(r, x, r, GMP_RNDU);
if (MPFR_SIGN(r)<0) { /* initial approximation n was too large */
n--;
mpfr_mul_ui(r, s, (n<0) ? -n : n, GMP_RNDZ);
if (n<0) mpfr_neg(r, r, GMP_RNDD);
mpfr_sub(r, x, r, GMP_RNDU);
}
#ifdef DEBUG
printf("x-r=%1.20e\n", mpfr_get_d1 (r));
printf(" ="); mpfr_print_binary(r); putchar('\n');
if (MPFR_SIGN(r)<0) { fprintf(stderr,"Error in mpfr_exp: r<0\n"); exit(1); }
#endif
mpfr_div_2ui(r, r, K, GMP_RNDU); /* r = (x-n*log(2))/2^K */
TMP_MARK(marker);
MY_INIT_MPZ(ss, 3 + 2*((q-1)/BITS_PER_MP_LIMB));
exps = mpfr_get_z_exp(ss, s);
/* s <- 1 + r/1! + r^2/2! + ... + r^l/l! */
l = (precy<SWITCH) ? mpfr_exp2_aux(ss, r, q, &exps) /* naive method */
: mpfr_exp2_aux2(ss, r, q, &exps); /* Brent/Kung method */
#ifdef DEBUG
printf("l=%d q=%d (K+l)*q^2=%1.3e\n", l, q, (K+l)*(double)q*q);
#endif
for (k=0;k<K;k++) {
mpz_mul(ss, ss, ss); exps <<= 1;
exps += mpz_normalize(ss, ss, q);
}
mpfr_set_z(s, ss, GMP_RNDN); MPFR_EXP(s) += exps;
TMP_FREE(marker); /* don't need ss anymore */
if (n>0) mpfr_mul_2ui(s, s, n, GMP_RNDU);
else mpfr_div_2ui(s, s, -n, GMP_RNDU);
/* error is at most 2^K*(3l*(l+1)) ulp for mpfr_exp2_aux */
if (precy<SWITCH) l = 3*l*(l+1);
else l = l*(l+4);
k=0; while (l) { k++; l >>= 1; }
/* now k = ceil(log(error in ulps)/log(2)) */
K += k;
#ifdef DEBUG
printf("after mult. by 2^n:\n");
if (MPFR_EXP(s) > -1024)
printf("s=%1.20e\n", mpfr_get_d1 (s));
printf(" ="); mpfr_print_binary(s); putchar('\n');
printf("err=%d bits\n", K);
#endif
l = mpfr_can_round(s, q-K, GMP_RNDN, rnd_mode, precy);
if (l==0) {
#ifdef DEBUG
printf("not enough precision, use %d\n", q+BITS_PER_MP_LIMB);
printf("q=%d q-K=%d precy=%d\n",q,q-K,precy);
#endif
q += BITS_PER_MP_LIMB;
mpfr_set_prec(r, q); mpfr_set_prec(s, q); mpfr_set_prec(t, q);
}
} while (l==0);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear(r); mpfr_clear(s); mpfr_clear(t);
return inexact;
}
