int fractal_mpfr_calculate_line(image_info* img, int line)
{
int ret = 1;
int ix = 0;
int mx = 0;
int chk_px = ((rthdata*)img->rth_ptr)->check_stop_px;
int img_width = img->real_width;
int* raw_data = &img->raw_data[line * img_width];
depth_t depth = img->depth;
mpfr_t x, y;
mpfr_t x2, y2;
mpfr_t c_re, c_im;
/* working variables: */
mpfr_t wre, wim;
mpfr_t wre2, wim2;
mpfr_t frs_bail;
mpfr_t width, img_rw, img_xmin;
mpfr_t t1;
mpfr_init2(x, img->precision);
mpfr_init2(y, img->precision);
mpfr_init2(x2, img->precision);
mpfr_init2(y2, img->precision);
mpfr_init2(c_re, img->precision);
mpfr_init2(c_im, img->precision);
mpfr_init2(wre, img->precision);
mpfr_init2(wim, img->precision);
mpfr_init2(wre2, img->precision);
mpfr_init2(wim2, img->precision);
mpfr_init2(frs_bail,img->precision);
mpfr_init2(width, img->precision);
mpfr_init2(img_rw, img->precision);
mpfr_init2(img_xmin,img->precision);
mpfr_init2(t1, img->precision);
mpfr_set_si(frs_bail, 4, GMP_RNDN);
mpfr_set_si(img_rw, img_width, GMP_RNDN);
mpfr_set( img_xmin, img->xmin, GMP_RNDN);
mpfr_set( width, img->width, GMP_RNDN);
/* y = img->ymax - ((img->xmax - img->xmin)
/ (long double)img->real_width)
* (long double)img->lines_done; */
mpfr_div( t1, width, img_rw, GMP_RNDN);
mpfr_mul_si( t1, t1, line, GMP_RNDN);
mpfr_sub( y, img->ymax, t1, GMP_RNDN);
mpfr_mul( y2, y, y, GMP_RNDN);
while (ix < img_width)
{
mx += chk_px;
if (mx > img_width)
mx = img_width;
for (; ix < mx; ++ix, ++raw_data)
{
/* x = ((long double)ix / (long double)img->real_width)
* (img->xmax - img->xmin) + img->xmin; */
mpfr_si_div(t1, ix, img_rw, GMP_RNDN);
mpfr_mul(x, t1, width, GMP_RNDN);
mpfr_add(x, x, img_xmin, GMP_RNDN);
mpfr_mul( x2, x, x, GMP_RNDN);
mpfr_set( wre, x, GMP_RNDN);
mpfr_set( wim, y, GMP_RNDN);
mpfr_set( wre2, x2, GMP_RNDN);
mpfr_set( wim2, y2, GMP_RNDN);
switch (img->family)
{
case FAMILY_MANDEL:
mpfr_set(c_re, x, GMP_RNDN);
mpfr_set(c_im, y, GMP_RNDN);
break;
case FAMILY_JULIA:
mpfr_set(c_re, img->u.julia.c_re, GMP_RNDN);
mpfr_set(c_im, img->u.julia.c_im, GMP_RNDN);
break;
}
switch(img->fractal)
{
case BURNING_SHIP:
*raw_data = frac_burning_ship_mpfr(
depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
break;
case GENERALIZED_CELTIC:
*raw_data = frac_generalized_celtic_mpfr(
depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
break;
case VARIANT:
*raw_data = frac_variant_mpfr(
depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
break;
case MANDELBROT:
default:
*raw_data = frac_mandel_mpfr(depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
}
}
if (rth_render_should_stop((rthdata*)img->rth_ptr))
{
ret = 0;
break;
}
}
mpfr_clear(x);
mpfr_clear(y);
mpfr_clear(x2);
mpfr_clear(y2);
mpfr_clear(c_re);
mpfr_clear(c_im);
mpfr_clear(wre);
mpfr_clear(wim);
mpfr_clear(wre2);
mpfr_clear(wim2);
mpfr_clear(frs_bail);
mpfr_clear(width);
mpfr_clear(img_rw);
mpfr_clear(t1);
return ret;
}
void generate_2D_sample (FILE *output, struct speed_params2D param)
{
mpfr_t temp;
double incr_prec;
mpfr_t incr_x;
mpfr_t x, x2;
double prec;
struct speed_params s;
int i;
int test;
int nb_functions;
double *t; /* store the timing of each implementation */
/* We first determine how many implementations we have */
nb_functions = 0;
while (param.speed_funcs[nb_functions] != NULL)
nb_functions++;
t = malloc (nb_functions * sizeof (double));
if (t == NULL)
{
fprintf (stderr, "Can't allocate memory.\n");
abort ();
}
mpfr_init2 (temp, MPFR_SMALL_PRECISION);
/* The precision is sampled from min_prec to max_prec with */
/* approximately nb_points_prec points. If logarithmic_scale_prec */
/* is true, the precision is multiplied by incr_prec at each */
/* step. Otherwise, incr_prec is added at each step. */
if (param.logarithmic_scale_prec)
{
mpfr_set_ui (temp, (unsigned long int)param.max_prec, MPFR_RNDU);
mpfr_div_ui (temp, temp, (unsigned long int)param.min_prec, MPFR_RNDU);
mpfr_root (temp, temp,
(unsigned long int)param.nb_points_prec, MPFR_RNDU);
incr_prec = mpfr_get_d (temp, MPFR_RNDU);
}
else
{
incr_prec = (double)param.max_prec - (double)param.min_prec;
incr_prec = incr_prec/((double)param.nb_points_prec);
}
/* The points x are sampled according to the following rule: */
/* If logarithmic_scale_x = 0: */
/* nb_points_x points are equally distributed between min_x and max_x */
/* If logarithmic_scale_x = 1: */
/* nb_points_x points are sampled from 2^(min_x) to 2^(max_x). At */
/* each step, the current point is multiplied by incr_x. */
/* If logarithmic_scale_x = -1: */
/* nb_points_x/2 points are sampled from -2^(max_x) to -2^(min_x) */
/* (at each step, the current point is divided by incr_x); and */
/* nb_points_x/2 points are sampled from 2^(min_x) to 2^(max_x) */
/* (at each step, the current point is multiplied by incr_x). */
mpfr_init2 (incr_x, param.max_prec);
if (param.logarithmic_scale_x == 0)
{
mpfr_set_d (incr_x,
(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
}
else if (param.logarithmic_scale_x == -1)
{
mpfr_set_d (incr_x,
2.*(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
mpfr_exp2 (incr_x, incr_x, MPFR_RNDU);
}
else
{ /* other values of param.logarithmic_scale_x are considered as 1 */
mpfr_set_d (incr_x,
(param.max_x - param.min_x)/(double)param.nb_points_x,
MPFR_RNDU);
mpfr_exp2 (incr_x, incr_x, MPFR_RNDU);
}
/* Main loop */
mpfr_init2 (x, param.max_prec);
mpfr_init2 (x2, param.max_prec);
prec = (double)param.min_prec;
while (prec <= param.max_prec)
{
printf ("prec = %d\n", (int)prec);
if (param.logarithmic_scale_x == 0)
mpfr_set_d (temp, param.min_x, MPFR_RNDU);
else if (param.logarithmic_scale_x == -1)
{
mpfr_set_d (temp, param.max_x, MPFR_RNDD);
mpfr_exp2 (temp, temp, MPFR_RNDD);
mpfr_neg (temp, temp, MPFR_RNDU);
}
else
{
mpfr_set_d (temp, param.min_x, MPFR_RNDD);
mpfr_exp2 (temp, temp, MPFR_RNDD);
}
/* We perturb x a little bit, in order to avoid trailing zeros that */
/* might change the behavior of algorithms. */
mpfr_const_pi (x, MPFR_RNDN);
mpfr_div_2ui (x, x, 7, MPFR_RNDN);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
mpfr_mul (x, x, temp, MPFR_RNDN);
test = 1;
while (test)
{
mpfr_fprintf (output, "%e\t", mpfr_get_d (x, MPFR_RNDN));
mpfr_fprintf (output, "%Pu\t", (mpfr_prec_t)prec);
s.r = (mp_limb_t)mpfr_get_exp (x);
s.size = (mpfr_prec_t)prec;
s.align_xp = (mpfr_sgn (x) > 0)?1:2;
mpfr_set_prec (x2, (mpfr_prec_t)prec);
mpfr_set (x2, x, MPFR_RNDU);
s.xp = x2->_mpfr_d;
for (i=0; i<nb_functions; i++)
{
t[i] = speed_measure (param.speed_funcs[i], &s);
mpfr_fprintf (output, "%e\t", t[i]);
}
fprintf (output, "%d\n", 1 + find_best (t, nb_functions));
if (param.logarithmic_scale_x == 0)
{
mpfr_add (x, x, incr_x, MPFR_RNDU);
if (mpfr_cmp_d (x, param.max_x) > 0)
test=0;
}
else
{
if (mpfr_sgn (x) < 0 )
{ /* if x<0, it means that logarithmic_scale_x=-1 */
mpfr_div (x, x, incr_x, MPFR_RNDU);
mpfr_abs (temp, x, MPFR_RNDD);
mpfr_log2 (temp, temp, MPFR_RNDD);
if (mpfr_cmp_d (temp, param.min_x) < 0)
mpfr_neg (x, x, MPFR_RNDN);
}
else
{
mpfr_mul (x, x, incr_x, MPFR_RNDU);
mpfr_set (temp, x, MPFR_RNDD);
mpfr_log2 (temp, temp, MPFR_RNDD);
if (mpfr_cmp_d (temp, param.max_x) > 0)
test=0;
}
}
}
prec = ( (param.logarithmic_scale_prec) ? (prec * incr_prec)
: (prec + incr_prec) );
fprintf (output, "\n");
}
free (t);
mpfr_clear (incr_x);
mpfr_clear (x);
mpfr_clear (x2);
mpfr_clear (temp);
return;
}
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 if (e >= LONG_MIN)
printf ("%ld", (long) e);
else
printf ("<LONG_MIN");
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);
}
int
mpfr_atan2 (mpfr_ptr dest, mpfr_srcptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t tmp, pi;
int inexact;
mpfr_prec_t prec;
mpfr_exp_t e;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("y[%Pu]=%.*Rg x[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (y), mpfr_log_prec, y,
mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode),
("atan[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (dest), mpfr_log_prec, dest, inexact));
/* Special cases */
if (MPFR_ARE_SINGULAR (x, y))
{
/* atan2(0, 0) does not raise the "invalid" floating-point
exception, nor does atan2(y, 0) raise the "divide-by-zero"
floating-point exception.
-- atan2(±0, -0) returns ±pi.313)
-- atan2(±0, +0) returns ±0.
-- atan2(±0, x) returns ±pi, for x < 0.
-- atan2(±0, x) returns ±0, for x > 0.
-- atan2(y, ±0) returns -pi/2 for y < 0.
-- atan2(y, ±0) returns pi/2 for y > 0.
-- atan2(±oo, -oo) returns ±3pi/4.
-- atan2(±oo, +oo) returns ±pi/4.
-- atan2(±oo, x) returns ±pi/2, for finite x.
-- atan2(±y, -oo) returns ±pi, for finite y > 0.
-- atan2(±y, +oo) returns ±0, for finite y > 0.
*/
if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y))
{
MPFR_SET_NAN (dest);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO (y))
{
if (MPFR_IS_NEG (x)) /* +/- PI */
{
set_pi:
if (MPFR_IS_NEG (y))
{
inexact = mpfr_const_pi (dest, MPFR_INVERT_RND (rnd_mode));
MPFR_CHANGE_SIGN (dest);
return -inexact;
}
else
return mpfr_const_pi (dest, rnd_mode);
}
else /* +/- 0 */
{
set_zero:
MPFR_SET_ZERO (dest);
MPFR_SET_SAME_SIGN (dest, y);
return 0;
}
}
if (MPFR_IS_ZERO (x))
{
return pi_div_2ui (dest, 1, MPFR_IS_NEG (y), rnd_mode);
}
if (MPFR_IS_INF (y))
{
if (!MPFR_IS_INF (x)) /* +/- PI/2 */
return pi_div_2ui (dest, 1, MPFR_IS_NEG (y), rnd_mode);
else if (MPFR_IS_POS (x)) /* +/- PI/4 */
return pi_div_2ui (dest, 2, MPFR_IS_NEG (y), rnd_mode);
else /* +/- 3*PI/4: Ugly since we have to round properly */
{
mpfr_t tmp2;
MPFR_ZIV_DECL (loop2);
mpfr_prec_t prec2 = MPFR_PREC (dest) + 10;
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp2, prec2);
MPFR_ZIV_INIT (loop2, prec2);
for (;;)
{
mpfr_const_pi (tmp2, MPFR_RNDN);
mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDN); /* Error <= 2 */
mpfr_div_2ui (tmp2, tmp2, 2, MPFR_RNDN);
if (mpfr_round_p (MPFR_MANT (tmp2), MPFR_LIMB_SIZE (tmp2),
MPFR_PREC (tmp2) - 2,
MPFR_PREC (dest) + (rnd_mode == MPFR_RNDN)))
break;
MPFR_ZIV_NEXT (loop2, prec2);
mpfr_set_prec (tmp2, prec2);
}
MPFR_ZIV_FREE (loop2);
if (MPFR_IS_NEG (y))
MPFR_CHANGE_SIGN (tmp2);
inexact = mpfr_set (dest, tmp2, rnd_mode);
mpfr_clear (tmp2);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (dest, inexact, rnd_mode);
}
}
MPFR_ASSERTD (MPFR_IS_INF (x));
if (MPFR_IS_NEG (x))
goto set_pi;
else
goto set_zero;
}
/* When x is a power of two, we call directly atan(y/x) since y/x is
exact. */
if (MPFR_UNLIKELY (MPFR_IS_POWER_OF_2 (x)))
{
int r;
mpfr_t yoverx;
unsigned int saved_flags = __gmpfr_flags;
mpfr_init2 (yoverx, MPFR_PREC (y));
if (MPFR_LIKELY (mpfr_div_2si (yoverx, y, MPFR_GET_EXP (x) - 1,
MPFR_RNDN) == 0))
{
/* Here the flags have not changed due to mpfr_div_2si. */
r = mpfr_atan (dest, yoverx, rnd_mode);
mpfr_clear (yoverx);
return r;
}
else
{
/* Division is inexact because of a small exponent range */
mpfr_clear (yoverx);
__gmpfr_flags = saved_flags;
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Set up initial prec */
prec = MPFR_PREC (dest) + 3 + MPFR_INT_CEIL_LOG2 (MPFR_PREC (dest));
mpfr_init2 (tmp, prec);
MPFR_ZIV_INIT (loop, prec);
if (MPFR_IS_POS (x))
/* use atan2(y,x) = atan(y/x) */
for (;;)
{
int div_inex;
MPFR_BLOCK_DECL (flags);
MPFR_BLOCK (flags, div_inex = mpfr_div (tmp, y, x, MPFR_RNDN));
if (div_inex == 0)
{
/* Result is exact. */
inexact = mpfr_atan (dest, tmp, rnd_mode);
goto end;
}
/* Error <= ulp (tmp) except in case of underflow or overflow. */
/* If the division underflowed, since |atan(z)/z| < 1, we have
an underflow. */
if (MPFR_UNDERFLOW (flags))
{
int sign;
/* In the case MPFR_RNDN with 2^(emin-2) < |y/x| < 2^(emin-1):
The smallest significand value S > 1 of |y/x| is:
* 1 / (1 - 2^(-px)) if py <= px,
* (1 - 2^(-px) + 2^(-py)) / (1 - 2^(-px)) if py >= px.
Therefore S - 1 > 2^(-pz), where pz = max(px,py). We have:
atan(|y/x|) > atan(z), where z = 2^(emin-2) * (1 + 2^(-pz)).
> z - z^3 / 3.
> 2^(emin-2) * (1 + 2^(-pz) - 2^(2 emin - 5))
Assuming pz <= -2 emin + 5, we can round away from zero
(this is what mpfr_underflow always does on MPFR_RNDN).
In the case MPFR_RNDN with |y/x| <= 2^(emin-2), we round
toward zero, as |atan(z)/z| < 1. */
MPFR_ASSERTN (MPFR_PREC_MAX <=
2 * (mpfr_uexp_t) - MPFR_EMIN_MIN + 5);
if (rnd_mode == MPFR_RNDN && MPFR_IS_ZERO (tmp))
rnd_mode = MPFR_RNDZ;
sign = MPFR_SIGN (tmp);
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_underflow (dest, rnd_mode, sign);
}
mpfr_atan (tmp, tmp, MPFR_RNDN); /* Error <= 2*ulp (tmp) since
abs(D(arctan)) <= 1 */
/* TODO: check that the error bound is correct in case of overflow. */
/* FIXME: Error <= ulp(tmp) ? */
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - 2, MPFR_PREC (dest),
rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec);
mpfr_set_prec (tmp, prec);
}
else /* x < 0 */
/* Use sign(y)*(PI - atan (|y/x|)) */
{
mpfr_init2 (pi, prec);
for (;;)
{
mpfr_div (tmp, y, x, MPFR_RNDN); /* Error <= ulp (tmp) */
/* If tmp is 0, we have |y/x| <= 2^(-emin-2), thus
atan|y/x| < 2^(-emin-2). */
MPFR_SET_POS (tmp); /* no error */
mpfr_atan (tmp, tmp, MPFR_RNDN); /* Error <= 2*ulp (tmp) since
abs(D(arctan)) <= 1 */
mpfr_const_pi (pi, MPFR_RNDN); /* Error <= ulp(pi) /2 */
e = MPFR_NOTZERO(tmp) ? MPFR_GET_EXP (tmp) : __gmpfr_emin - 1;
mpfr_sub (tmp, pi, tmp, MPFR_RNDN); /* see above */
if (MPFR_IS_NEG (y))
MPFR_CHANGE_SIGN (tmp);
/* Error(tmp) <= (1/2+2^(EXP(pi)-EXP(tmp)-1)+2^(e-EXP(tmp)+1))*ulp
<= 2^(MAX (MAX (EXP(PI)-EXP(tmp)-1, e-EXP(tmp)+1),
-1)+2)*ulp(tmp) */
e = MAX (MAX (MPFR_GET_EXP (pi)-MPFR_GET_EXP (tmp) - 1,
e - MPFR_GET_EXP (tmp) + 1), -1) + 2;
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - e, MPFR_PREC (dest),
rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec);
mpfr_set_prec (tmp, prec);
mpfr_set_prec (pi, prec);
}
mpfr_clear (pi);
}
inexact = mpfr_set (dest, tmp, rnd_mode);
end:
MPFR_ZIV_FREE (loop);
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (dest, inexact, rnd_mode);
}
/* 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 mpfr_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;
mpfr_exp_t e, sizeinbase;
mpfr_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) <= - (mpfr_exp_t) w)
{
mpfr_set (y, x, MPFR_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_2exp (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, MPFR_RNDN); /* eps[0] = 0 */
mpfr_set_ui (errs, 0, MPFR_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, MPFR_RNDU);
mpfr_add_z (eps, eps, t, MPFR_RNDU);
MPFR_MPZ_SIZEINBASE2 (sizeinbase, m);
mpfr_mul_2si (eps, eps, sizeinbase - (w - 1) + e, MPFR_RNDU);
mpfr_div_ui (eps, eps, k, MPFR_RNDU);
mpfr_add_ui (eps, eps, 1, MPFR_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, MPFR_RNDU);
mpfr_add_ui (erru, erru, 1, MPFR_RNDU);
/* and that on s is the sum of all errors on u */
mpfr_add (errs, errs, erru, MPFR_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, MPFR_RNDU);
mpfr_div_ui (eps, eps, k, MPFR_RNDU);
mpfr_abs (erru, x, MPFR_RNDU); /* |x| */
mpfr_mul (eps, eps, erru, MPFR_RNDU);
mpfr_ui_sub (erru, k, erru, MPFR_RNDD);
if (MPFR_IS_NEG (erru))
{
/* the truncated series does not converge, return fail */
e = w;
}
else
{
mpfr_div (eps, eps, erru, MPFR_RNDU);
mpfr_add (errs, errs, eps, MPFR_RNDU);
mpfr_set_z (y, s, MPFR_RNDN);
mpfr_div_2ui (y, y, w, MPFR_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;
}
int
mpfr_ui_div (mpfr_ptr y, unsigned long int u, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
MPFR_LOG_FUNC
(("u=%lu x[%Pu]=%.*Rg rnd=%d",
u, mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg", mpfr_get_prec(y), mpfr_log_prec, y));
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)) /* u/Inf = 0 */
{
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y,x);
MPFR_RET(0);
}
else /* u / 0 */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
if (u)
{
/* u > 0, so y = sign(x) * Inf */
MPFR_SET_SAME_SIGN(y, x);
MPFR_SET_INF(y);
mpfr_set_divby0 ();
MPFR_RET(0);
}
else
{
/* 0 / 0 */
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
}
}
else if (MPFR_LIKELY(u != 0))
{
mpfr_t uu;
mp_limb_t up[1];
int cnt;
int inex;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_TMP_INIT1(up, uu, GMP_NUMB_BITS);
MPFR_ASSERTN(u == (mp_limb_t) u);
count_leading_zeros(cnt, (mp_limb_t) u);
up[0] = (mp_limb_t) u << cnt;
/* Optimization note: Exponent save/restore operations may be
removed if mpfr_div works even when uu is out-of-range. */
MPFR_SAVE_EXPO_MARK (expo);
MPFR_SET_EXP (uu, GMP_NUMB_BITS - cnt);
inex = mpfr_div (y, uu, x, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd_mode);
}
else /* u = 0, and x != 0 */
{
MPFR_SET_ZERO(y); /* if u=0, then set y to 0 */
MPFR_SET_SAME_SIGN(y, x); /* u considered as +0: sign(+0/x) = sign(x) */
MPFR_RET(0);
}
}
int
mpfr_set_str (mpfr_ptr x, __gmp_const char *str, int base, mp_rnd_t rnd_mode)
{
mpz_t mantissa;
int negative, inex;
long k = 0;
unsigned char c;
long e;
mp_prec_t q;
mpfr_t y, z;
if (base < 2 || base > 36)
return 1;
if (strcasecmp(str, "NaN") == 0)
{
MPFR_SET_NAN(x);
/* MPFR_RET_NAN not used as the return value isn't a ternary value */
__mpfr_flags |= MPFR_FLAGS_NAN;
return 0;
}
negative = *str == '-';
if (negative || *str == '+')
str++;
if (strcasecmp(str, "Inf") == 0)
{
MPFR_CLEAR_NAN(x);
MPFR_SET_INF(x);
if (negative)
MPFR_SET_NEG(x);
else
MPFR_SET_POS(x);
return 0;
}
mpz_init(mantissa);
mpz_set_ui(mantissa, 0);
while (*str == '0')
str++; /* skip initial zeros */
/* allowed characters are '0' to '0'+base-1 if base <= 10,
and '0' to '9' plus 'a' to 'a'+base-11 if 10 < base <= 36 */
while (c = *str,
(isdigit(c) && c < '0' + base) ||
(islower(c) && c < 'a'-10 + base))
{
str++;
mpz_mul_ui(mantissa, mantissa, base);
mpz_add_ui(mantissa, mantissa, isdigit(c) ? c - '0' : c - ('a'-10));
}
/* k is the number of non-zero digits before the decimal point */
if (*str == '.')
{
str++;
while (c = *str,
(isdigit(c) && c < '0' + base) ||
(islower(c) && c < 'a'-10 + base))
{
if (k == LONG_MAX)
{
mpz_clear(mantissa);
return -1;
}
k++;
str++;
mpz_mul_ui(mantissa, mantissa, base);
mpz_add_ui(mantissa, mantissa, isdigit(c) ? c - '0' : c - ('a'-10));
}
}
if (*str == '\0') /* no exponent */
{
e = -k;
}
else if ((base <= 10 && (*str == 'e' || *str == 'E')) || *str == '@')
{
char *endptr;
if (*++str == '\0') /* exponent character but no exponent */
{
mpz_clear(mantissa);
return 1;
}
errno = 0;
e = strtol(str, &endptr, 10); /* signed exponent after 'e', 'E' or '@' */
if (*endptr != '\0')
{
mpz_clear(mantissa);
return 1;
}
if (errno)
{
mpz_clear(mantissa);
return -1;
}
if (e < 0 && (unsigned long) e - k < (unsigned long) LONG_MIN)
{
mpz_clear(mantissa);
return -1;
}
e -= k;
}
else /* unexpected character */
{
mpz_clear(mantissa);
return 1;
}
/* the number is mantissa*base^expn */
q = MPFR_PREC(x) & ~(mp_prec_t) (BITS_PER_MP_LIMB - 1);
mpfr_init(y);
mpfr_init(z);
do
{
q += BITS_PER_MP_LIMB;
mpfr_set_prec(y, q);
mpfr_set_z(y, mantissa, GMP_RNDN); /* error <= 1/2*ulp(y) */
mpfr_set_prec(z, q);
if (e > 0)
{
inex = mpfr_ui_pow_ui(z, base, e, GMP_RNDN);
mpfr_mul(y, y, z, GMP_RNDN);
}
else if (e < 0)
{
inex = mpfr_ui_pow_ui(z, base, -e, GMP_RNDN);
mpfr_div(y, y, z, GMP_RNDN);
}
else
inex = 1;
if (negative)
mpfr_neg(y, y, GMP_RNDN);
}
while (mpfr_can_round(y, q-inex, GMP_RNDN, rnd_mode, MPFR_PREC(x))==0
&& q<=2*MPFR_PREC(x));
mpfr_set(x, y, rnd_mode);
mpz_clear(mantissa);
mpfr_clear(y);
mpfr_clear(z);
return 0;
}
/* computes tan(x) = sign(x)*sqrt(1/cos(x)^2-1) */
int
mpfr_tan (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t precy, m;
int inexact;
mpfr_t s, c;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
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_IS_INF(x))
{
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);
}
}
/* tan(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 1, 1,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
precy = MPFR_PREC (y);
m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13;
MPFR_ASSERTD (m >= 2); /* needed for the error analysis in algorithms.tex */
MPFR_GROUP_INIT_2 (group, m, s, c);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* The only way to get an overflow is to get ~ Pi/2
But the result will be ~ 2^Prec(y). */
mpfr_sin_cos (s, c, x, MPFR_RNDN); /* err <= 1/2 ulp on s and c */
mpfr_div (c, s, c, MPFR_RNDN); /* err <= 4 ulps */
MPFR_ASSERTD (!MPFR_IS_SINGULAR (c));
if (MPFR_LIKELY (MPFR_CAN_ROUND (c, m - 2, precy, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_2 (group, m, s, c);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, c, rnd_mode);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
static void
_assympt_mpfr (gulong l, mpq_t q, mpfr_ptr res, mp_rnd_t rnd)
{
NcmBinSplit **bs_ptr = _ncm_mpsf_sbessel_get_bs ();
NcmBinSplit *bs = *bs_ptr;
_binsplit_spherical_bessel *data = (_binsplit_spherical_bessel *) bs->userdata;
gulong prec = mpfr_get_prec (res);
#define sin_x data->sin
#define cos_x data->cos
mpfr_set_prec (sin_x, prec);
mpfr_set_prec (cos_x, prec);
mpfr_set_q (res, q, rnd);
mpfr_sin_cos (sin_x, cos_x, res, rnd);
switch (l % 4)
{
case 0:
break;
case 1:
mpfr_swap (sin_x, cos_x);
mpfr_neg (sin_x, sin_x, rnd);
break;
case 2:
mpfr_neg (sin_x, sin_x, rnd);
mpfr_neg (cos_x, cos_x, rnd);
break;
case 3:
mpfr_swap (sin_x, cos_x);
mpfr_neg (cos_x, cos_x, rnd);
break;
}
if (l > 0)
{
mpfr_mul_ui (cos_x, cos_x, l * (l + 1), rnd);
mpfr_div (cos_x, cos_x, res, rnd);
mpfr_div (cos_x, cos_x, res, rnd);
mpfr_div_2ui (cos_x, cos_x, 1, rnd);
}
mpfr_div (sin_x, sin_x, res, rnd);
data->l = l;
mpq_inv (data->mq2_2, q);
mpq_mul (data->mq2_2, data->mq2_2, data->mq2_2);
mpq_neg (data->mq2_2, data->mq2_2);
mpq_div_2exp (data->mq2_2, data->mq2_2, 2);
data->sincos = 0;
binsplit_spherical_bessel_assympt (bs, 0, (l + 1) / 2 + (l + 1) % 2);
mpfr_mul_z (sin_x, sin_x, bs->T, rnd);
mpfr_div_z (sin_x, sin_x, bs->Q, rnd);
data->sincos = 1;
if (l > 0)
{
binsplit_spherical_bessel_assympt (bs, 0, l / 2 + l % 2);
mpfr_mul_z (cos_x, cos_x, bs->T, rnd);
mpfr_div_z (cos_x, cos_x, bs->Q, rnd);
mpfr_add (res, sin_x, cos_x, rnd);
}
else
mpfr_set (res, sin_x, rnd);
ncm_memory_pool_return (bs_ptr);
return;
}
int
main (int argc, char *argv[])
{
char *filenameCompressed = FILE_NAME_RW;
char *data = FILE_NAME_R;
int status;
FILE *fh;
mpfr_t x[9];
mpfr_t y;
unsigned char badData[6][2] =
{ { 7, 0 }, { 16, 0 }, { 23, 118 }, { 23, 95 }, { 23, 127 }, { 23, 47 } };
int badDataSize[6] = { 1, 1, 2, 2, 2, 2 };
int i;
if (argc != 1)
{
printf ("Usage: %s\n", argv[0]);
exit (1);
}
tests_start_mpfr ();
mpfr_init2 (x[0], 130);
mpfr_init2 (x[8], 130);
mpfr_inits2 (2048, x[1], x[2], x[3], x[4], x[5], x[6], x[7], (mpfr_ptr) 0);
mpfr_set_str1 (x[0], "45.2564215000000018562786863185465335845947265625");
mpfr_set_str1 (x[1], "45.2564215000000018562786863185465335845947265625");
mpfr_set_str1 (x[2], "45.2564215000000018562786863185465335845947265625");
mpfr_set_exp (x[2], -48000);
mpfr_set_inf (x[3], -1);
mpfr_set_zero (x[4], 0);
mpfr_set_nan (x[5]);
mpfr_set_ui (x[6], 104348, MPFR_RNDN);
mpfr_set_ui (x[7], 33215, MPFR_RNDN);
mpfr_div (x[8], x[6], x[7], MPFR_RNDN);
mpfr_div (x[6], x[6], x[7], MPFR_RNDN);
/* we first write to file FILE_NAME_RW the numbers x[i] */
fh = fopen (filenameCompressed, "w");
if (fh == NULL)
{
printf ("Failed to open for writing %s, exiting...\n",
filenameCompressed);
exit (1);
}
for (i = 0; i < 9; i++)
{
status = mpfr_fpif_export (fh, x[i]);
if (status != 0)
{
fclose (fh);
printf ("Failed to export number %d, exiting...\n", i);
exit (1);
}
}
fclose (fh);
/* we then read back FILE_NAME_RW and check we get the same numbers x[i] */
fh = fopen (filenameCompressed, "r");
if (fh == NULL)
{
printf ("Failed to open for reading %s, exiting...\n",
filenameCompressed);
exit (1);
}
for (i = 0; i < 9; i++)
{
mpfr_init2 (y, 2);
mpfr_fpif_import (y, fh);
if (mpfr_cmp(x[i], y) != 0)
{
printf ("mpfr_cmp failed on written number %d, exiting...\n", i);
printf ("expected "); mpfr_dump (x[i]);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_clear (y);
}
fclose (fh);
/* we do the same for the fixed file FILE_NAME_R, this ensures
we get same results with different word size or endianness */
fh = src_fopen (data, "r");
if (fh == NULL)
{
printf ("Failed to open for reading %s in srcdir, exiting...\n", data);
exit (1);
}
for (i = 0; i < 9; i++)
{
mpfr_init2 (y, 2);
mpfr_fpif_import (y, fh);
if (mpfr_cmp (x[i], y) != 0)
{
printf ("mpfr_cmp failed on data number %d, exiting...\n", i);
printf ("expected "); mpfr_dump (x[i]);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_clear (y);
}
fclose (fh);
for (i = 0; i < 9; i++)
mpfr_clear (x[i]);
remove (filenameCompressed);
mpfr_init2 (y, 2);
status = mpfr_fpif_export (NULL, y);
if (status == 0)
{
printf ("mpfr_fpif_export did not fail with a NULL file\n");
exit(1);
}
status = mpfr_fpif_import (y, NULL);
if (status == 0)
{
printf ("mpfr_fpif_import did not fail with a NULL file\n");
exit(1);
}
fh = fopen (filenameCompressed, "w+");
if (fh == NULL)
{
printf ("Failed to open for reading/writing %s, exiting...\n",
filenameCompressed);
fclose (fh);
remove (filenameCompressed);
exit (1);
}
status = mpfr_fpif_import (y, fh);
if (status == 0)
{
printf ("mpfr_fpif_import did not fail on a empty file\n");
fclose (fh);
remove (filenameCompressed);
exit(1);
}
for (i = 0; i < 6; i++)
{
rewind (fh);
status = fwrite (&badData[i][0], badDataSize[i], 1, fh);
if (status != 1)
{
printf ("Write error on the test file\n");
fclose (fh);
remove (filenameCompressed);
exit(1);
}
rewind (fh);
status = mpfr_fpif_import (y, fh);
if (status == 0)
{
printf ("mpfr_fpif_import did not fail on a bad imported data\n");
switch (i)
{
case 0:
printf (" not enough precision data\n");
break;
case 1:
printf (" no exponent data\n");
break;
case 2:
printf (" too big exponent\n");
break;
case 3:
printf (" not enough exponent data\n");
break;
case 4:
printf (" exponent data wrong\n");
break;
case 5:
printf (" no limb data\n");
break;
default:
printf ("Test fatal error, unknown case\n");
break;
}
fclose (fh);
remove (filenameCompressed);
exit(1);
}
}
fclose (fh);
mpfr_clear (y);
fh = fopen (filenameCompressed, "r");
if (fh == NULL)
{
printf ("Failed to open for reading %s, exiting...\n",
filenameCompressed);
exit (1);
}
mpfr_init2 (y, 2);
status = mpfr_fpif_export (fh, y);
if (status == 0)
{
printf ("mpfr_fpif_export did not fail on a read only stream\n");
exit(1);
}
fclose (fh);
remove (filenameCompressed);
mpfr_clear (y);
tests_end_mpfr ();
return 0;
}
int
mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_t x, t, te;
mpfr_prec_t Nx, Ny, Nt;
mpfr_exp_t err;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
/* Special cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
/* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result
between -1 and 1 */
if (MPFR_IS_NAN (xt) || MPFR_IS_INF (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else /* necessarily xt is 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* atanh(0) = 0 */
MPFR_SET_SAME_SIGN (y,xt);
MPFR_RET (0);
}
}
/* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */
if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0))
{
if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_SET_DIVBY0 ();
MPFR_RET (0);
}
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
/* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
Nx = MPFR_PREC (xt);
MPFR_TMP_INIT_ABS (x, xt);
Ny = MPFR_PREC (y);
Nt = MAX (Nx, Ny);
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* initialize of intermediary variable */
mpfr_init2 (t, Nt);
mpfr_init2 (te, Nt);
/* First computation of cosh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute atanh */
mpfr_ui_sub (te, 1, x, MPFR_RNDU); /* (1-xt)*/
mpfr_add_ui (t, x, 1, MPFR_RNDD); /* (xt+1)*/
mpfr_div (t, t, te, MPFR_RNDN); /* (1+xt)/(1-xt)*/
mpfr_log (t, t, MPFR_RNDN); /* ln((1+xt)/(1-xt))*/
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/
/* error estimate: see algorithms.tex */
/* FIXME: this does not correspond to the value in algorithms.tex!!! */
/* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/
err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1);
if (MPFR_LIKELY (MPFR_IS_ZERO (t)
|| MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* reactualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
mpfr_set_prec (te, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
mpfr_clear(t);
mpfr_clear(te);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
/* set f to the rational q */
int
mpfr_set_q (mpfr_ptr f, mpq_srcptr q, mpfr_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 / GMP_NUMB_BITS))
{
MPFR_SAVE_EXPO_FREE (expo);
inexact = mpfr_overflow (f, rnd, MPFR_SIGN (f));
goto end;
}
if (MPFR_UNLIKELY (sn < MPFR_EMIN_MIN / GMP_NUMB_BITS -1))
{
MPFR_SAVE_EXPO_FREE (expo);
if (rnd == MPFR_RNDN)
rnd = MPFR_RNDZ;
inexact = mpfr_underflow (f, rnd, MPFR_SIGN (f));
goto end;
}
inexact = mpfr_div (f, n, d, rnd);
shift = GMP_NUMB_BITS*sn+cn-cd;
MPFR_ASSERTD (shift == GMP_NUMB_BITS*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);
MPFR_RET (inexact);
}
void test_all() {
long long int
failures_libm=0,
#ifdef HAVE_MATHLIB_H
failures_libultim=0,
#endif
#ifdef HAVE_LIBMCR_H
failures_libmcr=0,
#endif
failures_crlibm=0;
long long int i;
double worst_err, global_worst_err=-200;
db_number global_worst_inpt, global_worst_inpt2;
i=0;
while(1+1==2)
{
input.d = randfun();
input2.d = randfun();
if (input.d>input2.d)
{
double temp=input.d;
input.d=input2.d;
input2.d=temp;
}
/* db_number ia,ib;
ia.i[HI]=0x31100afb;
ia.i[LO]=0x198a95fe;
ib.i[HI]=0x3d42897b;
ib.i[LO]=0x84591a4e;
input.d=ia.d; input2.d=ib.d;*/
ASSIGN_LOW(input_i,input.d);
ASSIGN_UP(input_i,input2.d);
res_crlibm = testfun_crlibm_interval(input_i);
res_crlibm_low.d=LOW(res_crlibm);
res_crlibm_up.d=UP(res_crlibm);
mpfr_set_d(mp_inpt, input.d, GMP_RNDN);
testfun_mpfr(mp_res, mp_inpt, GMP_RNDD);
res_mpfr_low.d = mpfr_get_d(mp_res, GMP_RNDD);
mpfr_set_d(mp_inpt, input2.d, GMP_RNDN);
testfun_mpfr(mp_res, mp_inpt, GMP_RNDU);
res_mpfr_up.d = mpfr_get_d(mp_res, GMP_RNDU);
/* printHexa("resul crlibm low:",res_crlibm_low.d);
printHexa("resul crlibm up:",res_crlibm_up.d);
printHexa("resul mpfr low:",res_mpfr_low.d);
printHexa("resul mpfr up:",res_mpfr_up.d);*/
#if PRINT_NAN
if(1){
#else
if( ((res_mpfr_low.i[HI] & 0x7ff00000) != 0x7ff00000)
&& ((res_mpfr_up.i[HI] & 0x7ff00000) != 0x7ff00000) ) {
#endif
if( (res_crlibm_low.i[LO] != res_mpfr_low.i[LO])
|| (res_crlibm_low.i[HI] != res_mpfr_low.i[HI])
|| (res_crlibm_up.i[LO] != res_mpfr_up.i[LO])
|| (res_crlibm_up.i[HI] != res_mpfr_up.i[HI]) )
{
#if DETAILED_REPORT
printf("*** CRLIBM ERROR ***\n");
PRINT_INPUT_ERROR;
printf("crlibm gives [%.50e,%.50e] \n [(%08x %08x),(%08x %08x)] \n",
res_crlibm_low.d, res_crlibm_up.d,
res_crlibm_low.i[HI], res_crlibm_low.i[LO],
res_crlibm_up.i[HI], res_crlibm_up.i[LO]);
printf("MPFR gives [%.50e,%.50e] \n [(%08x %08x),(%08x %08x)] \n\n",
res_mpfr_low.d,
res_mpfr_up.d,
res_mpfr_low.i[HI],
res_mpfr_low.i[LO],
res_mpfr_up.i[HI],
res_mpfr_up.i[LO]
);
#endif
#if WORST_ERROR_REPORT
mpfr_set_d(mp_inpt, res_crlibm_low.d, GMP_RNDN);
mpfr_sub(mp_inpt, mp_inpt, mp_res, GMP_RNDN);
mpfr_div(mp_inpt, mp_inpt, mp_res, GMP_RNDN);
mpfr_abs(mp_inpt, mp_inpt, GMP_RNDN);
mpfr_log2(mp_inpt, mp_inpt, GMP_RNDN);
worst_err=mpfr_get_d(mp_inpt, GMP_RNDN);
if (worst_err>global_worst_err){
global_worst_err=worst_err;
global_worst_inpt.d = input.d;
global_worst_inpt2.d = input2.d;
}
mpfr_set_d(mp_inpt, res_crlibm_up.d, GMP_RNDN);
mpfr_sub(mp_inpt, mp_inpt, mp_res, GMP_RNDN);
mpfr_div(mp_inpt, mp_inpt, mp_res, GMP_RNDN);
mpfr_abs(mp_inpt, mp_inpt, GMP_RNDN);
mpfr_log2(mp_inpt, mp_inpt, GMP_RNDN);
worst_err=mpfr_get_d(mp_inpt, GMP_RNDN);
if (worst_err>global_worst_err){
global_worst_err=worst_err;
global_worst_inpt.d = input.d;
global_worst_inpt2.d = input2.d;
}
printf("Worst crlibm relative error so far : 2^(%f)\n",global_worst_err);
printf(" for x =%.50e (%08x %08x) \n",
global_worst_inpt.d,
global_worst_inpt.i[HI],
global_worst_inpt.i[LO]);
#endif
failures_crlibm++;
}
}
i++;
if((i % 10000)==0)
{
printf(" CRLIBM : %lld failures out of %lld (ratio %e) \n",failures_crlibm, i,
((double)failures_crlibm)/(double)i);
printf("\n");
}
}
}
void usage(char *fct_name){
/* fprintf (stderr, "\n%s: Soak-test for crlibm and other mathematical libraries \n", fct_name); */
fprintf (stderr, "\nUsage: %s function seed \n", fct_name);
fprintf (stderr, " function : name of function to test \n");
fprintf (stderr, " seed : integer seed for the random number generator \n");
exit (1);
}
void divide(ElementType &result, const ElementType& a, const ElementType& b) const
{
mpfr_div(&result, &a, &b, GMP_RNDN);
}
/* Compute the first 2^m terms from the hypergeometric series
with x = p / 2^r */
static int
GENERIC (mpfr_ptr y, mpz_srcptr p, long r, int m)
{
unsigned long n,i,k,j,l;
int is_p_one;
mpz_t* P,*S;
#ifdef A
mpz_t *T;
#endif
mpz_t* ptoj;
#ifdef R_IS_RATIONAL
mpz_t* qtoj;
mpfr_t tmp;
#endif
mp_exp_t diff, expo;
mp_prec_t precy = MPFR_PREC(y);
MPFR_TMP_DECL(marker);
MPFR_TMP_MARK(marker);
MPFR_CLEAR_FLAGS(y);
n = 1UL << m;
P = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
S = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
ptoj = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t)); /* ptoj[i] = mantissa^(2^i) */
#ifdef A
T = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
#endif
#ifdef R_IS_RATIONAL
qtoj = (mpz_t*) MPFR_TMP_ALLOC ((m+1) * sizeof(mpz_t));
#endif
for (i = 0 ; i <= m ; i++)
{
mpz_init (P[i]);
mpz_init (S[i]);
mpz_init (ptoj[i]);
#ifdef R_IS_RATIONAL
mpz_init (qtoj[i]);
#endif
#ifdef A
mpz_init (T[i]);
#endif
}
mpz_set (ptoj[0], p);
#ifdef C
# if C2 != 1
mpz_mul_ui (ptoj[0], ptoj[0], C2);
# endif
#endif
is_p_one = mpz_cmp_ui(ptoj[0], 1) == 0;
#ifdef A
# ifdef B
mpz_set_ui (T[0], A1 * B1);
# else
mpz_set_ui (T[0], A1);
# endif
#endif
if (!is_p_one)
for (i = 1 ; i < m ; i++)
mpz_mul (ptoj[i], ptoj[i-1], ptoj[i-1]);
#ifdef R_IS_RATIONAL
mpz_set_si (qtoj[0], r);
for (i = 1 ; i <= m ; i++)
mpz_mul(qtoj[i], qtoj[i-1], qtoj[i-1]);
#endif
mpz_set_ui (P[0], 1);
mpz_set_ui (S[0], 1);
k = 0;
for (i = 1 ; i < n ; i++) {
k++;
#ifdef A
# ifdef B
mpz_set_ui (T[k], (A1 + A2*i)*(B1+B2*i));
# else
mpz_set_ui (T[k], A1 + A2*i);
# endif
#endif
#ifdef C
# ifdef NO_FACTORIAL
mpz_set_ui (P[k], (C1 + C2 * (i-1)));
mpz_set_ui (S[k], 1);
# else
mpz_set_ui (P[k], (i+1) * (C1 + C2 * (i-1)));
mpz_set_ui (S[k], i+1);
# endif
#else
# ifdef NO_FACTORIAL
mpz_set_ui (P[k], 1);
# else
mpz_set_ui (P[k], i+1);
# endif
mpz_set (S[k], P[k]);
#endif
for (j = i+1, l = 0 ; (j & 1) == 0 ; l++, j>>=1, k--) {
if (!is_p_one)
mpz_mul (S[k], S[k], ptoj[l]);
#ifdef A
# ifdef B
# if (A2*B2) != 1
mpz_mul_ui (P[k], P[k], A2*B2);
# endif
# else
# if A2 != 1
mpz_mul_ui (P[k], P[k], A2);
# endif
#endif
mpz_mul (S[k], S[k], T[k-1]);
#endif
mpz_mul (S[k-1], S[k-1], P[k]);
#ifdef R_IS_RATIONAL
mpz_mul (S[k-1], S[k-1], qtoj[l]);
#else
mpz_mul_2exp (S[k-1], S[k-1], r*(1<<l));
#endif
mpz_add (S[k-1], S[k-1], S[k]);
mpz_mul (P[k-1], P[k-1], P[k]);
#ifdef A
mpz_mul (T[k-1], T[k-1], T[k]);
#endif
}
}
diff = mpz_sizeinbase(S[0],2) - 2*precy;
expo = diff;
if (diff >= 0)
mpz_div_2exp(S[0],S[0],diff);
else
mpz_mul_2exp(S[0],S[0],-diff);
diff = mpz_sizeinbase(P[0],2) - precy;
expo -= diff;
if (diff >=0)
mpz_div_2exp(P[0],P[0],diff);
else
mpz_mul_2exp(P[0],P[0],-diff);
mpz_tdiv_q(S[0], S[0], P[0]);
mpfr_set_z(y, S[0], GMP_RNDD);
MPFR_SET_EXP (y, MPFR_GET_EXP (y) + expo);
#ifdef R_IS_RATIONAL
/* exact division */
mpz_div_ui (qtoj[m], qtoj[m], r);
mpfr_init2 (tmp, MPFR_PREC(y));
mpfr_set_z (tmp, qtoj[m] , GMP_RNDD);
mpfr_div (y, y, tmp, GMP_RNDD);
mpfr_clear (tmp);
#else
mpfr_div_2ui(y, y, r*(i-1), GMP_RNDN);
#endif
for (i = 0 ; i <= m ; i++)
{
mpz_clear (P[i]);
mpz_clear (S[i]);
mpz_clear (ptoj[i]);
#ifdef R_IS_RATIONAL
mpz_clear (qtoj[i]);
#endif
#ifdef A
mpz_clear (T[i]);
#endif
}
MPFR_TMP_FREE (marker);
return 0;
}
/* Don't need to save / restore exponent range: the cache does it */
int
mpfr_const_log2_internal (mpfr_ptr x, mpfr_rnd_t rnd_mode)
{
unsigned long n = MPFR_PREC (x);
mpfr_prec_t w; /* working precision */
unsigned long N;
mpz_t *T, *P, *Q;
mpfr_t t, q;
int inexact;
int ok = 1; /* ensures that the 1st try will give correct rounding */
unsigned long lgN, i;
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (
("rnd_mode=%d", rnd_mode),
("x[%Pu]=%.*Rg inex=%d", mpfr_get_prec(x), mpfr_log_prec, x, inexact));
mpfr_init2 (t, MPFR_PREC_MIN);
mpfr_init2 (q, MPFR_PREC_MIN);
if (n < 1253)
w = n + 10; /* ensures correct rounding for the four rounding modes,
together with N = w / 3 + 1 (see below). */
else if (n < 2571)
w = n + 11; /* idem */
else if (n < 3983)
w = n + 12;
else if (n < 4854)
w = n + 13;
else if (n < 26248)
w = n + 14;
else
{
w = n + 15;
ok = 0;
}
MPFR_ZIV_INIT (loop, w);
for (;;)
{
N = w / 3 + 1; /* Warning: do not change that (even increasing N!)
without checking correct rounding in the above
ranges for n. */
/* the following are needed for error analysis (see algorithms.tex) */
MPFR_ASSERTD(w >= 3 && N >= 2);
lgN = MPFR_INT_CEIL_LOG2 (N) + 1;
T = (mpz_t *) (*__gmp_allocate_func) (3 * lgN * sizeof (mpz_t));
P = T + lgN;
Q = T + 2*lgN;
for (i = 0; i < lgN; i++)
{
mpz_init (T[i]);
mpz_init (P[i]);
mpz_init (Q[i]);
}
S (T, P, Q, 0, N, 0);
mpfr_set_prec (t, w);
mpfr_set_prec (q, w);
mpfr_set_z (t, T[0], MPFR_RNDN);
mpfr_set_z (q, Q[0], MPFR_RNDN);
mpfr_div (t, t, q, MPFR_RNDN);
for (i = 0; i < lgN; i++)
{
mpz_clear (T[i]);
mpz_clear (P[i]);
mpz_clear (Q[i]);
}
(*__gmp_free_func) (T, 3 * lgN * sizeof (mpz_t));
if (MPFR_LIKELY (ok != 0
|| mpfr_can_round (t, w - 2, MPFR_RNDN, rnd_mode, n)))
break;
MPFR_ZIV_NEXT (loop, w);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (x, t, rnd_mode);
mpfr_clear (t);
mpfr_clear (q);
return inexact;
}
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);
}
/* Don't need to save/restore exponent range: the cache does it.
Catalan's constant is G = sum((-1)^k/(2*k+1)^2, k=0..infinity).
We compute it using formula (31) of Victor Adamchik's page
"33 representations for Catalan's constant"
http://www-2.cs.cmu.edu/~adamchik/articles/catalan/catalan.htm
G = Pi/8*log(2+sqrt(3)) + 3/8*sum(k!^2/(2k)!/(2k+1)^2,k=0..infinity)
*/
int
mpfr_const_catalan_internal (mpfr_ptr g, mpfr_rnd_t rnd_mode)
{
mpfr_t x, y, z;
mpz_t T, P, Q;
mpfr_prec_t pg, p;
int inex;
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL (group);
MPFR_LOG_FUNC (("rnd_mode=%d", rnd_mode),
("g[%Pu]=%.*Rg inex=%d", mpfr_get_prec (g), mpfr_log_prec, g, inex));
/* Here are the WC (max prec = 100.000.000)
Once we have found a chain of 11, we only look for bigger chain.
Found 3 '1' at 0
Found 5 '1' at 9
Found 6 '0' at 34
Found 9 '1' at 176
Found 11 '1' at 705
Found 12 '0' at 913
Found 14 '1' at 12762
Found 15 '1' at 152561
Found 16 '0' at 171725
Found 18 '0' at 525355
Found 20 '0' at 529245
Found 21 '1' at 6390133
Found 22 '0' at 7806417
Found 25 '1' at 11936239
Found 27 '1' at 51752950
*/
pg = MPFR_PREC (g);
p = pg + MPFR_INT_CEIL_LOG2 (pg) + 7;
MPFR_GROUP_INIT_3 (group, p, x, y, z);
mpz_init (T);
mpz_init (P);
mpz_init (Q);
MPFR_ZIV_INIT (loop, p);
for (;;) {
mpfr_sqrt_ui (x, 3, MPFR_RNDU);
mpfr_add_ui (x, x, 2, MPFR_RNDU);
mpfr_log (x, x, MPFR_RNDU);
mpfr_const_pi (y, MPFR_RNDU);
mpfr_mul (x, x, y, MPFR_RNDN);
S (T, P, Q, 0, (p - 1) / 2);
mpz_mul_ui (T, T, 3);
mpfr_set_z (y, T, MPFR_RNDU);
mpfr_set_z (z, Q, MPFR_RNDD);
mpfr_div (y, y, z, MPFR_RNDN);
mpfr_add (x, x, y, MPFR_RNDN);
mpfr_div_2ui (x, x, 3, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (x, p - 5, pg, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, p);
MPFR_GROUP_REPREC_3 (group, p, x, y, z);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (g, x, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpz_clear (T);
mpz_clear (P);
mpz_clear (Q);
return inex;
}
int
mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd)
{
int inex;
mpfr_t tmp, ump;
mpfr_exp_t err, te;
mpfr_prec_t prec;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (
("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, 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_set_divby0 ();
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, MPFR_RNDU);
mpfr_sub (ump, x, tmp, MPFR_RNDD);
mpfr_const_log2 (tmp, MPFR_RNDU);
mpfr_div (ump, ump, tmp, MPFR_RNDD);
/* FIXME: We really need mpfr_set_exp_t and mpfr_cmpfr_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 */
/* FIXME: do not use native floating-point here. */
if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */
{
double d;
d = mpfr_get_d (x, MPFR_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, MPFR_RNDN); /* 0.577 -> EXP(ump)=0 */
mpfr_add (tmp, tmp, ump, MPFR_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, MPFR_RNDN);
mpfr_add (tmp, tmp, ump, MPFR_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);
}
