static void
check_cache (void)
{
mpfr_t x;
int i;
mpfr_init2 (x, 195);
mpfr_free_cache ();
i = mpfr_const_log2 (x, MPFR_RNDN);
if (i == 0)
{
printf("Error for log2. Invalid ternary value (1).\n");
exit (1);
}
mpfr_set_prec (x, 194);
i = mpfr_const_log2 (x, MPFR_RNDN);
if (i == 0)
{
printf("Error for log2. Invalid ternary value (2).\n");
exit (1);
}
mpfr_free_cache ();
mpfr_set_prec (x, 9);
mpfr_const_log2 (x, MPFR_RNDN);
mpfr_set_prec (x, 8);
mpfr_const_log2 (x, MPFR_RNDN);
if (mpfr_cmp_str (x, "0.10110001E0", 2, MPFR_RNDN))
{
printf("Error for log2. Wrong rounding.\n");
exit (1);
}
mpfr_clear (x);
}
int
mpfi_const_log2 (mpfi_ptr a)
{
mpfr_const_log2 (&(a->left), MPFI_RNDD);
mpfr_const_log2 (&(a->right), MPFI_RNDU);
return MPFI_FLAGS_BOTH_ENDPOINTS_INEXACT;
}
static void
check_large (void)
{
mpfr_t x, y, z;
mpfr_init2 (x, 25000);
mpfr_init2 (y, 26000);
mpfr_init2 (z, 26000);
(mpfr_const_log2) (x, MPFR_RNDN); /* First one ! */
(mpfr_const_log2) (y, MPFR_RNDN); /* Then the other - cache - */
mpfr_set (z, y, MPFR_RNDN);
mpfr_prec_round (y, 25000, MPFR_RNDN);
if (mpfr_cmp (x, y) != 0)
{
printf ("const_log2: error for large prec\n");
printf ("x = ");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
printf ("y = ");
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\n");
printf ("z = ");
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
/* worst-case with 15 successive ones after last bit,
to exercise can_round loop */
mpfr_set_prec (x, 26249);
mpfr_const_log2 (x, MPFR_RNDZ);
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
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;
}
MpfrFloat const_log2()
{
if(!mConst_log2)
{
mConst_log2 = allocateMpfrFloatData(false);
mpfr_const_log2(mConst_log2->mFloat, GMP_RNDN);
}
return MpfrFloat(mConst_log2);
}
static void
check_large (void)
{
mpfr_t x, y;
mpfr_init2 (x, 25000);
mpfr_init2 (y, 26000);
mpfr_const_log2 (x, GMP_RNDN); /* First one ! */
mpfr_const_log2 (y, GMP_RNDN); /* Then the other - cache - */
mpfr_prec_round (y, 25000, GMP_RNDN);
if (mpfr_cmp (x, y))
{
printf ("const_pi: error for large prec\n");
exit (1);
}
/* worst-case with 15 successive ones after last bit,
to exercise can_round loop */
mpfr_set_prec (x, 26249);
mpfr_const_log2 (x, GMP_RNDZ);
mpfr_clears (x, y, NULL);
}
void
check (mp_prec_t p0, mp_prec_t p1)
{
mpfr_t x, y, z;
mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init2 (z, p1 + 10);
mpfr_const_log2 (z, GMP_RNDN);
__mpfr_const_log2_prec = 1;
for (; p0<=p1; p0++)
{
mpfr_set_prec (x, p0);
mpfr_set_prec (y, p0);
for (rnd = 0; rnd < 4; rnd++)
{
mpfr_const_log2 (x, rnd);
mpfr_set (y, z, rnd);
if (mpfr_cmp (x, y) && mpfr_can_round (z, mpfr_get_prec(z), GMP_RNDN,
rnd, p0))
{
fprintf (stderr, "mpfr_const_log2 fails for prec=%u, rnd=%s\n",
(unsigned int) p0, mpfr_print_rnd_mode (rnd));
fprintf (stderr, "expected ");
mpfr_out_str (stderr, 2, 0, y, GMP_RNDN);
fprintf (stderr, "\ngot ");
mpfr_out_str (stderr, 2, 0, x, GMP_RNDN);
fprintf (stderr, "\n");
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
static void
check (mp_prec_t p0, mp_prec_t p1)
{
mpfr_t x, y, z;
mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init2 (z, p1 + 10);
mpfr_const_log2 (z, GMP_RNDN);
mpfr_clear_cache (__gmpfr_cache_const_log2);
for (; p0<=p1; p0++)
{
mpfr_set_prec (x, p0);
mpfr_set_prec (y, p0);
{
rnd = (mp_rnd_t) RND_RAND ();
mpfr_const_log2 (x, rnd);
mpfr_set (y, z, rnd);
if (mpfr_cmp (x, y) && mpfr_can_round (z, mpfr_get_prec(z), GMP_RNDN,
rnd, p0))
{
printf ("mpfr_const_log2 fails for prec=%u, rnd=%s\n",
(unsigned int) p0, mpfr_print_rnd_mode (rnd));
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, GMP_RNDN);
printf ("\ngot ");
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
static void
check (mpfr_prec_t p0, mpfr_prec_t p1)
{
mpfr_t x, y, z;
mpfr_rnd_t rnd;
int dif;
mpfr_init (x);
mpfr_init (y);
mpfr_init2 (z, p1 + 10);
mpfr_const_log2 (z, MPFR_RNDN);
mpfr_clear_cache (__gmpfr_cache_const_log2);
for (; p0<=p1; p0++)
{
mpfr_set_prec (x, p0);
mpfr_set_prec (y, p0);
{
rnd = RND_RAND ();
mpfr_const_log2 (x, rnd);
mpfr_set (y, z, rnd);
if ((dif = mpfr_cmp (x, y))
&& mpfr_can_round (z, mpfr_get_prec(z), MPFR_RNDN,
rnd, p0))
{
printf ("mpfr_const_log2 fails for prec=%u, rnd=%s Diff=%d\n",
(unsigned int) p0, mpfr_print_rnd_mode (rnd), dif);
printf ("expected "), mpfr_dump (y);
printf ("got "), mpfr_dump (x);
exit (1);
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
void setDefaultPrecision(unsigned long bits)
{
if(bits != mDefaultPrecision)
{
mDefaultPrecision = bits;
for(size_t i = 0; i < mData.size(); ++i)
mpfr_set_prec(mData[i].mFloat, bits);
if(mConst_pi) mpfr_const_pi(mConst_pi->mFloat, GMP_RNDN);
if(mConst_e) mpfr_const_euler(mConst_e->mFloat, GMP_RNDN);
if(mConst_log2) mpfr_const_log2(mConst_log2->mFloat, GMP_RNDN);
if(mConst_epsilon) recalculateEpsilon();
}
}
SEXP const_asMpfr(SEXP I, SEXP prec, SEXP rnd_mode)
{
SEXP val;
mpfr_t r;
int i_p = asInteger(prec);
R_mpfr_check_prec(i_p);
mpfr_init2(r, i_p);
switch(asInteger(I)) {
case 1: mpfr_const_pi (r, R_rnd2MP(rnd_mode)); break;
case 2: mpfr_const_euler (r, R_rnd2MP(rnd_mode)); break;
case 3: mpfr_const_catalan(r, R_rnd2MP(rnd_mode)); break;
case 4: mpfr_const_log2 (r, R_rnd2MP(rnd_mode)); break;
default:
error("invalid integer code {const_asMpfr()}"); /* -Wall */
}
FINISH_1_RETURN(r, val);
}
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);
}
/* 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_log2 (mpfr_ptr r, mpfr_srcptr a, mpfr_rnd_t rnd_mode)
{
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
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_RET (0); /* log2(0) is an exact -infinity */
}
}
/* If a is negative, the result is NaN */
if (MPFR_UNLIKELY (MPFR_IS_NEG (a)))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* If a is 1, the result is 0 */
if (MPFR_UNLIKELY (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 */
}
/* If a is 2^N, log2(a) is exact*/
if (MPFR_UNLIKELY (mpfr_cmp_ui_2exp (a, 1, MPFR_GET_EXP (a) - 1) == 0))
return mpfr_set_si(r, MPFR_GET_EXP (a) - 1, rnd_mode);
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, tt;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(r); /* 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 + 3 + MPFR_INT_CEIL_LOG2 (Ny);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
mpfr_init2 (tt, Nt);
/* First computation of log2 */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute log2 */
mpfr_const_log2(t,MPFR_RNDD); /* log(2) */
mpfr_log(tt,a,MPFR_RNDN); /* log(a) */
mpfr_div(t,tt,t,MPFR_RNDN); /* log(a)/log(2) */
/* estimation of the error */
err = Nt-3;
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_set_prec (tt, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (r, t, rnd_mode);
mpfr_clear (t);
mpfr_clear (tt);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (r, inexact, rnd_mode);
}
int
mpfr_erf (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xf;
int inex, large;
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, inex));
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)) /* erf(+inf) = +1, erf(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (x), MPFR_RNDN);
else /* erf(+0) = +0, erf(-0) = -0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set (y, x, MPFR_RNDN); /* should keep the sign of x */
}
}
/* now x is neither NaN, Inf nor 0 */
/* first try expansion at x=0 when x is small, or asymptotic expansion
where x is large */
MPFR_SAVE_EXPO_MARK (expo);
/* around x=0, we have erf(x) = 2x/sqrt(Pi) (1 - x^2/3 + ...),
with 1 - x^2/3 <= sqrt(Pi)*erf(x)/2/x <= 1 for x >= 0. This means that
if x^2/3 < 2^(-PREC(y)-1) we can decide of the correct rounding,
unless we have a worst-case for 2x/sqrt(Pi). */
if (MPFR_EXP(x) < - (mpfr_exp_t) (MPFR_PREC(y) / 2))
{
/* we use 2x/sqrt(Pi) (1 - x^2/3) <= erf(x) <= 2x/sqrt(Pi) for x > 0
and 2x/sqrt(Pi) <= erf(x) <= 2x/sqrt(Pi) (1 - x^2/3) for x < 0.
In both cases |2x/sqrt(Pi) (1 - x^2/3)| <= |erf(x)| <= |2x/sqrt(Pi)|.
We will compute l and h such that l <= |2x/sqrt(Pi) (1 - x^2/3)|
and |2x/sqrt(Pi)| <= h. If l and h round to the same value to
precision PREC(y) and rounding rnd_mode, then we are done. */
mpfr_t l, h; /* lower and upper bounds for erf(x) */
int ok, inex2;
mpfr_init2 (l, MPFR_PREC(y) + 17);
mpfr_init2 (h, MPFR_PREC(y) + 17);
/* first compute l */
mpfr_mul (l, x, x, MPFR_RNDU);
mpfr_div_ui (l, l, 3, MPFR_RNDU); /* upper bound on x^2/3 */
mpfr_ui_sub (l, 1, l, MPFR_RNDZ); /* lower bound on 1 - x^2/3 */
mpfr_const_pi (h, MPFR_RNDU); /* upper bound of Pi */
mpfr_sqrt (h, h, MPFR_RNDU); /* upper bound on sqrt(Pi) */
mpfr_div (l, l, h, MPFR_RNDZ); /* lower bound on 1/sqrt(Pi) (1 - x^2/3) */
mpfr_mul_2ui (l, l, 1, MPFR_RNDZ); /* 2/sqrt(Pi) (1 - x^2/3) */
mpfr_mul (l, l, x, MPFR_RNDZ); /* |l| is a lower bound on
|2x/sqrt(Pi) (1 - x^2/3)| */
/* now compute h */
mpfr_const_pi (h, MPFR_RNDD); /* lower bound on Pi */
mpfr_sqrt (h, h, MPFR_RNDD); /* lower bound on sqrt(Pi) */
mpfr_div_2ui (h, h, 1, MPFR_RNDD); /* lower bound on sqrt(Pi)/2 */
/* since sqrt(Pi)/2 < 1, the following should not underflow */
mpfr_div (h, x, h, MPFR_IS_POS(x) ? MPFR_RNDU : MPFR_RNDD);
/* round l and h to precision PREC(y) */
inex = mpfr_prec_round (l, MPFR_PREC(y), rnd_mode);
inex2 = mpfr_prec_round (h, MPFR_PREC(y), rnd_mode);
/* Caution: we also need inex=inex2 (inex might be 0). */
ok = SAME_SIGN (inex, inex2) && mpfr_cmp (l, h) == 0;
if (ok)
mpfr_set (y, h, rnd_mode);
mpfr_clear (l);
mpfr_clear (h);
if (ok)
goto end;
/* this test can still fail for small precision, for example
for x=-0.100E-2 with a target precision of 3 bits, since
the error term x^2/3 is not that small. */
}
mpfr_init2 (xf, 53);
mpfr_const_log2 (xf, MPFR_RNDU);
mpfr_div (xf, x, xf, MPFR_RNDZ); /* round to zero ensures we get a lower
bound of |x/log(2)| */
mpfr_mul (xf, xf, x, MPFR_RNDZ);
large = mpfr_cmp_ui (xf, MPFR_PREC (y) + 1) > 0;
mpfr_clear (xf);
/* when x goes to infinity, we have erf(x) = 1 - 1/sqrt(Pi)/exp(x^2)/x + ...
and |erf(x) - 1| <= exp(-x^2) is true for any x >= 0, thus if
exp(-x^2) < 2^(-PREC(y)-1) the result is 1 or 1-epsilon.
This rewrites as x^2/log(2) > p+1. */
if (MPFR_UNLIKELY (large))
/* |erf x| = 1 or 1- */
{
mpfr_rnd_t rnd2 = MPFR_IS_POS (x) ? rnd_mode : MPFR_INVERT_RND(rnd_mode);
if (rnd2 == MPFR_RNDN || rnd2 == MPFR_RNDU || rnd2 == MPFR_RNDA)
{
inex = MPFR_INT_SIGN (x);
mpfr_set_si (y, inex, rnd2);
}
else /* round to zero */
{
inex = -MPFR_INT_SIGN (x);
mpfr_setmax (y, 0); /* warning: setmax keeps the old sign of y */
MPFR_SET_SAME_SIGN (y, x);
}
}
else /* use Taylor */
{
double xf2;
/* FIXME: get rid of doubles/mpfr_get_d here */
xf2 = mpfr_get_d (x, MPFR_RNDN);
xf2 = xf2 * xf2; /* xf2 ~ x^2 */
inex = mpfr_erf_0 (y, x, xf2, rnd_mode);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd_mode);
}
/* Wrapper for tgeneric */
static int
my_const_log2 (mpfr_ptr x, mpfr_srcptr y, mpfr_rnd_t r)
{
return mpfr_const_log2 (x, r);
}
int
main (int argc, char *argv[])
{
mpfr_t x;
int p;
mpfr_rnd_t rnd;
tests_start_mpfr ();
p = (argc>1) ? atoi(argv[1]) : 53;
rnd = (argc>2) ? (mpfr_rnd_t) atoi(argv[2]) : MPFR_RNDZ;
mpfr_init (x);
check (2, 1000);
/* check precision of 2 bits */
mpfr_set_prec (x, 2);
mpfr_const_log2 (x, MPFR_RNDN);
if (mpfr_cmp_ui_2exp(x, 3, -2)) /* 3*2^-2 */
{
printf ("mpfr_const_log2 failed for prec=2, rnd=MPFR_RNDN\n"
"expected 0.75, got ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN);
putchar('\n');
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);
puts ("");
}
mpfr_set_prec (x, 53);
mpfr_const_log2 (x, MPFR_RNDZ);
if (mpfr_cmp_str1 (x, "6.9314718055994530941e-1") )
{
printf ("mpfr_const_log2 failed for prec=53\n");
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_const_log2 (x, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "0.69314718060195446"))
{
printf ("mpfr_const_log2 failed for prec=32\n");
exit (1);
}
mpfr_clear(x);
check_large();
check_cache ();
test_generic (2, 200, 1);
tests_end_mpfr ();
return 0;
}
static void
underflow_up (int extended_emin)
{
mpfr_t minpos, x, y, t, t2;
int precx, precy;
int inex;
int rnd;
int e3;
int i, j;
mpfr_init2 (minpos, 2);
mpfr_set_ui (minpos, 0, MPFR_RNDN);
mpfr_nextabove (minpos);
/* Let's test values near the underflow boundary.
*
* Minimum representable positive number: minpos = 2^(emin - 1).
* Let's choose an MPFR number x = log(minpos) + eps, with |eps| small
* (note: eps cannot be 0, and cannot be a rational number either).
* Then exp(x) = minpos * exp(eps) ~= minpos * (1 + eps + eps^2).
* We will compute y = rnd(exp(x)) in some rounding mode, precision p.
* 1. If eps > 0, then in any rounding mode:
* rnd(exp(x)) >= minpos and no underflow.
* So, let's take x1 = rndu(log(minpos)) in some precision.
* 2. If eps < 0, then exp(x) < minpos and the result will be either 0
* or minpos. An underflow always occurs in MPFR_RNDZ and MPFR_RNDD,
* but not necessarily in MPFR_RNDN and MPFR_RNDU (this is underflow
* after rounding in an unbounded exponent range). If -a < eps < -b,
* minpos * (1 - a) < exp(x) < minpos * (1 - b + b^2).
* - If eps > -2^(-p), no underflow in MPFR_RNDU.
* - If eps > -2^(-p-1), no underflow in MPFR_RNDN.
* - If eps < - (2^(-p-1) + 2^(-2p-1)), underflow in MPFR_RNDN.
* - If eps < - (2^(-p) + 2^(-2p+1)), underflow in MPFR_RNDU.
* - In MPFR_RNDN, result is minpos iff exp(eps) > 1/2, i.e.
* - log(2) < eps < ...
*
* Moreover, since precy < MPFR_EXP_THRESHOLD (to avoid tests that take
* too much time), mpfr_exp() always selects mpfr_exp_2(); so, we need
* to test mpfr_exp_3() too. This will be done via the e3 variable:
* e3 = 0: mpfr_exp(), thus mpfr_exp_2().
* e3 = 1: mpfr_exp_3(), via the exp_3() wrapper.
* i.e.: inex = e3 ? exp_3 (y, x, rnd) : mpfr_exp (y, x, rnd);
*/
/* Case eps > 0. In revision 5461 (trunk) on a 64-bit Linux machine:
* Incorrect flags in underflow_up, eps > 0, MPFR_RNDN and extended emin
* for precx = 96, precy = 16, mpfr_exp_3
* Got 9 instead of 8.
* Note: testing this case in several precisions for x and y introduces
* some useful random. Indeed, the bug is not always triggered.
* Fixed in r5469.
*/
for (precx = 16; precx <= 128; precx += 16)
{
mpfr_init2 (x, precx);
mpfr_log (x, minpos, MPFR_RNDU);
for (precy = 16; precy <= 128; precy += 16)
{
mpfr_init2 (y, precy);
for (e3 = 0; e3 <= 1; e3++)
{
RND_LOOP (rnd)
{
int err = 0;
mpfr_clear_flags ();
inex = e3 ? exp_3 (y, x, (mpfr_rnd_t) rnd)
: mpfr_exp (y, x, (mpfr_rnd_t) rnd);
if (__gmpfr_flags != MPFR_FLAGS_INEXACT)
{
printf ("Incorrect flags in underflow_up, eps > 0, %s",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
if (extended_emin)
printf (" and extended emin");
printf ("\nfor precx = %d, precy = %d, %s\n",
precx, precy, e3 ? "mpfr_exp_3" : "mpfr_exp");
printf ("Got %u instead of %u.\n", __gmpfr_flags,
(unsigned int) MPFR_FLAGS_INEXACT);
err = 1;
}
if (mpfr_cmp0 (y, minpos) < 0)
{
printf ("Incorrect result in underflow_up, eps > 0, %s",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
if (extended_emin)
printf (" and extended emin");
printf ("\nfor precx = %d, precy = %d, %s\n",
precx, precy, e3 ? "mpfr_exp_3" : "mpfr_exp");
mpfr_dump (y);
err = 1;
}
MPFR_ASSERTN (inex != 0);
if (rnd == MPFR_RNDD || rnd == MPFR_RNDZ)
MPFR_ASSERTN (inex < 0);
if (rnd == MPFR_RNDU)
MPFR_ASSERTN (inex > 0);
if (err)
exit (1);
}
}
mpfr_clear (y);
}
mpfr_clear (x);
}
/* Case - log(2) < eps < 0 in MPFR_RNDN, starting with small-precision x;
* only check the result and the ternary value.
* Previous to r5453 (trunk), on 32-bit and 64-bit machines, this fails
* for precx = 65 and precy = 16, e.g.:
* exp_2.c:264: assertion failed: ...
* because mpfr_sub (r, x, r, MPFR_RNDU); yields a null value. This is
* fixed in r5453 by going to next Ziv's iteration.
*/
for (precx = sizeof(mpfr_exp_t) * CHAR_BIT + 1; precx <= 81; precx += 8)
{
mpfr_init2 (x, precx);
mpfr_log (x, minpos, MPFR_RNDD); /* |ulp| <= 1/2 */
for (precy = 16; precy <= 128; precy += 16)
{
mpfr_init2 (y, precy);
inex = mpfr_exp (y, x, MPFR_RNDN);
if (inex <= 0 || mpfr_cmp0 (y, minpos) != 0)
{
printf ("Error in underflow_up, - log(2) < eps < 0");
if (extended_emin)
printf (" and extended emin");
printf (" for prec = %d\nExpected ", precy);
mpfr_out_str (stdout, 16, 0, minpos, MPFR_RNDN);
printf (" (minimum positive MPFR number) and inex > 0\nGot ");
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\nwith inex = %d\n", inex);
exit (1);
}
mpfr_clear (y);
}
mpfr_clear (x);
}
/* Cases eps ~ -2^(-p) and eps ~ -2^(-p-1). More precisely,
* _ for j = 0, eps > -2^(-(p+i)),
* _ for j = 1, eps < - (2^(-(p+i)) + 2^(1-2(p+i))),
* where i = 0 or 1.
*/
mpfr_inits2 (2, t, t2, (mpfr_ptr) 0);
for (precy = 16; precy <= 128; precy += 16)
{
mpfr_set_ui_2exp (t, 1, - precy, MPFR_RNDN); /* 2^(-p) */
mpfr_set_ui_2exp (t2, 1, 1 - 2 * precy, MPFR_RNDN); /* 2^(-2p+1) */
precx = sizeof(mpfr_exp_t) * CHAR_BIT + 2 * precy + 8;
mpfr_init2 (x, precx);
mpfr_init2 (y, precy);
for (i = 0; i <= 1; i++)
{
for (j = 0; j <= 1; j++)
{
if (j == 0)
{
/* Case eps > -2^(-(p+i)). */
mpfr_log (x, minpos, MPFR_RNDU);
}
else /* j == 1 */
{
/* Case eps < - (2^(-(p+i)) + 2^(1-2(p+i))). */
mpfr_log (x, minpos, MPFR_RNDD);
inex = mpfr_sub (x, x, t2, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
}
inex = mpfr_sub (x, x, t, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
RND_LOOP (rnd)
for (e3 = 0; e3 <= 1; e3++)
{
int err = 0;
unsigned int flags;
flags = MPFR_FLAGS_INEXACT |
(((rnd == MPFR_RNDU || rnd == MPFR_RNDA)
&& (i == 1 || j == 0)) ||
(rnd == MPFR_RNDN && (i == 1 && j == 0)) ?
0 : MPFR_FLAGS_UNDERFLOW);
mpfr_clear_flags ();
inex = e3 ? exp_3 (y, x, (mpfr_rnd_t) rnd)
: mpfr_exp (y, x, (mpfr_rnd_t) rnd);
if (__gmpfr_flags != flags)
{
printf ("Incorrect flags in underflow_up, %s",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
if (extended_emin)
printf (" and extended emin");
printf ("\nfor precx = %d, precy = %d, ",
precx, precy);
if (j == 0)
printf ("eps >~ -2^(-%d)", precy + i);
else
printf ("eps <~ - (2^(-%d) + 2^(%d))",
precy + i, 1 - 2 * (precy + i));
printf (", %s\n", e3 ? "mpfr_exp_3" : "mpfr_exp");
printf ("Got %u instead of %u.\n",
__gmpfr_flags, flags);
err = 1;
}
if (rnd == MPFR_RNDU || rnd == MPFR_RNDA || rnd == MPFR_RNDN ?
mpfr_cmp0 (y, minpos) != 0 : MPFR_NOTZERO (y))
{
printf ("Incorrect result in underflow_up, %s",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd));
if (extended_emin)
printf (" and extended emin");
printf ("\nfor precx = %d, precy = %d, ",
precx, precy);
if (j == 0)
printf ("eps >~ -2^(-%d)", precy + i);
else
printf ("eps <~ - (2^(-%d) + 2^(%d))",
precy + i, 1 - 2 * (precy + i));
printf (", %s\n", e3 ? "mpfr_exp_3" : "mpfr_exp");
mpfr_dump (y);
err = 1;
}
if (err)
exit (1);
} /* for (e3 ...) */
} /* for (j ...) */
mpfr_div_2si (t, t, 1, MPFR_RNDN);
mpfr_div_2si (t2, t2, 2, MPFR_RNDN);
} /* for (i ...) */
mpfr_clears (x, y, (mpfr_ptr) 0);
} /* for (precy ...) */
mpfr_clears (t, t2, (mpfr_ptr) 0);
/* Case exp(eps) ~= 1/2, i.e. eps ~= - log(2).
* We choose x0 and x1 with high enough precision such that:
* x0 = rndd(rndd(log(minpos)) - rndu(log(2)))
* x1 = rndu(rndu(log(minpos)) - rndd(log(2)))
* In revision 5507 (trunk) on a 64-bit Linux machine, this fails:
* Error in underflow_up, eps >~ - log(2) and extended emin
* for precy = 16, mpfr_exp
* Expected 1.0@-1152921504606846976 (minimum positive MPFR number),
* inex > 0 and flags = 9
* Got 0
* with inex = -1 and flags = 9
* due to a double-rounding problem in mpfr_mul_2si when rescaling
* the result.
*/
mpfr_inits2 (sizeof(mpfr_exp_t) * CHAR_BIT + 64, x, t, (mpfr_ptr) 0);
for (i = 0; i <= 1; i++)
{
mpfr_log (x, minpos, i ? MPFR_RNDU : MPFR_RNDD);
mpfr_const_log2 (t, i ? MPFR_RNDD : MPFR_RNDU);
mpfr_sub (x, x, t, i ? MPFR_RNDU : MPFR_RNDD);
for (precy = 16; precy <= 128; precy += 16)
{
mpfr_init2 (y, precy);
for (e3 = 0; e3 <= 1; e3++)
{
unsigned int flags, uflags =
MPFR_FLAGS_INEXACT | MPFR_FLAGS_UNDERFLOW;
mpfr_clear_flags ();
inex = e3 ? exp_3 (y, x, MPFR_RNDN) : mpfr_exp (y, x, MPFR_RNDN);
flags = __gmpfr_flags;
if (flags != uflags ||
(i ? (inex <= 0 || mpfr_cmp0 (y, minpos) != 0)
: (inex >= 0 || MPFR_NOTZERO (y))))
{
printf ("Error in underflow_up, eps %c~ - log(2)",
i ? '>' : '<');
if (extended_emin)
printf (" and extended emin");
printf ("\nfor precy = %d, %s\nExpected ", precy,
e3 ? "mpfr_exp_3" : "mpfr_exp");
if (i)
{
mpfr_out_str (stdout, 16, 0, minpos, MPFR_RNDN);
printf (" (minimum positive MPFR number),\ninex >");
}
else
{
printf ("+0, inex <");
}
printf (" 0 and flags = %u\nGot ", uflags);
mpfr_out_str (stdout, 16, 0, y, MPFR_RNDN);
printf ("\nwith inex = %d and flags = %u\n", inex, flags);
exit (1);
}
}
mpfr_clear (y);
}
}
mpfr_clears (x, t, (mpfr_ptr) 0);
mpfr_clear (minpos);
}
/* 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;
}
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);
}
int
mpfr_acosh (mpfr_ptr y, mpfr_srcptr x , mpfr_rnd_t rnd_mode)
{
MPFR_SAVE_EXPO_DECL (expo);
int inexact;
int comp;
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));
/* Deal with special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
/* Nan, or zero or -Inf */
if (MPFR_IS_INF (x) && MPFR_IS_POS (x))
{
MPFR_SET_INF (y);
MPFR_SET_POS (y);
MPFR_RET (0);
}
else /* Nan, or zero or -Inf */
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
}
comp = mpfr_cmp_ui (x, 1);
if (MPFR_UNLIKELY (comp < 0))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_UNLIKELY (comp == 0))
{
MPFR_SET_ZERO (y); /* acosh(1) = 0 */
MPFR_SET_POS (y);
MPFR_RET (0);
}
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variables */
mpfr_t t;
/* Declaration of the size variables */
mpfr_prec_t Ny = MPFR_PREC(y); /* Precision of output variable */
mpfr_prec_t Nt; /* Precision of the intermediary variable */
mpfr_exp_t err, exp_te, d; /* Precision of error */
MPFR_ZIV_DECL (loop);
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 4 + MPFR_INT_CEIL_LOG2 (Ny);
/* initialization of intermediary variables */
mpfr_init2 (t, Nt);
/* First computation of acosh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute acosh */
MPFR_BLOCK (flags, mpfr_mul (t, x, x, MPFR_RNDD)); /* x^2 */
if (MPFR_OVERFLOW (flags))
{
mpfr_t ln2;
mpfr_prec_t pln2;
/* As x is very large and the precision is not too large, we
assume that we obtain the same result by evaluating ln(2x).
We need to compute ln(x) + ln(2) as 2x can overflow. TODO:
write a proof and add an MPFR_ASSERTN. */
mpfr_log (t, x, MPFR_RNDN); /* err(log) < 1/2 ulp(t) */
pln2 = Nt - MPFR_PREC_MIN < MPFR_GET_EXP (t) ?
MPFR_PREC_MIN : Nt - MPFR_GET_EXP (t);
mpfr_init2 (ln2, pln2);
mpfr_const_log2 (ln2, MPFR_RNDN); /* err(ln2) < 1/2 ulp(t) */
mpfr_add (t, t, ln2, MPFR_RNDN); /* err <= 3/2 ulp(t) */
mpfr_clear (ln2);
err = 1;
}
else
{
exp_te = MPFR_GET_EXP (t);
mpfr_sub_ui (t, t, 1, MPFR_RNDD); /* x^2-1 */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (t)))
{
/* This means that x is very close to 1: x = 1 + t with
t < 2^(-Nt). We have: acosh(x) = sqrt(2t) (1 - eps(t))
with 0 < eps(t) < t / 12. */
mpfr_sub_ui (t, x, 1, MPFR_RNDD); /* t = x - 1 */
mpfr_mul_2ui (t, t, 1, MPFR_RNDN); /* 2t */
mpfr_sqrt (t, t, MPFR_RNDN); /* sqrt(2t) */
err = 1;
}
else
{
d = exp_te - MPFR_GET_EXP (t);
mpfr_sqrt (t, t, MPFR_RNDN); /* sqrt(x^2-1) */
mpfr_add (t, t, x, MPFR_RNDN); /* sqrt(x^2-1)+x */
mpfr_log (t, t, MPFR_RNDN); /* ln(sqrt(x^2-1)+x) */
/* error estimate -- see algorithms.tex */
err = 3 + MAX (1, d) - MPFR_GET_EXP (t);
/* error is bounded by 1/2 + 2^err <= 2^(max(0,1+err)) */
err = MAX (0, 1 + err);
}
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - err, Ny, rnd_mode)))
break;
/* reactualisation 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_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, r;
long q[1];
if (argc == 3) /* usage: tremquo x y (rnd=MPFR_RNDN implicit) */
{
mpfr_init2 (x, GMP_NUMB_BITS);
mpfr_init2 (y, GMP_NUMB_BITS);
mpfr_init2 (r, GMP_NUMB_BITS);
mpfr_set_str (x, argv[1], 10, MPFR_RNDN);
mpfr_set_str (y, argv[2], 10, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
printf ("r=");
mpfr_out_str (stdout, 10, 0, r, MPFR_RNDN);
printf (" q=%ld\n", q[0]);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
return 0;
}
tests_start_mpfr ();
bug20090227 ();
mpfr_init (x);
mpfr_init (y);
mpfr_init (r);
/* special values */
mpfr_set_nan (x);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (r));
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_nan (y);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_inf (x, 1); /* +Inf */
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_POS (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN); /* -0 */
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_NEG (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_inf (y, 1);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp (r, x) == 0);
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_nan_p (r));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_POS (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 0) == 0 && MPFR_IS_NEG (r));
MPFR_ASSERTN (q[0] == (long) 0);
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
/* check four possible sign combinations */
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 8) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_si (x, -42, MPFR_RNDN);
mpfr_set_ui (y, 17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -8) == 0);
MPFR_ASSERTN (q[0] == (long) -2);
mpfr_set_si (x, -42, MPFR_RNDN);
mpfr_set_si (y, -17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -8) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_si (y, -17, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui (r, 8) == 0);
MPFR_ASSERTN (q[0] == (long) -2);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 50);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_nextabove (x); /* 42 + 2^(-94) */
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -94) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 100);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_nextabove (x); /* 42 + 2^(-44) */
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -44) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 50);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_nextabove (y); /* 21 + 2^(-45) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* r should be 42 - 2*(21 + 2^(-45)) = -2^(-44) */
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -44) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 100);
mpfr_set_ui (x, 42, MPFR_RNDN);
mpfr_set_ui (y, 21, MPFR_RNDN);
mpfr_nextabove (y); /* 21 + 2^(-95) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* r should be 42 - 2*(21 + 2^(-95)) = -2^(-94) */
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -94) == 0);
MPFR_ASSERTN (q[0] == (long) 2);
/* exercise large quotient */
mpfr_set_ui_2exp (x, 1, 65, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
/* quotient is 2^65 */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, 0) == 0);
MPFR_ASSERTN (q[0] % 1073741824L == 0L);
/* another large quotient */
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_const_pi (x, MPFR_RNDN);
mpfr_mul_2exp (x, x, 63, MPFR_RNDN);
mpfr_const_log2 (y, MPFR_RNDN);
mpfr_set_prec (r, 10);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* q should be 41803643793084085130, r should be 605/2048 */
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 605, -11) == 0);
MPFR_ASSERTN ((q[0] > 0) && ((q[0] % 1073741824L) == 733836170L));
/* check cases where quotient is 1.5 +/- eps */
mpfr_set_prec (x, 65);
mpfr_set_prec (y, 65);
mpfr_set_prec (r, 63);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5, quotient should be 2 (even rule), remainder should be -1 */
MPFR_ASSERTN (mpfr_cmp_si (r, -1) == 0);
MPFR_ASSERTN (q[0] == 2L);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_nextabove (x); /* 3 + 2^(-63) */
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5 + 2^(-64), quo should be 2, r should be -1 + 2^(-63) */
MPFR_ASSERTN (mpfr_add_ui (r, r, 1, MPFR_RNDN) == 0);
MPFR_ASSERTN (mpfr_cmp_ui_2exp (r, 1, -63) == 0);
MPFR_ASSERTN (q[0] == 2L);
mpfr_set_ui (x, 3, MPFR_RNDN);
mpfr_set_ui (y, 2, MPFR_RNDN);
mpfr_nextabove (y); /* 2 + 2^(-63) */
mpfr_remquo (r, q, x, y, MPFR_RNDN);
/* x/y = 1.5 - eps, quo should be 1, r should be 1 - 2^(-63) */
MPFR_ASSERTN (mpfr_sub_ui (r, r, 1, MPFR_RNDN) == 0);
MPFR_ASSERTN (mpfr_cmp_si_2exp (r, -1, -63) == 0);
MPFR_ASSERTN (q[0] == 1L);
/* bug founds by Kaveh Ghazi, 3 May 2007 */
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_set_ui (y, 3, MPFR_RNDN);
mpfr_remainder (r, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, -1) == 0);
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remainder (r, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (r, 0) == 0 && MPFR_SIGN (r) < 0);
/* check argument reuse */
mpfr_set_si (x, -1, MPFR_RNDN);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_remainder (x, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (x, 0) == 0 && MPFR_SIGN (x) < 0);
mpfr_set_ui_2exp (x, 1, mpfr_get_emax () - 1, MPFR_RNDN);
mpfr_set_ui_2exp (y, 1, mpfr_get_emin (), MPFR_RNDN);
mpfr_remquo (r, q, x, y, MPFR_RNDN);
MPFR_ASSERTN (mpfr_zero_p (r) && MPFR_SIGN (r) > 0);
MPFR_ASSERTN (q[0] == 0);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (r);
tests_end_mpfr ();
return 0;
}
int
mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
int inex;
unsigned long absn;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex));
absn = SAFE_ABS (unsigned long, n);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z)))
{
if (MPFR_IS_NAN (z))
{
MPFR_SET_NAN (res); /* y(n,NaN) = NaN */
MPFR_RET_NAN;
}
/* y(n,z) tends to zero when z goes to +Inf, oscillating around
0. We choose to return +0 in that case. */
else if (MPFR_IS_INF (z))
{
if (MPFR_SIGN(z) > 0)
return mpfr_set_ui (res, 0, r);
else /* y(n,-Inf) = NaN */
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
}
else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise,
when z goes to zero */
{
MPFR_SET_INF(res);
if (n >= 0 || ((unsigned long) n & 1) == 0)
MPFR_SET_NEG(res);
else
MPFR_SET_POS(res);
mpfr_set_divby0 ();
MPFR_RET(0);
}
}
/* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we
assume does not happen for a rational z. */
if (MPFR_SIGN(z) < 0)
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
/* now z is not singular, and z > 0 */
MPFR_SAVE_EXPO_MARK (expo);
/* Deal with tiny arguments. We have:
y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more
precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z),
g(z) - 0.41*z^2 < y0(z)/log(z) < g(z)
thus since log(z) is negative:
g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z)
and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on
y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2.
Note: we use both the main term in log(z) and the constant term, because
otherwise the relative error would be only in 1/log(|log(z)|).
*/
if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2))
{
mpfr_t l, h, t, logz;
mpfr_prec_t prec;
int ok, inex2;
prec = MPFR_PREC(res) + 10;
mpfr_init2 (l, prec);
mpfr_init2 (h, prec);
mpfr_init2 (t, prec);
mpfr_init2 (logz, prec);
/* first enclose log(z) + euler - log(2) = log(z/2) + euler */
mpfr_log (logz, z, MPFR_RNDD); /* lower bound of log(z) */
mpfr_set (h, logz, MPFR_RNDU); /* exact */
mpfr_nextabove (h); /* upper bound of log(z) */
mpfr_const_euler (t, MPFR_RNDD); /* lower bound of euler */
mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */
mpfr_nextabove (t); /* upper bound of euler */
mpfr_add (h, h, t, MPFR_RNDU); /* upper bound of log(z) + euler */
mpfr_const_log2 (t, MPFR_RNDU); /* upper bound of log(2) */
mpfr_sub (l, l, t, MPFR_RNDD); /* lower bound of log(z/2) + euler */
mpfr_nextbelow (t); /* lower bound of log(2) */
mpfr_sub (h, h, t, MPFR_RNDU); /* upper bound of log(z/2) + euler */
mpfr_const_pi (t, MPFR_RNDU); /* upper bound of Pi */
mpfr_div (l, l, t, MPFR_RNDD); /* lower bound of (log(z/2)+euler)/Pi */
mpfr_nextbelow (t); /* lower bound of Pi */
mpfr_div (h, h, t, MPFR_RNDD); /* upper bound of (log(z/2)+euler)/Pi */
mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */
mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */
/* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z)
to h */
mpfr_mul (t, z, z, MPFR_RNDU); /* upper bound on z^2 */
/* since logz is negative, a lower bound corresponds to an upper bound
for its absolute value */
mpfr_neg (t, t, MPFR_RNDD);
mpfr_div_2ui (t, t, 1, MPFR_RNDD);
mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */
mpfr_add (h, h, t, MPFR_RNDU);
inex = mpfr_prec_round (l, MPFR_PREC(res), r);
inex2 = mpfr_prec_round (h, MPFR_PREC(res), r);
/* we need h=l and inex=inex2 */
ok = (inex == inex2) && mpfr_equal_p (l, h);
if (ok)
mpfr_set (res, h, r); /* exact */
mpfr_clear (l);
mpfr_clear (h);
mpfr_clear (t);
mpfr_clear (logz);
if (ok)
goto end;
}
/* small argument check for y1(z) = -2/Pi/z + O(log(z)):
for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */
if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res))
{
mpfr_t y;
mpfr_prec_t prec;
mpfr_exp_t err1;
int ok;
MPFR_BLOCK_DECL (flags);
/* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1),
then |y1(z)| > 2^emax */
prec = MPFR_PREC(res) + 10;
mpfr_init2 (y, prec);
mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u
represents a quantity <= 1/2^prec */
mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */
MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ));
/* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */
if (MPFR_OVERFLOW (flags))
{
mpfr_clear (y);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (res, r, -1);
}
mpfr_neg (y, y, MPFR_RNDN);
/* (1+u)^6 can be written 1+7u [for another value of u], thus the
error on 2/Pi/z is less than 7ulp(y). The truncation error is less
than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y),
otherwise it is less than 1/4+7/8 <= 2. */
if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */
err1 = 3;
else /* ulp(y) <= 1/8 */
err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1;
ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r);
if (ok)
inex = mpfr_set (res, y, r);
mpfr_clear (y);
if (ok)
goto end;
}
/* we can use the asymptotic expansion as soon as z > p log(2)/2,
but to get some margin we use it for z > p/2 */
if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0)
{
inex = mpfr_yn_asympt (res, n, z, r);
if (inex != 0)
goto end;
}
/* General case */
{
mpfr_prec_t prec;
mpfr_exp_t err1, err2, err3;
mpfr_t y, s1, s2, s3;
MPFR_ZIV_DECL (loop);
mpfr_init (y);
mpfr_init (s1);
mpfr_init (s2);
mpfr_init (s3);
prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13;
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
mpfr_set_prec (y, prec);
mpfr_set_prec (s1, prec);
mpfr_set_prec (s2, prec);
mpfr_set_prec (s3, prec);
mpfr_mul (y, z, z, MPFR_RNDN);
mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */
/* store (z/2)^n temporarily in s2 */
mpfr_pow_ui (s2, z, absn, MPFR_RNDN);
mpfr_div_2si (s2, s2, absn, MPFR_RNDN);
/* compute S1 * (z/2)^(-n) */
if (n == 0)
{
mpfr_set_ui (s1, 0, MPFR_RNDN);
err1 = 0;
}
else
err1 = mpfr_yn_s1 (s1, y, absn - 1);
mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */
/* See algorithms.tex: the relative error on s1 is bounded by
(3n+3)*2^(e+1-prec). */
err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1;
/* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */
/* compute (z/2)^n * S3 */
mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */
err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */
/* the error on s3 is bounded by 2^err3 ulps */
/* add s1+s3 */
err1 += MPFR_EXP(s1);
mpfr_add (s1, s1, s3, MPFR_RNDN);
/* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1))
+ 2^err3*2^(EXP(s3) - EXP(s1)) */
err3 += MPFR_EXP(s3);
err1 = (err3 > err1) ? err3 + 1 : err1 + 1;
err1 -= MPFR_EXP(s1);
err1 = (err1 >= 0) ? err1 + 1 : 1;
/* now the error on s1 is bounded by 2^err1*ulp(s1) */
/* compute S2 */
mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */
mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */
mpfr_const_euler (s3, MPFR_RNDN);
err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3);
mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */
err2 -= MPFR_EXP(s2);
mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */
mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */
mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */
err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see
algorithms.tex */
/* add all three sums */
err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */
err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */
mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */
err2 = (err1 > err2) ? err1 + 1 : err2 + 1;
err2 -= MPFR_EXP(s2);
err2 = (err2 >= 0) ? err2 + 1 : 1;
/* now the error on s2 is bounded by 2^err2*ulp(s2) */
mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */
mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by
2^(err2+1)*ulp(s2) */
err2 ++;
if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r)))
break;
MPFR_ZIV_NEXT (loop, prec);
}
MPFR_ZIV_FREE (loop);
/* Assume two's complement for the test n & 1 */
inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ?
MPFR_SIGN (s2) : - MPFR_SIGN (s2));
mpfr_clear (y);
mpfr_clear (s1);
mpfr_clear (s2);
mpfr_clear (s3);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (res, inex, r);
}
int
mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd)
{
int inex;
mpfr_t tmp, ump;
mp_exp_t err, te;
mp_prec_t prec;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd),
("y[%#R]=%R inexact=%d", y, y, inex));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
/* exp(NaN) = exp(-Inf) = NaN */
if (MPFR_IS_NAN (x) || (MPFR_IS_INF (x) && MPFR_IS_NEG(x)))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
/* eint(+inf) = +inf */
else if (MPFR_IS_INF (x))
{
MPFR_SET_INF(y);
MPFR_SET_POS(y);
MPFR_RET(0);
}
else /* eint(+/-0) = -Inf */
{
MPFR_SET_INF(y);
MPFR_SET_NEG(y);
MPFR_RET(0);
}
}
/* eint(x) = NaN for x < 0 */
if (MPFR_IS_NEG(x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
MPFR_SAVE_EXPO_MARK (expo);
/* Since eint(x) >= exp(x)/x, we have log2(eint(x)) >= (x-log(x))/log(2).
Let's compute k <= (x-log(x))/log(2) in a low precision. If k >= emax,
then log2(eint(x)) >= emax, and eint(x) >= 2^emax, i.e. it overflows. */
mpfr_init2 (tmp, 64);
mpfr_init2 (ump, 64);
mpfr_log (tmp, x, GMP_RNDU);
mpfr_sub (ump, x, tmp, GMP_RNDD);
mpfr_const_log2 (tmp, GMP_RNDU);
mpfr_div (ump, ump, tmp, GMP_RNDD);
/* FIXME: We really need mpfr_set_exp_t and mpfr_cmp_exp_t functions. */
MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
if (mpfr_cmp_ui (ump, __gmpfr_emax) >= 0)
{
mpfr_clear (tmp);
mpfr_clear (ump);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd, 1);
}
/* Init stuff */
prec = MPFR_PREC (y) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (y)) + 6;
/* eint() has a root 0.37250741078136663446..., so if x is near,
already take more bits */
if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */
{
double d;
d = mpfr_get_d (x, GMP_RNDN) - 0.37250741078136663;
d = (d == 0.0) ? -53 : __gmpfr_ceil_log2 (d);
prec += -d;
}
mpfr_set_prec (tmp, prec);
mpfr_set_prec (ump, prec);
MPFR_ZIV_INIT (loop, prec); /* Initialize the ZivLoop controler */
for (;;) /* Infinite loop */
{
/* We need that the smallest value of k!/x^k is smaller than 2^(-p).
The minimum is obtained for x=k, and it is smaller than e*sqrt(x)/e^x
for x>=1. */
if (MPFR_GET_EXP (x) > 0 && mpfr_cmp_d (x, ((double) prec +
0.5 * (double) MPFR_GET_EXP (x)) * LOG2 + 1.0) > 0)
err = mpfr_eint_asympt (tmp, x);
else
{
err = mpfr_eint_aux (tmp, x); /* error <= 2^err ulp(tmp) */
te = MPFR_GET_EXP(tmp);
mpfr_const_euler (ump, GMP_RNDN); /* 0.577 -> EXP(ump)=0 */
mpfr_add (tmp, tmp, ump, GMP_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(ump)-EXP(tmp)) + 2^(te-EXP(tmp)+err)
<= 1/2 + 2^(MAX(EXP(ump), te+err+1) - EXP(tmp))
<= 2^(MAX(0, 1 + MAX(EXP(ump), te+err+1) - EXP(tmp))) */
err = MAX(1, te + err + 2) - MPFR_GET_EXP(tmp);
err = MAX(0, err);
te = MPFR_GET_EXP(tmp);
mpfr_log (ump, x, GMP_RNDN);
mpfr_add (tmp, tmp, ump, GMP_RNDN);
/* same formula as above, except now EXP(ump) is not 0 */
err += te + 1;
if (MPFR_LIKELY (!MPFR_IS_ZERO (ump)))
err = MAX (MPFR_GET_EXP (ump), err);
err = MAX(0, err - MPFR_GET_EXP (tmp));
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - err, MPFR_PREC (y), rnd)))
break;
MPFR_ZIV_NEXT (loop, prec); /* Increase used precision */
mpfr_set_prec (tmp, prec);
mpfr_set_prec (ump, prec);
}
MPFR_ZIV_FREE (loop); /* Free the ZivLoop Controler */
inex = mpfr_set (y, tmp, rnd); /* Set y to the computed value */
mpfr_clear (tmp);
mpfr_clear (ump);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd);
}
int
mpfr_exp (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_exp_t expx;
mpfr_prec_t precy;
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(x) ))
{
if (MPFR_IS_NAN(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF(x))
{
if (MPFR_IS_POS(x))
MPFR_SET_INF(y);
else
MPFR_SET_ZERO(y);
MPFR_SET_POS(y);
MPFR_RET(0);
}
else
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
/* First, let's detect most overflow and underflow cases. */
{
mpfr_t e, bound;
/* We must extended the exponent range and save the flags now. */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (e, sizeof (mpfr_exp_t) * CHAR_BIT);
mpfr_init2 (bound, 32);
inexact = mpfr_set_exp_t (e, expo.saved_emax, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
mpfr_const_log2 (bound, expo.saved_emax < 0 ? MPFR_RNDD : MPFR_RNDU);
mpfr_mul (bound, bound, e, MPFR_RNDU);
if (MPFR_UNLIKELY (mpfr_cmp (x, bound) >= 0))
{
/* x > log(2^emax), thus exp(x) > 2^emax */
mpfr_clears (e, bound, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd_mode, 1);
}
inexact = mpfr_set_exp_t (e, expo.saved_emin, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
inexact = mpfr_sub_ui (e, e, 2, MPFR_RNDN);
MPFR_ASSERTD (inexact == 0);
mpfr_const_log2 (bound, expo.saved_emin < 0 ? MPFR_RNDU : MPFR_RNDD);
mpfr_mul (bound, bound, e, MPFR_RNDD);
if (MPFR_UNLIKELY (mpfr_cmp (x, bound) <= 0))
{
/* x < log(2^(emin - 2)), thus exp(x) < 2^(emin - 2) */
mpfr_clears (e, bound, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (y, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
1);
}
/* Other overflow/underflow cases must be detected
by the generic routines. */
mpfr_clears (e, bound, (mpfr_ptr) 0);
MPFR_SAVE_EXPO_FREE (expo);
}
expx = MPFR_GET_EXP (x);
precy = MPFR_PREC (y);
/* if x < 2^(-precy), then exp(x) i.e. gives 1 +/- 1 ulp(1) */
if (MPFR_UNLIKELY (expx < 0 && (mpfr_uexp_t) (-expx) > precy))
{
mpfr_exp_t emin = __gmpfr_emin;
mpfr_exp_t emax = __gmpfr_emax;
int signx = MPFR_SIGN (x);
MPFR_SET_POS (y);
if (MPFR_IS_NEG_SIGN (signx) && (rnd_mode == MPFR_RNDD ||
rnd_mode == MPFR_RNDZ))
{
__gmpfr_emin = 0;
__gmpfr_emax = 0;
mpfr_setmax (y, 0); /* y = 1 - epsilon */
inexact = -1;
}
else
{
__gmpfr_emin = 1;
__gmpfr_emax = 1;
mpfr_setmin (y, 1); /* y = 1 */
if (MPFR_IS_POS_SIGN (signx) && (rnd_mode == MPFR_RNDU ||
rnd_mode == MPFR_RNDA))
{
mp_size_t yn;
int sh;
yn = 1 + (MPFR_PREC(y) - 1) / GMP_NUMB_BITS;
sh = (mpfr_prec_t) yn * GMP_NUMB_BITS - MPFR_PREC(y);
MPFR_MANT(y)[0] += MPFR_LIMB_ONE << sh;
inexact = 1;
}
else
inexact = -MPFR_FROM_SIGN_TO_INT(signx);
}
__gmpfr_emin = emin;
__gmpfr_emax = emax;
}
else /* General case */
{
if (MPFR_UNLIKELY (precy >= MPFR_EXP_THRESHOLD))
/* mpfr_exp_3 saves the exponent range and flags itself, otherwise
the flag changes in mpfr_exp_3 are lost */
inexact = mpfr_exp_3 (y, x, rnd_mode); /* O(M(n) log(n)^2) */
else
{
MPFR_SAVE_EXPO_MARK (expo);
inexact = mpfr_exp_2 (y, x, rnd_mode); /* O(n^(1/3) M(n)) */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
}
}
return mpfr_check_range (y, inexact, rnd_mode);
}
/* 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;
}
