static void
atan2_pow_of_2 (void)
{
mpfr_t x, y, r, g;
int i;
int d[] = { 0, -1, 1 };
int ntests = sizeof (d) / sizeof (int);
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
mpfr_init2 (r, 53);
mpfr_init2 (g, 53);
/* atan(42) */
mpfr_set_str_binary (g, "1100011000000011110011111001100110101000011010010011E-51");
for (i = 0; i < ntests; ++i)
{
mpfr_set_ui (y, 42, MPFR_RNDN);
mpfr_mul_2si (y, y, d[i], MPFR_RNDN);
mpfr_set_ui_2exp (x, 1, d[i], MPFR_RNDN);
mpfr_atan2 (r, y, x, MPFR_RNDN);
if (mpfr_equal_p (r, g) == 0)
{
printf ("Error in mpfr_atan2 (5)\n");
printf ("Expected "); mpfr_print_binary (g); printf ("\n");
printf ("Got "); mpfr_print_binary (r); printf ("\n");
exit (1);
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
mpfr_clear (g);
}
int
main (void)
{
int i, base;
mpfr_t x;
mpfr_prec_t p;
mpfr_exp_t e;
mpfr_init (x);
printf ("struct dymmy_test { \n"
" mpfr_prec_t prec; \n"
" int base; \n"
" const char *str; \n"
" const char *binstr; \n"
" } RefTable[] = { \n");
for (i = 0 ; i < MAX_NUM ; i++)
{
p = randomab(2, 180);
base = randomab (2, 30);
e = randomab (-1<<15, 1<<15);
mpfr_set_prec (x, p);
mpfr_urandomb (x, RANDS);
mpfr_mul_2si (x, x, e, MPFR_RNDN);
printf("{%lu, %d,\n\"", p, base);
mpfr_out_str (stdout, base, p, x, MPFR_RNDN);
printf ("\",\n\"");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\"}%c\n", i == MAX_NUM-1 ? ' ' : ',' );
}
printf("};\n");
mpfr_clear (x);
}
static void
check_min(void)
{
mpfr_t xx, yy, zz;
mpfr_init2(xx, 4);
mpfr_init2(yy, 4);
mpfr_init2(zz, 3);
mpfr_set_str1(xx, "0.9375");
mpfr_mul_2si(xx, xx, MPFR_EMIN_DEFAULT/2, MPFR_RNDN);
mpfr_set_str1(yy, "0.9375");
mpfr_mul_2si(yy, yy, MPFR_EMIN_DEFAULT - MPFR_EMIN_DEFAULT/2 - 1, MPFR_RNDN);
test_mul(zz, xx, yy, MPFR_RNDD);
if (mpfr_sgn(zz) != 0)
{
printf("check_min failed: got ");
mpfr_out_str(stdout, 2, 0, zz, MPFR_RNDZ);
printf(" instead of 0\n");
exit(1);
}
test_mul(zz, xx, yy, MPFR_RNDU);
mpfr_set_str1 (xx, "0.5");
mpfr_mul_2si(xx, xx, MPFR_EMIN_DEFAULT, MPFR_RNDN);
if (mpfr_sgn(xx) <= 0)
{
printf("check_min failed (internal error)\n");
exit(1);
}
if (mpfr_cmp(xx, zz) != 0)
{
printf("check_min failed: got ");
mpfr_out_str(stdout, 2, 0, zz, MPFR_RNDZ);
printf(" instead of ");
mpfr_out_str(stdout, 2, 0, xx, MPFR_RNDZ);
printf("\n");
exit(1);
}
mpfr_clear(xx);
mpfr_clear(yy);
mpfr_clear(zz);
}
mpz_class FirstLogTable::function(int x)
{
mpz_class result;
double apprinv;
mpfr_t i,l;
mpz_t r;
mpfr_init(i);
mpfr_init2(l,wOut);
mpz_init2(r,400);
apprinv = fit->output2double(fit->function(x));;
// result = double2output(log(apprinv));
mpfr_set_d(i, apprinv, GMP_RNDN);
mpfr_log(l, i, GMP_RNDN);
mpfr_neg(l, l, GMP_RNDN);
// Remove the sum of small offsets that are added to the other log tables
for(int j=1; j<=op->stages; j++){
mpfr_set_d(i, 1.0, GMP_RNDN);
int pi=op->p[j];
mpfr_mul_2si(i, i, -2*pi, GMP_RNDN);
mpfr_sub(l, l, i, GMP_RNDN);
}
// code the log in 2's compliment
mpfr_mul_2si(l, l, wOut, GMP_RNDN);
mpfr_get_z(r, l, GMP_RNDN);
result = mpz_class(r); // signed
// This is a very inefficient way of converting
mpz_class t = mpz_class(1) << wOut;
result = t+result;
if(result>t) result-=t;
// cout << "x="<<x<<" apprinv="<<apprinv<<" logapprinv="<<log(apprinv)<<" result="<<result<<endl;
mpfr_clear(i);
mpfr_clear(l);
mpz_clear(r);
return result;
}
/* Return in y an approximation of Ei(x) using the asymptotic expansion:
Ei(x) = exp(x)/x * (1 + 1/x + 2/x^2 + ... + k!/x^k + ...)
Assumes x >= PREC(y) * log(2).
Returns the error bound in terms of ulp(y).
*/
static mp_exp_t
mpfr_eint_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mp_prec_t p = MPFR_PREC(y);
mpfr_t invx, t, err;
unsigned long k;
mp_exp_t err_exp;
mpfr_init2 (t, p);
mpfr_init2 (invx, p);
mpfr_init2 (err, 31); /* error in ulps on y */
mpfr_ui_div (invx, 1, x, GMP_RNDN); /* invx = 1/x*(1+u) with |u|<=2^(1-p) */
mpfr_set_ui (t, 1, GMP_RNDN); /* exact */
mpfr_set (y, t, GMP_RNDN);
mpfr_set_ui (err, 0, GMP_RNDN);
for (k = 1; MPFR_GET_EXP(t) + (mp_exp_t) p > MPFR_GET_EXP(y); k++)
{
mpfr_mul (t, t, invx, GMP_RNDN); /* 2 more roundings */
mpfr_mul_ui (t, t, k, GMP_RNDN); /* 1 more rounding: t = k!/x^k*(1+u)^e
with u=2^{-p} and |e| <= 3*k */
/* we use the fact that |(1+u)^n-1| <= 2*|n*u| for |n*u| <= 1, thus
the error on t is less than 6*k*2^{-p}*t <= 6*k*ulp(t) */
/* err is in terms of ulp(y): transform it in terms of ulp(t) */
mpfr_mul_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add_ui (err, err, 6 * k, GMP_RNDU);
/* transform back in terms of ulp(y) */
mpfr_div_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add (y, y, t, GMP_RNDN);
}
/* add the truncation error bounded by ulp(y): 1 ulp */
mpfr_mul (y, y, invx, GMP_RNDN); /* err <= 2*err + 3/2 */
mpfr_exp (t, x, GMP_RNDN); /* err(t) <= 1/2*ulp(t) */
mpfr_mul (y, y, t, GMP_RNDN); /* again: err <= 2*err + 3/2 */
mpfr_mul_2ui (err, err, 2, GMP_RNDU);
mpfr_add_ui (err, err, 8, GMP_RNDU);
err_exp = MPFR_GET_EXP(err);
mpfr_clear (t);
mpfr_clear (invx);
mpfr_clear (err);
return err_exp;
}
void HOTBM::emulate(TestCase* tc)
{
/* Get inputs / outputs */
mpz_class sx = tc->getInputValue ("X");
// int outSign = 0;
mpfr_t mpX, mpR;
mpfr_inits(mpX, mpR, 0, NULL);
/* Convert a random signal to an mpfr_t in [0,1[ */
mpfr_set_z(mpX, sx.get_mpz_t(), GMP_RNDN);
mpfr_div_2si(mpX, mpX, wI, GMP_RNDN);
/* Compute the function */
f.eval(mpR, mpX);
/* Compute the signal value */
if (mpfr_signbit(mpR))
{
// outSign = 1;
mpfr_abs(mpR, mpR, GMP_RNDN);
}
mpfr_mul_2si(mpR, mpR, wO, GMP_RNDN);
/* NOT A TYPO. HOTBM only guarantees faithful
* rounding, so we will round down here,
* add both the upper and lower neighbor.
*/
mpz_t rd_t;
mpz_init (rd_t);
mpfr_get_z(rd_t, mpR, GMP_RNDD);
mpz_class rd (rd_t), ru = rd + 1;
tc->addExpectedOutput ("R", rd);
tc->addExpectedOutput ("R", ru);
mpz_clear (rd_t);
mpfr_clear (mpX);
mpfr_clear (mpR);
}
SeedValue seed_mpfr_mul_2si (SeedContext ctx,
SeedObject function,
SeedObject this_object,
gsize argument_count,
const SeedValue args[],
SeedException *exception)
{
mpfr_rnd_t rnd;
mpfr_ptr rop, op;
gint ret;
gulong k;
CHECK_ARG_COUNT("mpfr.mul_2si", 3);
rop = seed_object_get_private(this_object);
rnd = seed_value_to_mpfr_rnd_t(ctx, args[2], exception);
if ( seed_value_is_object_of_class(ctx, args[0], mpfr_class) )
{
op = seed_object_get_private(args[0]);
}
else
{
TYPE_EXCEPTION("mpfr.mul_2si", "mpfr_t");
}
if ( seed_value_is_number(ctx, args[1]) )
{
k = seed_value_to_ulong(ctx, args[1], exception);
}
else
{
TYPE_EXCEPTION("mpfr.mul_2si", "long int");
}
ret = mpfr_mul_2si(rop, op, k, rnd);
return seed_value_from_int(ctx, ret, exception);
}
static void
reuse_bug (void)
{
mpc_t z1;
/* reuse bug found by Paul Zimmermann 20081021 */
mpc_init2 (z1, 2);
/* RE (z1^2) overflows, IM(z^2) = -0 */
mpfr_set_str (mpc_realref (z1), "0.11", 2, MPFR_RNDN);
mpfr_mul_2si (mpc_realref (z1), mpc_realref (z1), mpfr_get_emax (), MPFR_RNDN);
mpfr_set_ui (mpc_imagref (z1), 0, MPFR_RNDN);
mpc_conj (z1, z1, MPC_RNDNN);
mpc_sqr (z1, z1, MPC_RNDNN);
if (!mpfr_inf_p (mpc_realref (z1)) || mpfr_signbit (mpc_realref (z1))
||!mpfr_zero_p (mpc_imagref (z1)) || !mpfr_signbit (mpc_imagref (z1)))
{
printf ("Error: Regression, bug 20081021 reproduced\n");
MPC_OUT (z1);
exit (1);
}
mpc_clear (z1);
}
static number read_number(ast_number const &n, mp_rnd_t rnd) {
number_base *res = new number_base;
switch (n.base) {
case 10: {
std::stringstream s;
s << n.mantissa << 'e' << n.exponent;
mpfr_set_str(res->val, s.str().c_str(), 10, rnd);
break; }
case 2: {
mpfr_set_str(res->val, n.mantissa.c_str(), 10, rnd);
mpfr_mul_2si(res->val, res->val, n.exponent, rnd);
break; }
case 1: {
mpfr_set_str(res->val, n.mantissa.c_str(), 10, rnd);
break; }
case 0: {
mpfr_set_ui(res->val, 0, rnd);
break; }
default:
assert(false);
}
return res;
}
static void
check_max(void)
{
mpfr_t xx, yy, zz;
mpfr_exp_t emin;
mpfr_init2(xx, 4);
mpfr_init2(yy, 4);
mpfr_init2(zz, 4);
mpfr_set_str1 (xx, "0.68750");
mpfr_mul_2si(xx, xx, MPFR_EMAX_DEFAULT/2, MPFR_RNDN);
mpfr_set_str1 (yy, "0.68750");
mpfr_mul_2si(yy, yy, MPFR_EMAX_DEFAULT - MPFR_EMAX_DEFAULT/2 + 1, MPFR_RNDN);
mpfr_clear_flags();
test_mul(zz, xx, yy, MPFR_RNDU);
if (!(mpfr_overflow_p() && MPFR_IS_INF(zz)))
{
printf("check_max failed (should be an overflow)\n");
exit(1);
}
mpfr_clear_flags();
test_mul(zz, xx, yy, MPFR_RNDD);
if (mpfr_overflow_p() || MPFR_IS_INF(zz))
{
printf("check_max failed (should NOT be an overflow)\n");
exit(1);
}
mpfr_set_str1 (xx, "0.93750");
mpfr_mul_2si(xx, xx, MPFR_EMAX_DEFAULT, MPFR_RNDN);
if (!(MPFR_IS_FP(xx) && MPFR_IS_FP(zz)))
{
printf("check_max failed (internal error)\n");
exit(1);
}
if (mpfr_cmp(xx, zz) != 0)
{
printf("check_max failed: got ");
mpfr_out_str(stdout, 2, 0, zz, MPFR_RNDZ);
printf(" instead of ");
mpfr_out_str(stdout, 2, 0, xx, MPFR_RNDZ);
printf("\n");
exit(1);
}
/* check underflow */
emin = mpfr_get_emin ();
set_emin (0);
mpfr_set_str_binary (xx, "0.1E0");
mpfr_set_str_binary (yy, "0.1E0");
test_mul (zz, xx, yy, MPFR_RNDN);
/* exact result is 0.1E-1, which should round to 0 */
MPFR_ASSERTN(mpfr_cmp_ui (zz, 0) == 0 && MPFR_IS_POS(zz));
set_emin (emin);
/* coverage test for mpfr_powerof2_raw */
emin = mpfr_get_emin ();
set_emin (0);
mpfr_set_prec (xx, mp_bits_per_limb + 1);
mpfr_set_str_binary (xx, "0.1E0");
mpfr_nextabove (xx);
mpfr_set_str_binary (yy, "0.1E0");
test_mul (zz, xx, yy, MPFR_RNDN);
/* exact result is just above 0.1E-1, which should round to minfloat */
MPFR_ASSERTN(mpfr_cmp (zz, yy) == 0);
set_emin (emin);
mpfr_clear(xx);
mpfr_clear(yy);
mpfr_clear(zz);
}
int
mpfr_grandom (mpfr_ptr rop1, mpfr_ptr rop2, gmp_randstate_t rstate,
mpfr_rnd_t rnd)
{
int inex1, inex2, s1, s2;
mpz_t x, y, xp, yp, t, a, b, s;
mpfr_t sfr, l, r1, r2;
mpfr_prec_t tprec, tprec0;
inex2 = inex1 = 0;
if (rop2 == NULL) /* only one output requested. */
{
tprec0 = MPFR_PREC (rop1);
}
else
{
tprec0 = MAX (MPFR_PREC (rop1), MPFR_PREC (rop2));
}
tprec0 += 11;
/* We use "Marsaglia polar method" here (cf.
George Marsaglia, Normal (Gaussian) random variables for supercomputers
The Journal of Supercomputing, Volume 5, Number 1, 49–55
DOI: 10.1007/BF00155857).
First we draw uniform x and y in [0,1] using mpz_urandomb (in
fixed precision), and scale them to [-1, 1].
*/
mpz_init (xp);
mpz_init (yp);
mpz_init (x);
mpz_init (y);
mpz_init (t);
mpz_init (s);
mpz_init (a);
mpz_init (b);
mpfr_init2 (sfr, MPFR_PREC_MIN);
mpfr_init2 (l, MPFR_PREC_MIN);
mpfr_init2 (r1, MPFR_PREC_MIN);
if (rop2 != NULL)
mpfr_init2 (r2, MPFR_PREC_MIN);
mpz_set_ui (xp, 0);
mpz_set_ui (yp, 0);
for (;;)
{
tprec = tprec0;
do
{
mpz_urandomb (xp, rstate, tprec);
mpz_urandomb (yp, rstate, tprec);
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
}
while (mpz_sizeinbase (s, 2) > tprec * 2); /* x^2 + y^2 <= 2^{2tprec} */
for (;;)
{
/* FIXME: compute s as s += 2x + 2y + 2 */
mpz_add_ui (a, xp, 1);
mpz_add_ui (b, yp, 1);
mpz_mul (a, a, a);
mpz_mul (b, b, b);
mpz_add (s, a, b);
if ((mpz_sizeinbase (s, 2) <= 2 * tprec) ||
((mpz_sizeinbase (s, 2) == 2 * tprec + 1) &&
(mpz_scan1 (s, 0) == 2 * tprec)))
goto yeepee;
/* Extend by 32 bits */
mpz_mul_2exp (xp, xp, 32);
mpz_mul_2exp (yp, yp, 32);
mpz_urandomb (x, rstate, 32);
mpz_urandomb (y, rstate, 32);
mpz_add (xp, xp, x);
mpz_add (yp, yp, y);
tprec += 32;
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
if (mpz_sizeinbase (s, 2) > tprec * 2)
break;
}
}
yeepee:
/* FIXME: compute s with s -= 2x + 2y + 2 */
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
/* Compute the signs of the output */
mpz_urandomb (x, rstate, 2);
s1 = mpz_tstbit (x, 0);
s2 = mpz_tstbit (x, 1);
for (;;)
{
/* s = xp^2 + yp^2 (loop invariant) */
mpfr_set_prec (sfr, 2 * tprec);
mpfr_set_prec (l, tprec);
mpfr_set_z (sfr, s, MPFR_RNDN); /* exact */
mpfr_mul_2si (sfr, sfr, -2 * tprec, MPFR_RNDN); /* exact */
mpfr_log (l, sfr, MPFR_RNDN);
mpfr_neg (l, l, MPFR_RNDN);
mpfr_mul_2si (l, l, 1, MPFR_RNDN);
mpfr_div (l, l, sfr, MPFR_RNDN);
mpfr_sqrt (l, l, MPFR_RNDN);
mpfr_set_prec (r1, tprec);
mpfr_mul_z (r1, l, xp, MPFR_RNDN);
mpfr_div_2ui (r1, r1, tprec, MPFR_RNDN); /* exact */
if (s1)
mpfr_neg (r1, r1, MPFR_RNDN);
if (MPFR_CAN_ROUND (r1, tprec - 2, MPFR_PREC (rop1), rnd))
{
if (rop2 != NULL)
{
mpfr_set_prec (r2, tprec);
mpfr_mul_z (r2, l, yp, MPFR_RNDN);
mpfr_div_2ui (r2, r2, tprec, MPFR_RNDN); /* exact */
if (s2)
mpfr_neg (r2, r2, MPFR_RNDN);
if (MPFR_CAN_ROUND (r2, tprec - 2, MPFR_PREC (rop2), rnd))
break;
}
else
break;
}
/* Extend by 32 bits */
mpz_mul_2exp (xp, xp, 32);
mpz_mul_2exp (yp, yp, 32);
mpz_urandomb (x, rstate, 32);
mpz_urandomb (y, rstate, 32);
mpz_add (xp, xp, x);
mpz_add (yp, yp, y);
tprec += 32;
mpz_mul (a, xp, xp);
mpz_mul (b, yp, yp);
mpz_add (s, a, b);
}
inex1 = mpfr_set (rop1, r1, rnd);
if (rop2 != NULL)
{
inex2 = mpfr_set (rop2, r2, rnd);
inex2 = mpfr_check_range (rop2, inex2, rnd);
}
inex1 = mpfr_check_range (rop1, inex1, rnd);
if (rop2 != NULL)
mpfr_clear (r2);
mpfr_clear (r1);
mpfr_clear (l);
mpfr_clear (sfr);
mpz_clear (b);
mpz_clear (a);
mpz_clear (s);
mpz_clear (t);
mpz_clear (y);
mpz_clear (x);
mpz_clear (yp);
mpz_clear (xp);
return INEX (inex1, inex2);
}
static void
check_1111 (void)
{
mpfr_t one;
long n;
mpfr_init2 (one, MPFR_PREC_MIN);
mpfr_set_ui (one, 1, MPFR_RNDN);
for (n = 0; n < NUM; n++)
{
mpfr_prec_t prec_a, prec_b, prec_c;
mpfr_exp_t tb=0, tc, diff;
mpfr_t a, b, c, s;
int m = 512;
int sb, sc;
int inex_a, inex_s;
mpfr_rnd_t rnd_mode;
prec_a = MPFR_PREC_MIN + (randlimb () % m);
prec_b = MPFR_PREC_MIN + (randlimb () % m);
prec_c = MPFR_PREC_MIN + (randlimb () % m);
mpfr_init2 (a, prec_a);
mpfr_init2 (b, prec_b);
mpfr_init2 (c, prec_c);
sb = randlimb () % 3;
if (sb != 0)
{
tb = 1 + (randlimb () % (prec_b - (sb != 2)));
mpfr_div_2ui (b, one, tb, MPFR_RNDN);
if (sb == 2)
mpfr_neg (b, b, MPFR_RNDN);
test_add (b, b, one, MPFR_RNDN);
}
else
mpfr_set (b, one, MPFR_RNDN);
tc = 1 + (randlimb () % (prec_c - 1));
mpfr_div_2ui (c, one, tc, MPFR_RNDN);
sc = randlimb () % 2;
if (sc)
mpfr_neg (c, c, MPFR_RNDN);
test_add (c, c, one, MPFR_RNDN);
diff = (randlimb () % (2*m)) - m;
mpfr_mul_2si (c, c, diff, MPFR_RNDN);
rnd_mode = RND_RAND ();
inex_a = test_add (a, b, c, rnd_mode);
mpfr_init2 (s, MPFR_PREC_MIN + 2*m);
inex_s = test_add (s, b, c, MPFR_RNDN); /* exact */
if (inex_s)
{
printf ("check_1111: result should have been exact.\n");
exit (1);
}
inex_s = mpfr_prec_round (s, prec_a, rnd_mode);
if ((inex_a < 0 && inex_s >= 0) ||
(inex_a == 0 && inex_s != 0) ||
(inex_a > 0 && inex_s <= 0) ||
!mpfr_equal_p (a, s))
{
printf ("check_1111: results are different.\n");
printf ("prec_a = %d, prec_b = %d, prec_c = %d\n",
(int) prec_a, (int) prec_b, (int) prec_c);
printf ("tb = %d, tc = %d, diff = %d, rnd = %s\n",
(int) tb, (int) tc, (int) diff,
mpfr_print_rnd_mode (rnd_mode));
printf ("sb = %d, sc = %d\n", sb, sc);
printf ("a = ");
mpfr_print_binary (a);
puts ("");
printf ("s = ");
mpfr_print_binary (s);
puts ("");
printf ("inex_a = %d, inex_s = %d\n", inex_a, inex_s);
exit (1);
}
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
mpfr_clear (s);
}
mpfr_clear (one);
}
/* Put in y an approximation of erfc(x) for large x, using formulae 7.1.23 and
7.1.24 from Abramowitz and Stegun.
Returns e such that the error is bounded by 2^e ulp(y),
or returns 0 in case of underflow.
*/
static mpfr_exp_t
mpfr_erfc_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mpfr_t t, xx, err;
unsigned long k;
mpfr_prec_t prec = MPFR_PREC(y);
mpfr_exp_t exp_err;
mpfr_init2 (t, prec);
mpfr_init2 (xx, prec);
mpfr_init2 (err, 31);
/* let u = 2^(1-p), and let us represent the error as (1+u)^err
with a bound for err */
mpfr_mul (xx, x, x, MPFR_RNDD); /* err <= 1 */
mpfr_ui_div (xx, 1, xx, MPFR_RNDU); /* upper bound for 1/(2x^2), err <= 2 */
mpfr_div_2ui (xx, xx, 1, MPFR_RNDU); /* exact */
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term, exact */
mpfr_set (y, t, MPFR_RNDN); /* current sum */
mpfr_set_ui (err, 0, MPFR_RNDN);
for (k = 1; ; k++)
{
mpfr_mul_ui (t, t, 2 * k - 1, MPFR_RNDU); /* err <= 4k-3 */
mpfr_mul (t, t, xx, MPFR_RNDU); /* err <= 4k */
/* for -1 < x < 1, and |nx| < 1, we have |(1+x)^n| <= 1+7/4|nx|.
Indeed, for x>=0: log((1+x)^n) = n*log(1+x) <= n*x. Let y=n*x < 1,
then exp(y) <= 1+7/4*y.
For x<=0, let x=-x, we can prove by induction that (1-x)^n >= 1-n*x.*/
mpfr_mul_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
mpfr_add_ui (err, err, 14 * k, MPFR_RNDU); /* 2^(1-p) * t <= 2 ulp(t) */
mpfr_div_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
if (MPFR_GET_EXP (t) + (mpfr_exp_t) prec <= MPFR_GET_EXP (y))
{
/* the truncation error is bounded by |t| < ulp(y) */
mpfr_add_ui (err, err, 1, MPFR_RNDU);
break;
}
if (k & 1)
mpfr_sub (y, y, t, MPFR_RNDN);
else
mpfr_add (y, y, t, MPFR_RNDN);
}
/* the error on y is bounded by err*ulp(y) */
mpfr_mul (t, x, x, MPFR_RNDU); /* rel. err <= 2^(1-p) */
mpfr_div_2ui (err, err, 3, MPFR_RNDU); /* err/8 */
mpfr_add (err, err, t, MPFR_RNDU); /* err/8 + xx */
mpfr_mul_2ui (err, err, 3, MPFR_RNDU); /* err + 8*xx */
mpfr_exp (t, t, MPFR_RNDU); /* err <= 1/2*ulp(t) + err(x*x)*t
<= 1/2*ulp(t)+2*|x*x|*ulp(t)
<= (2*|x*x|+1/2)*ulp(t) */
mpfr_mul (t, t, x, MPFR_RNDN); /* err <= 1/2*ulp(t) + (4*|x*x|+1)*ulp(t)
<= (4*|x*x|+3/2)*ulp(t) */
mpfr_const_pi (xx, MPFR_RNDZ); /* err <= ulp(Pi) */
mpfr_sqrt (xx, xx, MPFR_RNDN); /* err <= 1/2*ulp(xx) + ulp(Pi)/2/sqrt(Pi)
<= 3/2*ulp(xx) */
mpfr_mul (t, t, xx, MPFR_RNDN); /* err <= (8 |xx| + 13/2) * ulp(t) */
mpfr_div (y, y, t, MPFR_RNDN); /* the relative error on input y is bounded
by (1+u)^err with u = 2^(1-p), that on
t is bounded by (1+u)^(8 |xx| + 13/2),
thus that on output y is bounded by
8 |xx| + 7 + err. */
if (MPFR_IS_ZERO(y))
{
/* If y is zero, most probably we have underflow. We check it directly
using the fact that erfc(x) <= exp(-x^2)/sqrt(Pi)/x for x >= 0.
We compute an upper approximation of exp(-x^2)/sqrt(Pi)/x.
*/
mpfr_mul (t, x, x, MPFR_RNDD); /* t <= x^2 */
mpfr_neg (t, t, MPFR_RNDU); /* -x^2 <= t */
mpfr_exp (t, t, MPFR_RNDU); /* exp(-x^2) <= t */
mpfr_const_pi (xx, MPFR_RNDD); /* xx <= sqrt(Pi), cached */
mpfr_mul (xx, xx, x, MPFR_RNDD); /* xx <= sqrt(Pi)*x */
mpfr_div (y, t, xx, MPFR_RNDN); /* if y is zero, this means that the upper
approximation of exp(-x^2)/sqrt(Pi)/x
is nearer from 0 than from 2^(-emin-1),
thus we have underflow. */
exp_err = 0;
}
else
{
mpfr_add_ui (err, err, 7, MPFR_RNDU);
exp_err = MPFR_GET_EXP (err);
}
mpfr_clear (t);
mpfr_clear (xx);
mpfr_clear (err);
return exp_err;
}
CRFPConstMult::CRFPConstMult(Target* target, int wE_in, int wF_in, int wE_out, int wF_out, string _constant):
FPConstMult(target, wE_in, wF_in, wE_out, wF_out),
constant (_constant)
{
#if 0
sollya_obj_t node;
mpfr_t mpR;
mpz_t zz;
srcFileName="CRFPConstMult";
/* Convert the input string into a sollya evaluation tree */
node = sollya_lib_parse_string(constant.c_str());
/* If parse error throw an exception */
if (sollya_lib_obj_is_error(node))
{
ostringstream error;
error << srcFileName << ": Unable to parse string "<< constant << " as a numeric constant" <<endl;
throw error.str();
}
mpfr_inits(mpR, NULL);
sollya_lib_get_constant(mpR, node);
if(verbose){
double r;
r = mpfr_get_d(mpR, GMP_RNDN);
cout << " Constant evaluates to " <<r <<endl;
}
// compute the precision -- TODO with NWB
cst_width = 2*wF_in+4;
REPORT(0, "***** WARNING Taking constant with 2*wF_in+4 bits. Correct rounding is not yet guaranteed. This is being implemented." );
REPORT(INFO, "Required significand precision to reach correct rounding is " << cst_width );
mpfr_set_prec(mpfrC, cst_width);
sollya_lib_get_constant(mpR, node);
// Now convert mpR into exponent + integral significand
// sign
cst_sgn = mpfr_sgn(mpR);
if(cst_sgn<0)
mpfr_neg(mpR, mpR, GMP_RNDN);
// compute exponent and mantissa
cst_exp_when_mantissa_1_2 = mpfr_get_exp(mpR) - 1; //mpfr_get_exp() assumes significand in [1/2,1)
cst_exp_when_mantissa_int = cst_exp_when_mantissa_1_2 - cst_width + 1;
mpfr_init2(mpfr_cst_sig, cst_width);
mpfr_div_2si(mpfr_cst_sig, mpR, cst_exp_when_mantissa_1_2, GMP_RNDN);
REPORT(INFO, "mpfr_cst_sig = " << mpfr_get_d(mpfr_cst_sig, GMP_RNDN));
// Build the corresponding FPConstMult.
// initialize mpfr_xcut_sig = 2/cst_sig, will be between 1 and 2
mpfr_init2(mpfr_xcut_sig, 32*(cst_width+wE_in+wE_out)); // should be accurate enough
mpfr_set_d(mpfr_xcut_sig, 2.0, GMP_RNDN); // exaxt op
mpfr_div(mpfr_xcut_sig, mpfr_xcut_sig, mpfr_cst_sig, GMP_RNDD);
// now round it down to wF_in+1 bits
mpfr_t xcut_wF;
mpfr_init2(xcut_wF, wF_in+1);
mpfr_set(xcut_wF, mpfr_xcut_sig, GMP_RNDD);
mpfr_mul_2si(xcut_wF, xcut_wF, wF_in, GMP_RNDN);
// It should now be an int; cast it into a mpz, then a mpz_class
mpz_init2(zz, wF_in+1);
mpfr_get_z(zz, xcut_wF, GMP_RNDN);
xcut_sig_rd = mpz_class(zz);
mpz_clear(zz);
REPORT(DETAILED, "mpfr_xcut_sig = " << mpfr_get_d(mpfr_xcut_sig, GMP_RNDN) );
// Now build the mpz significand
mpfr_mul_2si(mpfr_cst_sig, mpfr_cst_sig, cst_width, GMP_RNDN);
// It should now be an int; cast it into a mpz, then a mpz_class
mpz_init2(zz, cst_width);
mpfr_get_z(zz, mpfr_cst_sig, GMP_RNDN);
cst_sig = mpz_class(zz);
mpz_clear(zz);
REPORT(DETAILED, "mpzclass cst_sig = " << cst_sig);
// build the name
ostringstream name;
name <<"FPConstMult_"<<(cst_sgn==0?"":"M") <<cst_sig<<"b"
<<(cst_exp_when_mantissa_int<0?"M":"")<<abs(cst_exp_when_mantissa_int)
<<"_"<<wE_in<<"_"<<wF_in<<"_"<<wE_out<<"_"<<wF_out;
uniqueName_=name.str();
// cleaning up
mpfr_clears(mpR, mpfr_xcut_sig, xcut_wF, mpfr_cst_sig, NULL);
icm = new IntConstMult(target, wF_in+1, cst_sig);
oplist.push_back(icm);
buildVHDL();
#endif
}
int
mpfr_exp2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
int inexact;
long xint;
mpfr_t xfrac;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(y), mpfr_log_prec, 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 /* 2^0 = 1 */
{
MPFR_ASSERTD (MPFR_IS_ZERO(x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
/* since the smallest representable non-zero float is 1/2*2^__gmpfr_emin,
if x < __gmpfr_emin - 1, the result is either 1/2*2^__gmpfr_emin or 0 */
MPFR_ASSERTN (MPFR_EMIN_MIN >= LONG_MIN + 2);
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emin - 1) < 0))
{
mpfr_rnd_t rnd2 = rnd_mode;
/* in round to nearest mode, round to zero when x <= __gmpfr_emin-2 */
if (rnd_mode == MPFR_RNDN &&
mpfr_cmp_si_2exp (x, __gmpfr_emin - 2, 0) <= 0)
rnd2 = MPFR_RNDZ;
return mpfr_underflow (y, rnd2, 1);
}
MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax) >= 0))
return mpfr_overflow (y, rnd_mode, 1);
/* We now know that emin - 1 <= x < emax. */
MPFR_SAVE_EXPO_MARK (expo);
/* 2^x = 1 + x*log(2) + O(x^2) for x near zero, and for |x| <= 1 we have
|2^x - 1| <= x < 2^EXP(x). If x > 0 we must round away from 0 (dir=1);
if x < 0 we must round toward 0 (dir=0). */
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, - MPFR_GET_EXP (x), 0,
MPFR_IS_POS (x), rnd_mode, expo, {});
xint = mpfr_get_si (x, MPFR_RNDZ);
mpfr_init2 (xfrac, MPFR_PREC (x));
mpfr_sub_si (xfrac, x, xint, MPFR_RNDN); /* exact */
if (MPFR_IS_ZERO (xfrac))
{
mpfr_set_ui (y, 1, MPFR_RNDN);
inexact = 0;
}
else
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_exp_t err; /* error */
MPFR_ZIV_DECL (loop);
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 5 + MPFR_INT_CEIL_LOG2 (Ny);
/* initialize of intermediary variable */
mpfr_init2 (t, Nt);
/* First computation */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute exp(x*ln(2))*/
mpfr_const_log2 (t, MPFR_RNDU); /* ln(2) */
mpfr_mul (t, xfrac, t, MPFR_RNDU); /* xfrac * ln(2) */
err = Nt - (MPFR_GET_EXP (t) + 2); /* Estimate of the error */
mpfr_exp (t, t, MPFR_RNDN); /* exp(xfrac * ln(2)) */
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd_mode);
mpfr_clear (t);
}
mpfr_clear (xfrac);
MPFR_CLEAR_FLAGS ();
mpfr_mul_2si (y, y, xint, MPFR_RNDN); /* exact or overflow */
/* Note: We can have an overflow only when t was rounded up to 2. */
MPFR_ASSERTD (MPFR_IS_PURE_FP (y) || inexact > 0);
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_t x;
int r;
mp_prec_t p;
unsigned long k;
tests_start_mpfr ();
special ();
mpfr_init (x);
for (p = 2; p < 100; p++)
{
mpfr_set_prec (x, p);
for (r = 0; r < GMP_RND_MAX; r++)
{
mpfr_set_ui (x, 1, GMP_RNDN);
k = 2 + randlimb () % 4; /* 2 <= k <= 5 */
mpfr_root (x, x, k, (mp_rnd_t) r);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in mpfr_root(%lu) for x=1, rnd=%s\ngot ",
k, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
if (k % 2)
{
mpfr_root (x, x, k, (mp_rnd_t) r);
if (mpfr_cmp_si (x, -1))
{
printf ("Error in mpfr_root(%lu) for x=-1, rnd=%s\ngot ",
k, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
}
if (p >= 5)
{
int i;
for (i = -12; i <= 12; i++)
{
mpfr_set_ui (x, 27, GMP_RNDN);
mpfr_mul_2si (x, x, 3*i, GMP_RNDN);
mpfr_root (x, x, 3, GMP_RNDN);
if (mpfr_cmp_si_2exp (x, 3, i))
{
printf ("Error in mpfr_root(3) for "
"x = 27.0 * 2^(%d), rnd=%s\ngot ",
3*i, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\ninstead of 3 * 2^(%d)\n", i);
exit (1);
}
}
}
}
}
mpfr_clear (x);
test_generic_ui (2, 200, 30);
tests_end_mpfr ();
return 0;
}
int
main (void)
{
mpfr_t x;
int r;
mp_prec_t p;
tests_start_mpfr ();
special ();
mpfr_init (x);
for (p=2; p<100; p++)
{
mpfr_set_prec (x, p);
for (r = 0; r < GMP_RND_MAX; r++)
{
mpfr_set_ui (x, 1, GMP_RNDN);
mpfr_cbrt (x, x, (mp_rnd_t) r);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error in mpfr_cbrt for x=1, rnd=%s\ngot ",
mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_si (x, -1, GMP_RNDN);
mpfr_cbrt (x, x, (mp_rnd_t) r);
if (mpfr_cmp_si (x, -1))
{
printf ("Error in mpfr_cbrt for x=-1, rnd=%s\ngot ",
mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
if (p >= 5)
{
int i;
for (i = -12; i <= 12; i++)
{
mpfr_set_ui (x, 27, GMP_RNDN);
mpfr_mul_2si (x, x, 3*i, GMP_RNDN);
mpfr_cbrt (x, x, GMP_RNDN);
if (mpfr_cmp_si_2exp (x, 3, i))
{
printf ("Error in mpfr_cbrt for "
"x = 27.0 * 2^(%d), rnd=%s\ngot ",
3*i, mpfr_print_rnd_mode ((mp_rnd_t) r));
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\ninstead of 3 * 2^(%d)\n", i);
exit (1);
}
}
}
}
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
void mpfr_bisect_sqrt(mpfr_t R, mpfr_t N, mpfr_t T)
{
if(mpfr_cmp_ui(N, 0) < 0)
{
fprintf(stderr, "The value to square root must be non-negative\n");
exit(-1);
}
if(mpfr_cmp_ui(T, 0) < 0)
{
fprintf(stderr, "The tolerance must be non-negative\n");
exit(-1);
}
mpfr_exp_t e;
mpfr_t a, b, x, f, d, fab, n;
mpfr_init(n);
mpfr_frexp(&e, n, N, MPFR_RNDN);
if(e%2)
{
mpfr_div_ui(n, n, 2, MPFR_RNDN);
e += 1;
}
//Set a == 0
mpfr_init_set_ui(a, 0, MPFR_RNDN);
//Set b == 1
mpfr_init_set_ui(b, 1, MPFR_RNDN);
//Set x = (a + b)/2
mpfr_init(x);
mpfr_add(x, a, b, MPFR_RNDN);
mpfr_mul(x, x, MPFR_HALF, MPFR_RNDN);
//Set f = x^2 - N and fab = |f|
mpfr_init(f);
mpfr_init(fab);
mpfr_mul(f, x, x, MPFR_RNDN);
mpfr_sub(f, f, N, MPFR_RNDN);
mpfr_abs(fab, f, MPFR_RNDN);
//Set d = b - a
mpfr_init(d);
mpfr_sub(d, b, a, MPFR_RNDN);
while(mpfr_cmp(fab, T) > 0 && mpfr_cmp(d, T) > 0)
{
//Update the bounds, a and b
if(mpfr_cmp_ui(f, 0) < 0)
mpfr_set(a, x, MPFR_RNDN);
else
mpfr_set(b, x, MPFR_RNDN);
//Update x
mpfr_add(x, a, b, MPFR_RNDN);
mpfr_mul(x, x, MPFR_HALF, MPFR_RNDN);
//Update f and fab
mpfr_mul(f, x, x, MPFR_RNDN);
mpfr_sub(f, f, n, MPFR_RNDN);
mpfr_abs(fab, f, MPFR_RNDN);
}
printf("beep");
mpfr_mul_2si(R, x, e/2, MPFR_RNDN);
}
static void
large (mpfr_exp_t e)
{
mpfr_t x, y, z;
mpfr_exp_t emax;
int inex;
unsigned int flags;
emax = mpfr_get_emax ();
set_emax (e);
mpfr_init2 (x, 8);
mpfr_init2 (y, 8);
mpfr_init2 (z, 4);
mpfr_set_inf (x, 1);
mpfr_nextbelow (x);
mpfr_mul_2si (y, x, -1, MPFR_RNDU);
mpfr_prec_round (y, 4, MPFR_RNDU);
mpfr_clear_flags ();
inex = mpfr_mul_2si (z, x, -1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_mul_2si\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_div_2si (z, x, 1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_div_2si\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clear_flags ();
inex = mpfr_div_2ui (z, x, 1, MPFR_RNDU);
flags = __gmpfr_flags;
if (inex <= 0 || flags != MPFR_FLAGS_INEXACT || ! mpfr_equal_p (y, z))
{
printf ("Error in large(");
if (e == MPFR_EMAX_MAX)
printf ("MPFR_EMAX_MAX");
else if (e == emax)
printf ("default emax");
else if (e <= LONG_MAX)
printf ("%ld", (long) e);
else
printf (">LONG_MAX");
printf (") for mpfr_div_2ui\n");
printf ("Expected inex > 0, flags = %u,\n y = ",
(unsigned int) MPFR_FLAGS_INEXACT);
mpfr_dump (y);
printf ("Got inex = %d, flags = %u,\n y = ",
inex, flags);
mpfr_dump (z);
exit (1);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
set_emax (emax);
}
/* If x^y is exactly representable (with maybe a larger precision than z),
round it in z and return the (mpc) inexact flag in [0, 10].
If x^y is not exactly representable, return -1.
If intermediate computations lead to numbers of more than maxprec bits,
then abort and return -2 (in that case, to avoid loops, mpc_pow_exact
should be called again with a larger value of maxprec).
Assume one of Re(x) or Im(x) is non-zero, and y is non-zero (y is real).
Warning: z and x might be the same variable, same for Re(z) or Im(z) and y.
In case -1 or -2 is returned, z is not modified.
*/
static int
mpc_pow_exact (mpc_ptr z, mpc_srcptr x, mpfr_srcptr y, mpc_rnd_t rnd,
mpfr_prec_t maxprec)
{
mpfr_exp_t ec, ed, ey;
mpz_t my, a, b, c, d, u;
unsigned long int t;
int ret = -2;
int sign_rex = mpfr_signbit (mpc_realref(x));
int sign_imx = mpfr_signbit (mpc_imagref(x));
int x_imag = mpfr_zero_p (mpc_realref(x));
int z_is_y = 0;
mpfr_t copy_of_y;
if (mpc_realref (z) == y || mpc_imagref (z) == y)
{
z_is_y = 1;
mpfr_init2 (copy_of_y, mpfr_get_prec (y));
mpfr_set (copy_of_y, y, MPFR_RNDN);
}
mpz_init (my);
mpz_init (a);
mpz_init (b);
mpz_init (c);
mpz_init (d);
mpz_init (u);
ey = mpfr_get_z_exp (my, y);
/* normalize so that my is odd */
t = mpz_scan1 (my, 0);
ey += (mpfr_exp_t) t;
mpz_tdiv_q_2exp (my, my, t);
/* y = my*2^ey with my odd */
if (x_imag)
{
mpz_set_ui (c, 0);
ec = 0;
}
else
ec = mpfr_get_z_exp (c, mpc_realref(x));
if (mpfr_zero_p (mpc_imagref(x)))
{
mpz_set_ui (d, 0);
ed = ec;
}
else
{
ed = mpfr_get_z_exp (d, mpc_imagref(x));
if (x_imag)
ec = ed;
}
/* x = c*2^ec + I * d*2^ed */
/* equalize the exponents of x */
if (ec < ed)
{
mpz_mul_2exp (d, d, (unsigned long int) (ed - ec));
if ((mpfr_prec_t) mpz_sizeinbase (d, 2) > maxprec)
goto end;
}
else if (ed < ec)
{
mpz_mul_2exp (c, c, (unsigned long int) (ec - ed));
if ((mpfr_prec_t) mpz_sizeinbase (c, 2) > maxprec)
goto end;
ec = ed;
}
/* now ec=ed and x = (c + I * d) * 2^ec */
/* divide by two if possible */
if (mpz_cmp_ui (c, 0) == 0)
{
t = mpz_scan1 (d, 0);
mpz_tdiv_q_2exp (d, d, t);
ec += (mpfr_exp_t) t;
}
else if (mpz_cmp_ui (d, 0) == 0)
{
t = mpz_scan1 (c, 0);
mpz_tdiv_q_2exp (c, c, t);
ec += (mpfr_exp_t) t;
}
else /* neither c nor d is zero */
{
unsigned long v;
t = mpz_scan1 (c, 0);
v = mpz_scan1 (d, 0);
if (v < t)
t = v;
mpz_tdiv_q_2exp (c, c, t);
mpz_tdiv_q_2exp (d, d, t);
ec += (mpfr_exp_t) t;
}
/* now either one of c, d is odd */
while (ey < 0)
{
/* check if x is a square */
if (ec & 1)
{
mpz_mul_2exp (c, c, 1);
mpz_mul_2exp (d, d, 1);
ec --;
}
/* now ec is even */
if (mpc_perfect_square_p (a, b, c, d) == 0)
break;
mpz_swap (a, c);
mpz_swap (b, d);
ec /= 2;
ey ++;
}
if (ey < 0)
{
ret = -1; /* not representable */
goto end;
}
/* Now ey >= 0, it thus suffices to check that x^my is representable.
If my > 0, this is always true. If my < 0, we first try to invert
(c+I*d)*2^ec.
*/
if (mpz_cmp_ui (my, 0) < 0)
{
/* If my < 0, 1 / (c + I*d) = (c - I*d)/(c^2 + d^2), thus a sufficient
condition is that c^2 + d^2 is a power of two, assuming |c| <> |d|.
Assume a prime p <> 2 divides c^2 + d^2,
then if p does not divide c or d, 1 / (c + I*d) cannot be exact.
If p divides both c and d, then we can write c = p*c', d = p*d',
and 1 / (c + I*d) = 1/p * 1/(c' + I*d'). This shows that if 1/(c+I*d)
is exact, then 1/(c' + I*d') is exact too, and we are back to the
previous case. In conclusion, a necessary and sufficient condition
is that c^2 + d^2 is a power of two.
*/
/* FIXME: we could first compute c^2+d^2 mod a limb for example */
mpz_mul (a, c, c);
mpz_addmul (a, d, d);
t = mpz_scan1 (a, 0);
if (mpz_sizeinbase (a, 2) != 1 + t) /* a is not a power of two */
{
ret = -1; /* not representable */
goto end;
}
/* replace (c,d) by (c/(c^2+d^2), -d/(c^2+d^2)) */
mpz_neg (d, d);
ec = -ec - (mpfr_exp_t) t;
mpz_neg (my, my);
}
/* now ey >= 0 and my >= 0, and we want to compute
[(c + I * d) * 2^ec] ^ (my * 2^ey).
We first compute [(c + I * d) * 2^ec]^my, then square ey times. */
t = mpz_sizeinbase (my, 2) - 1;
mpz_set (a, c);
mpz_set (b, d);
ed = ec;
/* invariant: (a + I*b) * 2^ed = ((c + I*d) * 2^ec)^trunc(my/2^t) */
while (t-- > 0)
{
unsigned long int v, w;
/* square a + I*b */
mpz_mul (u, a, b);
mpz_mul (a, a, a);
mpz_submul (a, b, b);
mpz_mul_2exp (b, u, 1);
ed *= 2;
if (mpz_tstbit (my, t)) /* multiply by c + I*d */
{
mpz_mul (u, a, c);
mpz_submul (u, b, d); /* ac-bd */
mpz_mul (b, b, c);
mpz_addmul (b, a, d); /* bc+ad */
mpz_swap (a, u);
ed += ec;
}
/* remove powers of two in (a,b) */
if (mpz_cmp_ui (a, 0) == 0)
{
w = mpz_scan1 (b, 0);
mpz_tdiv_q_2exp (b, b, w);
ed += (mpfr_exp_t) w;
}
else if (mpz_cmp_ui (b, 0) == 0)
{
w = mpz_scan1 (a, 0);
mpz_tdiv_q_2exp (a, a, w);
ed += (mpfr_exp_t) w;
}
else
{
w = mpz_scan1 (a, 0);
v = mpz_scan1 (b, 0);
if (v < w)
w = v;
mpz_tdiv_q_2exp (a, a, w);
mpz_tdiv_q_2exp (b, b, w);
ed += (mpfr_exp_t) w;
}
if ( (mpfr_prec_t) mpz_sizeinbase (a, 2) > maxprec
|| (mpfr_prec_t) mpz_sizeinbase (b, 2) > maxprec)
goto end;
}
/* now a+I*b = (c+I*d)^my */
while (ey-- > 0)
{
unsigned long sa, sb;
/* square a + I*b */
mpz_mul (u, a, b);
mpz_mul (a, a, a);
mpz_submul (a, b, b);
mpz_mul_2exp (b, u, 1);
ed *= 2;
/* divide by largest 2^n possible, to avoid many loops for e.g.,
(2+2*I)^16777216 */
sa = mpz_scan1 (a, 0);
sb = mpz_scan1 (b, 0);
sa = (sa <= sb) ? sa : sb;
mpz_tdiv_q_2exp (a, a, sa);
mpz_tdiv_q_2exp (b, b, sa);
ed += (mpfr_exp_t) sa;
if ( (mpfr_prec_t) mpz_sizeinbase (a, 2) > maxprec
|| (mpfr_prec_t) mpz_sizeinbase (b, 2) > maxprec)
goto end;
}
ret = mpfr_set_z (mpc_realref(z), a, MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_z (mpc_imagref(z), b, MPC_RND_IM(rnd)));
mpfr_mul_2si (mpc_realref(z), mpc_realref(z), ed, MPC_RND_RE(rnd));
mpfr_mul_2si (mpc_imagref(z), mpc_imagref(z), ed, MPC_RND_IM(rnd));
end:
mpz_clear (my);
mpz_clear (a);
mpz_clear (b);
mpz_clear (c);
mpz_clear (d);
mpz_clear (u);
if (ret >= 0 && x_imag)
fix_sign (z, sign_rex, sign_imx, (z_is_y) ? copy_of_y : y);
if (z_is_y)
mpfr_clear (copy_of_y);
return ret;
}
int
mpfr_log (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_prec_t p, q;
mpfr_t tmp1, tmp2;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL(group);
MPFR_LOG_FUNC
(("a[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (a), mpfr_log_prec, a, rnd_mode),
("r[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (r), mpfr_log_prec, r,
inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a)))
{
/* If a is NaN, the result is NaN */
if (MPFR_IS_NAN (a))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* check for infinity before zero */
else if (MPFR_IS_INF (a))
{
if (MPFR_IS_NEG (a))
/* log(-Inf) = NaN */
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
else /* log(+Inf) = +Inf */
{
MPFR_SET_INF (r);
MPFR_SET_POS (r);
MPFR_RET (0);
}
}
else /* a is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (a));
MPFR_SET_INF (r);
MPFR_SET_NEG (r);
mpfr_set_divby0 ();
MPFR_RET (0); /* log(0) is an exact -infinity */
}
}
/* If a is negative, the result is NaN */
else if (MPFR_UNLIKELY (MPFR_IS_NEG (a)))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* If a is 1, the result is 0 */
else if (MPFR_UNLIKELY (MPFR_GET_EXP (a) == 1 && mpfr_cmp_ui (a, 1) == 0))
{
MPFR_SET_ZERO (r);
MPFR_SET_POS (r);
MPFR_RET (0); /* only "normal" case where the result is exact */
}
q = MPFR_PREC (r);
/* use initial precision about q+lg(q)+5 */
p = q + 5 + 2 * MPFR_INT_CEIL_LOG2 (q);
/* % ~(mpfr_prec_t)GMP_NUMB_BITS ;
m=q; while (m) { p++; m >>= 1; } */
/* if (MPFR_LIKELY(p % GMP_NUMB_BITS != 0))
p += GMP_NUMB_BITS - (p%GMP_NUMB_BITS); */
MPFR_SAVE_EXPO_MARK (expo);
MPFR_GROUP_INIT_2 (group, p, tmp1, tmp2);
MPFR_ZIV_INIT (loop, p);
for (;;)
{
long m;
mpfr_exp_t cancel;
/* Calculus of m (depends on p) */
m = (p + 1) / 2 - MPFR_GET_EXP (a) + 1;
mpfr_mul_2si (tmp2, a, m, MPFR_RNDN); /* s=a*2^m, err<=1 ulp */
mpfr_div (tmp1, __gmpfr_four, tmp2, MPFR_RNDN);/* 4/s, err<=2 ulps */
mpfr_agm (tmp2, __gmpfr_one, tmp1, MPFR_RNDN); /* AG(1,4/s),err<=3 ulps */
mpfr_mul_2ui (tmp2, tmp2, 1, MPFR_RNDN); /* 2*AG(1,4/s), err<=3 ulps */
mpfr_const_pi (tmp1, MPFR_RNDN); /* compute pi, err<=1ulp */
mpfr_div (tmp2, tmp1, tmp2, MPFR_RNDN); /* pi/2*AG(1,4/s), err<=5ulps */
mpfr_const_log2 (tmp1, MPFR_RNDN); /* compute log(2), err<=1ulp */
mpfr_mul_si (tmp1, tmp1, m, MPFR_RNDN); /* compute m*log(2),err<=2ulps */
mpfr_sub (tmp1, tmp2, tmp1, MPFR_RNDN); /* log(a), err<=7ulps+cancel */
if (MPFR_LIKELY (MPFR_IS_PURE_FP (tmp1) && MPFR_IS_PURE_FP (tmp2)))
{
cancel = MPFR_GET_EXP (tmp2) - MPFR_GET_EXP (tmp1);
MPFR_LOG_MSG (("canceled bits=%ld\n", (long) cancel));
MPFR_LOG_VAR (tmp1);
if (MPFR_UNLIKELY (cancel < 0))
cancel = 0;
/* we have 7 ulps of error from the above roundings,
4 ulps from the 4/s^2 second order term,
plus the canceled bits */
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp1, p-cancel-4, q, rnd_mode)))
break;
/* VL: I think it is better to have an increment that it isn't
too low; in particular, the increment must be positive even
if cancel = 0 (can this occur?). */
p += cancel >= 8 ? cancel : 8;
}
else
{
/* TODO: find why this case can occur and what is best to do
with it. */
p += 32;
}
MPFR_ZIV_NEXT (loop, p);
MPFR_GROUP_REPREC_2 (group, p, tmp1, tmp2);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (r, tmp1, rnd_mode);
/* We clean */
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (r, inexact, rnd_mode);
}
void FixComplexKCM::emulate(TestCase * tc) {
/* first we are going to format the entries */
mpz_class reIn = tc->getInputValue("ReIN");
mpz_class imIn = tc->getInputValue("ImIN");
/* Sign handling */
// Msb index counting from one
bool reInNeg = (
signedInput &&
(mpz_tstbit(reIn.get_mpz_t(), input_width - 1) == 1)
);
bool imInNeg = (
signedInput &&
(mpz_tstbit(imIn.get_mpz_t(), input_width - 1) == 1)
);
// 2's complement -> absolute value unsigned representation
if(reInNeg)
{
reIn = (mpz_class(1) << input_width) - reIn;
}
if(imInNeg)
{
imIn = (mpz_class(1) << input_width) - imIn;
}
//Cast to mp floating point number
mpfr_t reIn_mpfr, imIn_mpfr;
mpfr_init2(reIn_mpfr, input_width + 1);
mpfr_init2(imIn_mpfr, input_width + 1);
//Exact
mpfr_set_z(reIn_mpfr, reIn.get_mpz_t(), GMP_RNDN);
mpfr_set_z(imIn_mpfr, imIn.get_mpz_t(), GMP_RNDN);
//Scaling : Exact
mpfr_mul_2si(reIn_mpfr, reIn_mpfr, lsb_in, GMP_RNDN);
mpfr_mul_2si(imIn_mpfr, imIn_mpfr, lsb_in, GMP_RNDN);
mpfr_t re_prod, im_prod, crexim_prod, xrecim_prod;
mpfr_t reOut, imOut;
mpfr_inits2(
2 * input_width + 1,
re_prod,
im_prod,
crexim_prod,
xrecim_prod,
NULL
);
mpfr_inits2(5 * max(outputim_width, outputre_width) + 1, reOut, imOut, NULL);
// c_r * x_r -> re_prod
mpfr_mul(re_prod, reIn_mpfr, mpfr_constant_re, GMP_RNDN);
// c_i * x_i -> im_prod
mpfr_mul(im_prod, imIn_mpfr, mpfr_constant_im, GMP_RNDN);
// c_r * x_i -> crexim_prod
mpfr_mul(crexim_prod, mpfr_constant_re, imIn_mpfr, GMP_RNDN);
// x_r * c_im -> xrecim_prod
mpfr_mul(xrecim_prod, reIn_mpfr, mpfr_constant_im, GMP_RNDN);
/* Input sign correction */
if(reInNeg)
{
//Exact
mpfr_neg(re_prod, re_prod, GMP_RNDN);
mpfr_neg(xrecim_prod, xrecim_prod, GMP_RNDN);
}
if(imInNeg)
{
//Exact
mpfr_neg(im_prod, im_prod, GMP_RNDN);
mpfr_neg(crexim_prod, crexim_prod, GMP_RNDN);
}
mpfr_sub(reOut, re_prod, im_prod, GMP_RNDN);
mpfr_add(imOut, crexim_prod, xrecim_prod, GMP_RNDN);
bool reOutNeg = (mpfr_sgn(reOut) < 0);
bool imOutNeg = (mpfr_sgn(imOut) < 0);
if(reOutNeg)
{
//Exact
mpfr_abs(reOut, reOut, GMP_RNDN);
}
if(imOutNeg)
{
//Exact
mpfr_abs(imOut, imOut, GMP_RNDN);
}
//Scale back (Exact)
mpfr_mul_2si(reOut, reOut, -lsb_out, GMP_RNDN);
mpfr_mul_2si(imOut, imOut, -lsb_out, GMP_RNDN);
//Get bits vector
mpz_class reUp, reDown, imUp, imDown, carry;
mpfr_get_z(reUp.get_mpz_t(), reOut, GMP_RNDU);
mpfr_get_z(reDown.get_mpz_t(), reOut, GMP_RNDD);
mpfr_get_z(imDown.get_mpz_t(), imOut, GMP_RNDD);
mpfr_get_z(imUp.get_mpz_t(), imOut, GMP_RNDU);
carry = 0;
//If result was negative, compute 2's complement
if(reOutNeg)
{
reUp = (mpz_class(1) << outputre_width) - reUp;
reDown = (mpz_class(1) << outputre_width) - reDown;
}
if(imOutNeg)
{
imUp = (mpz_class(1) << outputim_width) - imUp;
imDown = (mpz_class(1) << outputim_width) - imDown;
}
//Handle border cases
if(imUp > (mpz_class(1) << outputim_width) - 1 )
{
imUp = 0;
}
if(reUp > (mpz_class(1) << outputre_width) - 1)
{
reUp = 0;
}
if(imDown > (mpz_class(1) << outputim_width) - 1 )
{
imDown = 0;
}
if(reDown > (mpz_class(1) << outputre_width) - 1)
{
reDown = 0;
}
//Add expected results to corresponding outputs
tc->addExpectedOutput("ReOut", reUp);
tc->addExpectedOutput("ReOut", reDown);
tc->addExpectedOutput("ImOut", imUp);
tc->addExpectedOutput("ImOut", imDown);
mpfr_clears(
reOut,
imOut,
re_prod,
im_prod,
crexim_prod,
xrecim_prod,
reIn_mpfr,
imIn_mpfr,
NULL
);
}
int
main (void)
{
#ifdef MPFR_HAVE_FESETROUND
mpfr_t half, x, y;
mp_rnd_t rnd_mode;
#endif
mpfr_test_init ();
#ifdef MPFR_HAVE_FESETROUND
mpfr_init2(half, 2);
mpfr_set_ui(half, 1, GMP_RNDZ);
mpfr_div_2ui(half, half, 1, GMP_RNDZ); /* has exponent 0 */
mpfr_init2(x, 128);
mpfr_init2(y, 128);
for (rnd_mode = 0; rnd_mode <= 3; rnd_mode++)
{
int i, j, si, sj;
double di, dj;
mpfr_set_machine_rnd_mode (rnd_mode);
for (i = 1, di = 0.25; i < 127; i++, di *= 0.5)
for (si = 0; si <= 1; si++)
{
mpfr_div_2ui (x, half, i, GMP_RNDZ);
(si ? mpfr_sub : mpfr_add)(x, half, x, GMP_RNDZ);
/* x = 1/2 +/- 1/2^(1+i) */
for (j = i+1, dj = di * 0.5; j < 128 && j < i+53; j++, dj *= 0.5)
for (sj = 0; sj <= 1; sj++)
{
double c, d, dd;
int exp;
char *f;
mpfr_div_2ui (y, half, j, GMP_RNDZ);
(sj ? mpfr_sub : mpfr_add)(y, x, y, GMP_RNDZ);
/* y = 1/2 +/- 1/2^(1+i) +/- 1/2^(1+j) */
exp = (LONG_RAND() % 47) - 23;
mpfr_mul_2si (y, y, exp, GMP_RNDZ);
if (mpfr_inexflag_p())
{
fprintf(stderr, "Error in tget_d: inexact flag for "
"(i,si,j,sj,rnd,exp) = (%d,%d,%d,%d,%d,%d)\n",
i, si, j, sj, rnd_mode, exp);
exit(1);
}
dd = si != sj ? di - dj : di + dj;
d = si ? 0.5 - dd : 0.5 + dd;
if ((LONG_RAND() / 1024) & 1)
{
c = mpfr_get_d (y, rnd_mode);
f = "mpfr_get_d";
}
else
{
exp = (LONG_RAND() % 47) - 23;
c = mpfr_get_d3 (y, exp, rnd_mode);
f = "mpfr_get_d3";
if (si) /* then real d < 0.5 */
d *= sj && i == 1 ? 4 : 2; /* normalize real d */
}
if (exp > 0)
d *= 1 << exp;
if (exp < 0)
d /= 1 << -exp;
if (c != d)
{
fprintf (stderr, "Error in tget_d (%s) for "
"(i,si,j,sj,rnd,exp) = (%d,%d,%d,%d,%d,%d)\n"
"got %.25Le instead of %.25Le\n"
"Difference: %.19e\n",
f, i, si, j, sj, rnd_mode, exp,
(long double) c, (long double) d, d - c);
exit (1);
}
}
}
}
mpfr_clear(half);
mpfr_clear(x);
mpfr_clear(y);
#endif
if (check_denorms ())
exit (1);
return 0;
}
/* set f to the rational q */
int
mpfr_set_q (mpfr_ptr f, mpq_srcptr q, mp_rnd_t rnd)
{
mpz_srcptr num, den;
mpfr_t n, d;
int inexact;
int cn, cd;
long shift;
mp_size_t sn, sd;
MPFR_SAVE_EXPO_DECL (expo);
num = mpq_numref (q);
den = mpq_denref (q);
/* NAN and INF for mpq are not really documented, but could be found */
if (MPFR_UNLIKELY (mpz_sgn (num) == 0))
{
if (MPFR_UNLIKELY (mpz_sgn (den) == 0))
{
MPFR_SET_NAN (f);
MPFR_RET_NAN;
}
else
{
MPFR_SET_ZERO (f);
MPFR_SET_POS (f);
MPFR_RET (0);
}
}
if (MPFR_UNLIKELY (mpz_sgn (den) == 0))
{
MPFR_SET_INF (f);
MPFR_SET_SIGN (f, mpz_sgn (num));
MPFR_RET (0);
}
MPFR_SAVE_EXPO_MARK (expo);
cn = set_z (n, num, &sn);
cd = set_z (d, den, &sd);
sn -= sd;
if (MPFR_UNLIKELY (sn > MPFR_EMAX_MAX / BITS_PER_MP_LIMB))
{
inexact = mpfr_overflow (f, rnd, MPFR_SIGN (f));
goto end;
}
if (MPFR_UNLIKELY (sn < MPFR_EMIN_MIN / BITS_PER_MP_LIMB -1))
{
if (rnd == GMP_RNDN)
rnd = GMP_RNDZ;
inexact = mpfr_underflow (f, rnd, MPFR_SIGN (f));
goto end;
}
inexact = mpfr_div (f, n, d, rnd);
shift = BITS_PER_MP_LIMB*sn+cn-cd;
MPFR_ASSERTD (shift == BITS_PER_MP_LIMB*sn+cn-cd);
cd = mpfr_mul_2si (f, f, shift, rnd);
MPFR_SAVE_EXPO_FREE (expo);
if (MPFR_UNLIKELY (cd != 0))
inexact = cd;
else
inexact = mpfr_check_range (f, inexact, rnd);
end:
mpfr_clear (d);
mpfr_clear (n);
return inexact;
}
/* Assumes that the exponent range has already been extended and if y is
an integer, then the result is not exact in unbounded exponent range. */
int
mpfr_pow_general (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y,
mpfr_rnd_t rnd_mode, int y_is_integer, mpfr_save_expo_t *expo)
{
mpfr_t t, u, k, absx;
int neg_result = 0;
int k_non_zero = 0;
int check_exact_case = 0;
int inexact;
/* Declaration of the size variable */
mpfr_prec_t Nz = MPFR_PREC(z); /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_exp_t err; /* error */
MPFR_ZIV_DECL (ziv_loop);
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));
/* We put the absolute value of x in absx, pointing to the significand
of x to avoid allocating memory for the significand of absx. */
MPFR_ALIAS(absx, x, /*sign=*/ 1, /*EXP=*/ MPFR_EXP(x));
/* We will compute the absolute value of the result. So, let's
invert the rounding mode if the result is negative. */
if (MPFR_IS_NEG (x) && is_odd (y))
{
neg_result = 1;
rnd_mode = MPFR_INVERT_RND (rnd_mode);
}
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Nz + 5 + MPFR_INT_CEIL_LOG2 (Nz);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
MPFR_ZIV_INIT (ziv_loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags1);
/* compute exp(y*ln|x|), using MPFR_RNDU to get an upper bound, so
that we can detect underflows. */
mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDD : MPFR_RNDU); /* ln|x| */
mpfr_mul (t, y, t, MPFR_RNDU); /* y*ln|x| */
if (k_non_zero)
{
MPFR_LOG_MSG (("subtract k * ln(2)\n", 0));
mpfr_const_log2 (u, MPFR_RNDD);
mpfr_mul (u, u, k, MPFR_RNDD);
/* Error on u = k * log(2): < k * 2^(-Nt) < 1. */
mpfr_sub (t, t, u, MPFR_RNDU);
MPFR_LOG_MSG (("t = y * ln|x| - k * ln(2)\n", 0));
MPFR_LOG_VAR (t);
}
/* estimate of the error -- see pow function in algorithms.tex.
The error on t is at most 1/2 + 3*2^(EXP(t)+1) ulps, which is
<= 2^(EXP(t)+3) for EXP(t) >= -1, and <= 2 ulps for EXP(t) <= -2.
Additional error if k_no_zero: treal = t * errk, with
1 - |k| * 2^(-Nt) <= exp(-|k| * 2^(-Nt)) <= errk <= 1,
i.e., additional absolute error <= 2^(EXP(k)+EXP(t)-Nt).
Total error <= 2^err1 + 2^err2 <= 2^(max(err1,err2)+1). */
err = MPFR_NOTZERO (t) && MPFR_GET_EXP (t) >= -1 ?
MPFR_GET_EXP (t) + 3 : 1;
if (k_non_zero)
{
if (MPFR_GET_EXP (k) > err)
err = MPFR_GET_EXP (k);
err++;
}
MPFR_BLOCK (flags1, mpfr_exp (t, t, MPFR_RNDN)); /* exp(y*ln|x|)*/
/* We need to test */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (t) || MPFR_UNDERFLOW (flags1)))
{
mpfr_prec_t Ntmin;
MPFR_BLOCK_DECL (flags2);
MPFR_ASSERTN (!k_non_zero);
MPFR_ASSERTN (!MPFR_IS_NAN (t));
/* Real underflow? */
if (MPFR_IS_ZERO (t))
{
/* Underflow. We computed rndn(exp(t)), where t >= y*ln|x|.
Therefore rndn(|x|^y) = 0, and we have a real underflow on
|x|^y. */
inexact = mpfr_underflow (z, rnd_mode == MPFR_RNDN ? MPFR_RNDZ
: rnd_mode, MPFR_SIGN_POS);
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT
| MPFR_FLAGS_UNDERFLOW);
break;
}
/* Real overflow? */
if (MPFR_IS_INF (t))
{
/* Note: we can probably use a low precision for this test. */
mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDU : MPFR_RNDD);
mpfr_mul (t, y, t, MPFR_RNDD); /* y * ln|x| */
MPFR_BLOCK (flags2, mpfr_exp (t, t, MPFR_RNDD));
/* t = lower bound on exp(y * ln|x|) */
if (MPFR_OVERFLOW (flags2))
{
/* We have computed a lower bound on |x|^y, and it
overflowed. Therefore we have a real overflow
on |x|^y. */
inexact = mpfr_overflow (z, rnd_mode, MPFR_SIGN_POS);
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT
| MPFR_FLAGS_OVERFLOW);
break;
}
}
k_non_zero = 1;
Ntmin = sizeof(mpfr_exp_t) * CHAR_BIT;
if (Ntmin > Nt)
{
Nt = Ntmin;
mpfr_set_prec (t, Nt);
}
mpfr_init2 (u, Nt);
mpfr_init2 (k, Ntmin);
mpfr_log2 (k, absx, MPFR_RNDN);
mpfr_mul (k, y, k, MPFR_RNDN);
mpfr_round (k, k);
MPFR_LOG_VAR (k);
/* |y| < 2^Ntmin, therefore |k| < 2^Nt. */
continue;
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - err, Nz, rnd_mode)))
{
inexact = mpfr_set (z, t, rnd_mode);
break;
}
/* check exact power, except when y is an integer (since the
exact cases for y integer have already been filtered out) */
if (check_exact_case == 0 && ! y_is_integer)
{
if (mpfr_pow_is_exact (z, absx, y, rnd_mode, &inexact))
break;
check_exact_case = 1;
}
/* reactualisation of the precision */
MPFR_ZIV_NEXT (ziv_loop, Nt);
mpfr_set_prec (t, Nt);
if (k_non_zero)
mpfr_set_prec (u, Nt);
}
MPFR_ZIV_FREE (ziv_loop);
if (k_non_zero)
{
int inex2;
long lk;
/* The rounded result in an unbounded exponent range is z * 2^k. As
* MPFR chooses underflow after rounding, the mpfr_mul_2si below will
* correctly detect underflows and overflows. However, in rounding to
* nearest, if z * 2^k = 2^(emin - 2), then the double rounding may
* affect the result. We need to cope with that before overwriting z.
* This can occur only if k < 0 (this test is necessary to avoid a
* potential integer overflow).
* If inexact >= 0, then the real result is <= 2^(emin - 2), so that
* o(2^(emin - 2)) = +0 is correct. If inexact < 0, then the real
* result is > 2^(emin - 2) and we need to round to 2^(emin - 1).
*/
MPFR_ASSERTN (MPFR_EXP_MAX <= LONG_MAX);
lk = mpfr_get_si (k, MPFR_RNDN);
/* Due to early overflow detection, |k| should not be much larger than
* MPFR_EMAX_MAX, and as MPFR_EMAX_MAX <= MPFR_EXP_MAX/2 <= LONG_MAX/2,
* an overflow should not be possible in mpfr_get_si (and lk is exact).
* And one even has the following assertion. TODO: complete proof.
*/
MPFR_ASSERTD (lk > LONG_MIN && lk < LONG_MAX);
/* Note: even in case of overflow (lk inexact), the code is correct.
* Indeed, for the 3 occurrences of lk:
* - The test lk < 0 is correct as sign(lk) = sign(k).
* - In the test MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk,
* if lk is inexact, then lk = LONG_MIN <= MPFR_EXP_MIN
* (the minimum value of the mpfr_exp_t type), and
* __gmpfr_emin - 1 - lk >= MPFR_EMIN_MIN - 1 - 2 * MPFR_EMIN_MIN
* >= - MPFR_EMIN_MIN - 1 = MPFR_EMAX_MAX - 1. However, from the
* choice of k, z has been chosen to be around 1, so that the
* result of the test is false, as if lk were exact.
* - In the mpfr_mul_2si (z, z, lk, rnd_mode), if lk is inexact,
* then |lk| >= LONG_MAX >= MPFR_EXP_MAX, and as z is around 1,
* mpfr_mul_2si underflows or overflows in the same way as if
* lk were exact.
* TODO: give a bound on |t|, then on |EXP(z)|.
*/
if (rnd_mode == MPFR_RNDN && inexact < 0 && lk < 0 &&
MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk && mpfr_powerof2_raw (z))
{
/* Rounding to nearest, real result > z * 2^k = 2^(emin - 2),
* underflow case: as the minimum precision is > 1, we will
* obtain the correct result and exceptions by replacing z by
* nextabove(z).
*/
MPFR_ASSERTN (MPFR_PREC_MIN > 1);
mpfr_nextabove (z);
}
MPFR_CLEAR_FLAGS ();
inex2 = mpfr_mul_2si (z, z, lk, rnd_mode);
if (inex2) /* underflow or overflow */
{
inexact = inex2;
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, __gmpfr_flags);
}
mpfr_clears (u, k, (mpfr_ptr) 0);
}
mpfr_clear (t);
/* update the sign of the result if x was negative */
if (neg_result)
{
MPFR_SET_NEG(z);
inexact = -inexact;
}
return inexact;
}
int
mpfr_mul_ui (mpfr_ptr y, mpfr_srcptr x, unsigned long int u, mpfr_rnd_t rnd_mode)
{
mp_limb_t *yp;
mp_size_t xn;
int cnt, inexact;
MPFR_TMP_DECL (marker);
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 (u != 0)
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, x);
MPFR_RET (0); /* infinity is exact */
}
else /* 0 * infinity */
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
}
else /* x is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
MPFR_RET (0); /* zero is exact */
}
}
else if (MPFR_UNLIKELY (u <= 1))
{
if (u < 1)
{
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, x);
MPFR_RET (0); /* zero is exact */
}
else
return mpfr_set (y, x, rnd_mode);
}
else if (MPFR_UNLIKELY (IS_POW2 (u)))
return mpfr_mul_2si (y, x, MPFR_INT_CEIL_LOG2 (u), rnd_mode);
yp = MPFR_MANT (y);
xn = MPFR_LIMB_SIZE (x);
MPFR_ASSERTD (xn < MP_SIZE_T_MAX);
MPFR_TMP_MARK(marker);
yp = MPFR_TMP_LIMBS_ALLOC (xn + 1);
MPFR_ASSERTN (u == (mp_limb_t) u);
yp[xn] = mpn_mul_1 (yp, MPFR_MANT (x), xn, u);
/* x * u is stored in yp[xn], ..., yp[0] */
/* since the case u=1 was treated above, we have u >= 2, thus
yp[xn] >= 1 since x was msb-normalized */
MPFR_ASSERTD (yp[xn] != 0);
if (MPFR_LIKELY (MPFR_LIMB_MSB (yp[xn]) == 0))
{
count_leading_zeros (cnt, yp[xn]);
mpn_lshift (yp, yp, xn + 1, cnt);
}
else
{
cnt = 0;
}
/* now yp[xn], ..., yp[0] is msb-normalized too, and has at most
PREC(x) + (GMP_NUMB_BITS - cnt) non-zero bits */
MPFR_RNDRAW (inexact, y, yp, (mpfr_prec_t) (xn + 1) * GMP_NUMB_BITS,
rnd_mode, MPFR_SIGN (x), cnt -- );
MPFR_TMP_FREE (marker);
cnt = GMP_NUMB_BITS - cnt;
if (MPFR_UNLIKELY (__gmpfr_emax < MPFR_EMAX_MIN + cnt
|| MPFR_GET_EXP (x) > __gmpfr_emax - cnt))
return mpfr_overflow (y, rnd_mode, MPFR_SIGN(x));
MPFR_SET_EXP (y, MPFR_GET_EXP (x) + cnt);
MPFR_SET_SAME_SIGN (y, x);
return inexact;
}
/* return non zero iff x^y is exact.
Assumes x and y are ordinary numbers,
y is not an integer, x is not a power of 2 and x is positive
If x^y is exact, it computes it and sets *inexact.
*/
static int
mpfr_pow_is_exact (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y,
mpfr_rnd_t rnd_mode, int *inexact)
{
mpz_t a, c;
mpfr_exp_t d, b;
unsigned long i;
int res;
MPFR_ASSERTD (!MPFR_IS_SINGULAR (y));
MPFR_ASSERTD (!MPFR_IS_SINGULAR (x));
MPFR_ASSERTD (!mpfr_integer_p (y));
MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_INT_SIGN (x),
MPFR_GET_EXP (x) - 1) != 0);
MPFR_ASSERTD (MPFR_IS_POS (x));
if (MPFR_IS_NEG (y))
return 0; /* x is not a power of two => x^-y is not exact */
/* compute d such that y = c*2^d with c odd integer */
mpz_init (c);
d = mpfr_get_z_2exp (c, y);
i = mpz_scan1 (c, 0);
mpz_fdiv_q_2exp (c, c, i);
d += i;
/* now y=c*2^d with c odd */
/* Since y is not an integer, d is necessarily < 0 */
MPFR_ASSERTD (d < 0);
/* Compute a,b such that x=a*2^b */
mpz_init (a);
b = mpfr_get_z_2exp (a, x);
i = mpz_scan1 (a, 0);
mpz_fdiv_q_2exp (a, a, i);
b += i;
/* now x=a*2^b with a is odd */
for (res = 1 ; d != 0 ; d++)
{
/* a*2^b is a square iff
(i) a is a square when b is even
(ii) 2*a is a square when b is odd */
if (b % 2 != 0)
{
mpz_mul_2exp (a, a, 1); /* 2*a */
b --;
}
MPFR_ASSERTD ((b % 2) == 0);
if (!mpz_perfect_square_p (a))
{
res = 0;
goto end;
}
mpz_sqrt (a, a);
b = b / 2;
}
/* Now x = (a'*2^b')^(2^-d) with d < 0
so x^y = ((a'*2^b')^(2^-d))^(c*2^d)
= ((a'*2^b')^c with c odd integer */
{
mpfr_t tmp;
mpfr_prec_t p;
MPFR_MPZ_SIZEINBASE2 (p, a);
mpfr_init2 (tmp, p); /* prec = 1 should not be possible */
res = mpfr_set_z (tmp, a, MPFR_RNDN);
MPFR_ASSERTD (res == 0);
res = mpfr_mul_2si (tmp, tmp, b, MPFR_RNDN);
MPFR_ASSERTD (res == 0);
*inexact = mpfr_pow_z (z, tmp, c, rnd_mode);
mpfr_clear (tmp);
res = 1;
}
end:
mpz_clear (a);
mpz_clear (c);
return res;
}
static void
underflow (mpfr_exp_t e)
{
mpfr_t x, y, z1, z2;
mpfr_exp_t emin;
int i, k;
int prec;
int rnd;
int div;
int inex1, inex2;
unsigned int flags1, flags2;
/* Test mul_2si(x, e - k), div_2si(x, k - e) and div_2ui(x, k - e)
* with emin = e, x = 1 + i/16, i in { -1, 0, 1 }, and k = 1 to 4,
* by comparing the result with the one of a simple division.
*/
emin = mpfr_get_emin ();
set_emin (e);
mpfr_inits2 (8, x, y, (mpfr_ptr) 0);
for (i = 15; i <= 17; i++)
{
inex1 = mpfr_set_ui_2exp (x, i, -4, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
for (prec = 6; prec >= 3; prec -= 3)
{
mpfr_inits2 (prec, z1, z2, (mpfr_ptr) 0);
RND_LOOP (rnd)
for (k = 1; k <= 4; k++)
{
/* The following one is assumed to be correct. */
inex1 = mpfr_mul_2si (y, x, e, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
inex1 = mpfr_set_ui (z1, 1 << k, MPFR_RNDN);
MPFR_ASSERTN (inex1 == 0);
mpfr_clear_flags ();
/* Do not use mpfr_div_ui to avoid the optimization
by mpfr_div_2si. */
inex1 = mpfr_div (z1, y, z1, (mpfr_rnd_t) rnd);
flags1 = __gmpfr_flags;
for (div = 0; div <= 2; div++)
{
mpfr_clear_flags ();
inex2 = div == 0 ?
mpfr_mul_2si (z2, x, e - k, (mpfr_rnd_t) rnd) : div == 1 ?
mpfr_div_2si (z2, x, k - e, (mpfr_rnd_t) rnd) :
mpfr_div_2ui (z2, x, k - e, (mpfr_rnd_t) rnd);
flags2 = __gmpfr_flags;
if (flags1 == flags2 && SAME_SIGN (inex1, inex2) &&
mpfr_equal_p (z1, z2))
continue;
printf ("Error in underflow(");
if (e == MPFR_EMIN_MIN)
printf ("MPFR_EMIN_MIN");
else if (e == emin)
printf ("default emin");
else
printf ("%ld", e);
printf (") with mpfr_%s,\nx = %d/16, prec = %d, k = %d, "
"%s\n", div == 0 ? "mul_2si" : div == 1 ?
"div_2si" : "div_2ui", i, prec, k,
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
printf ("Expected ");
mpfr_out_str (stdout, 16, 0, z1, MPFR_RNDN);
printf (", inex = %d, flags = %u\n", SIGN (inex1), flags1);
printf ("Got ");
mpfr_out_str (stdout, 16, 0, z2, MPFR_RNDN);
printf (", inex = %d, flags = %u\n", SIGN (inex2), flags2);
exit (1);
} /* div */
} /* k */
mpfr_clears (z1, z2, (mpfr_ptr) 0);
} /* prec */
} /* i */
mpfr_clears (x, y, (mpfr_ptr) 0);
set_emin (emin);
}
/* compute in y an approximation of sum(x^k/k/k!, k=1..infinity),
and return e such that the absolute error is bound by 2^e ulp(y) */
static mp_exp_t
mpfr_eint_aux (mpfr_t y, mpfr_srcptr x)
{
mpfr_t eps; /* dynamic (absolute) error bound on t */
mpfr_t erru, errs;
mpz_t m, s, t, u;
mp_exp_t e, sizeinbase;
mp_prec_t w = MPFR_PREC(y);
unsigned long k;
MPFR_GROUP_DECL (group);
/* for |x| <= 1, we have S := sum(x^k/k/k!, k=1..infinity) = x + R(x)
where |R(x)| <= (x/2)^2/(1-x/2) <= 2*(x/2)^2
thus |R(x)/x| <= |x|/2
thus if |x| <= 2^(-PREC(y)) we have |S - o(x)| <= ulp(y) */
if (MPFR_GET_EXP(x) <= - (mp_exp_t) w)
{
mpfr_set (y, x, GMP_RNDN);
return 0;
}
mpz_init (s); /* initializes to 0 */
mpz_init (t);
mpz_init (u);
mpz_init (m);
MPFR_GROUP_INIT_3 (group, 31, eps, erru, errs);
e = mpfr_get_z_exp (m, x); /* x = m * 2^e */
MPFR_ASSERTD (mpz_sizeinbase (m, 2) == MPFR_PREC (x));
if (MPFR_PREC (x) > w)
{
e += MPFR_PREC (x) - w;
mpz_tdiv_q_2exp (m, m, MPFR_PREC (x) - w);
}
/* remove trailing zeroes from m: this will speed up much cases where
x is a small integer divided by a power of 2 */
k = mpz_scan1 (m, 0);
mpz_tdiv_q_2exp (m, m, k);
e += k;
/* initialize t to 2^w */
mpz_set_ui (t, 1);
mpz_mul_2exp (t, t, w);
mpfr_set_ui (eps, 0, GMP_RNDN); /* eps[0] = 0 */
mpfr_set_ui (errs, 0, GMP_RNDN);
for (k = 1;; k++)
{
/* let eps[k] be the absolute error on t[k]:
since t[k] = trunc(t[k-1]*m*2^e/k), we have
eps[k+1] <= 1 + eps[k-1]*m*2^e/k + t[k-1]*m*2^(1-w)*2^e/k
= 1 + (eps[k-1] + t[k-1]*2^(1-w))*m*2^e/k
= 1 + (eps[k-1]*2^(w-1) + t[k-1])*2^(1-w)*m*2^e/k */
mpfr_mul_2ui (eps, eps, w - 1, GMP_RNDU);
mpfr_add_z (eps, eps, t, GMP_RNDU);
MPFR_MPZ_SIZEINBASE2 (sizeinbase, m);
mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, GMP_RNDU);
mpfr_div_ui (eps, eps, k, GMP_RNDU);
mpfr_add_ui (eps, eps, 1, GMP_RNDU);
mpz_mul (t, t, m);
if (e < 0)
mpz_tdiv_q_2exp (t, t, -e);
else
mpz_mul_2exp (t, t, e);
mpz_tdiv_q_ui (t, t, k);
mpz_tdiv_q_ui (u, t, k);
mpz_add (s, s, u);
/* the absolute error on u is <= 1 + eps[k]/k */
mpfr_div_ui (erru, eps, k, GMP_RNDU);
mpfr_add_ui (erru, erru, 1, GMP_RNDU);
/* and that on s is the sum of all errors on u */
mpfr_add (errs, errs, erru, GMP_RNDU);
/* we are done when t is smaller than errs */
if (mpz_sgn (t) == 0)
sizeinbase = 0;
else
MPFR_MPZ_SIZEINBASE2 (sizeinbase, t);
if (sizeinbase < MPFR_GET_EXP (errs))
break;
}
/* the truncation error is bounded by (|t|+eps)/k*(|x|/k + |x|^2/k^2 + ...)
<= (|t|+eps)/k*|x|/(k-|x|) */
mpz_abs (t, t);
mpfr_add_z (eps, eps, t, GMP_RNDU);
mpfr_div_ui (eps, eps, k, GMP_RNDU);
mpfr_abs (erru, x, GMP_RNDU); /* |x| */
mpfr_mul (eps, eps, erru, GMP_RNDU);
mpfr_ui_sub (erru, k, erru, GMP_RNDD);
if (MPFR_IS_NEG (erru))
{
/* the truncated series does not converge, return fail */
e = w;
}
else
{
mpfr_div (eps, eps, erru, GMP_RNDU);
mpfr_add (errs, errs, eps, GMP_RNDU);
mpfr_set_z (y, s, GMP_RNDN);
mpfr_div_2ui (y, y, w, GMP_RNDN);
/* errs was an absolute error bound on s. We must convert it to an error
in terms of ulp(y). Since ulp(y) = 2^(EXP(y)-PREC(y)), we must
divide the error by 2^(EXP(y)-PREC(y)), but since we divided also
y by 2^w = 2^PREC(y), we must simply divide by 2^EXP(y). */
e = MPFR_GET_EXP (errs) - MPFR_GET_EXP (y);
}
MPFR_GROUP_CLEAR (group);
mpz_clear (s);
mpz_clear (t);
mpz_clear (u);
mpz_clear (m);
return e;
}
