/* 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_sinh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
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));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mpfr_exp_t d;
mpfr_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh */
MPFR_BLOCK (flags, mpfr_exp (t, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */
mpfr_div_2ui (ti, x, 1, MPFR_RNDD); /* exact */
/* t <- cosh(x/2): error(t) <= 1 ulp(t) */
MPFR_BLOCK (flags, mpfr_cosh (t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* when x>1 we have |sinh(x)| >= cosh(x/2), so sinh(x)
overflows too */
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* ti <- sinh(x/2): , error(ti) <= 1 ulp(ti)
cannot overflow because 0 < sinh(x) < cosh(x) when x > 0 */
mpfr_sinh (ti, ti, MPFR_RNDD);
/* multiplication below, error(t) <= 5 ulp(t) */
MPFR_BLOCK (flags, mpfr_mul (t, t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* doubling below, exact */
MPFR_BLOCK (flags, mpfr_mul_2ui (t, t, 1, MPFR_RNDN));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* we have lost at most 3 bits of precision */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
err = Nt; /* double the precision */
}
else
{
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, MPFR_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
/* Use the reflection formula Digamma(1-x) = Digamma(x) + Pi * cot(Pi*x),
i.e., Digamma(x) = Digamma(1-x) - Pi * cot(Pi*x).
Assume x < 1/2. */
static int
mpfr_digamma_reflection (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t p = MPFR_PREC(y) + 10, q;
mpfr_t t, u, v;
mpfr_exp_t e1, expv;
int inex;
MPFR_ZIV_DECL (loop);
/* we want that 1-x is exact with precision q: if 0 < x < 1/2, then
q = PREC(x)-EXP(x) is ok, otherwise if -1 <= x < 0, q = PREC(x)-EXP(x)
is ok, otherwise for x < -1, PREC(x) is ok if EXP(x) <= PREC(x),
otherwise we need EXP(x) */
if (MPFR_EXP(x) < 0)
q = MPFR_PREC(x) + 1 - MPFR_EXP(x);
else if (MPFR_EXP(x) <= MPFR_PREC(x))
q = MPFR_PREC(x) + 1;
else
q = MPFR_EXP(x);
mpfr_init2 (u, q);
MPFR_DBGRES(inex = mpfr_ui_sub (u, 1, x, MPFR_RNDN));
MPFR_ASSERTN(inex == 0);
/* if x is half an integer, cot(Pi*x) = 0, thus Digamma(x) = Digamma(1-x) */
mpfr_mul_2exp (u, u, 1, MPFR_RNDN);
inex = mpfr_integer_p (u);
mpfr_div_2exp (u, u, 1, MPFR_RNDN);
if (inex)
{
inex = mpfr_digamma (y, u, rnd_mode);
goto end;
}
mpfr_init2 (t, p);
mpfr_init2 (v, p);
MPFR_ZIV_INIT (loop, p);
for (;;)
{
mpfr_const_pi (v, MPFR_RNDN); /* v = Pi*(1+theta) for |theta|<=2^(-p) */
mpfr_mul (t, v, x, MPFR_RNDN); /* (1+theta)^2 */
e1 = MPFR_EXP(t) - (mpfr_exp_t) p + 1; /* bound for t: err(t) <= 2^e1 */
mpfr_cot (t, t, MPFR_RNDN);
/* cot(t * (1+h)) = cot(t) - theta * (1 + cot(t)^2) with |theta|<=t*h */
if (MPFR_EXP(t) > 0)
e1 = e1 + 2 * MPFR_EXP(t) + 1;
else
e1 = e1 + 1;
/* now theta * (1 + cot(t)^2) <= 2^e1 */
e1 += (mpfr_exp_t) p - MPFR_EXP(t); /* error is now 2^e1 ulps */
mpfr_mul (t, t, v, MPFR_RNDN);
e1 ++;
mpfr_digamma (v, u, MPFR_RNDN); /* error <= 1/2 ulp */
expv = MPFR_EXP(v);
mpfr_sub (v, v, t, MPFR_RNDN);
if (MPFR_EXP(v) < MPFR_EXP(t))
e1 += MPFR_EXP(t) - MPFR_EXP(v); /* scale error for t wrt new v */
/* now take into account the 1/2 ulp error for v */
if (expv - MPFR_EXP(v) - 1 > e1)
e1 = expv - MPFR_EXP(v) - 1;
else
e1 ++;
e1 ++; /* rounding error for mpfr_sub */
if (MPFR_CAN_ROUND (v, p - e1, MPFR_PREC(y), rnd_mode))
break;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (t, p);
mpfr_set_prec (v, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (y, v, rnd_mode);
mpfr_clear (t);
mpfr_clear (v);
end:
mpfr_clear (u);
return inex;
}
void mexFunction( int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[] )
{
double *prec,*eoutr,*eouti;
int mrows,ncols;
char *input_buf;
char *w1,*w2;
int buflen,status;
mpfr_t xr,xi,yr,yi,zr,zi,temp,temp1;
mp_exp_t expptr;
/* Check for proper number of arguments. */
if(nrhs!=5) {
mexErrMsgTxt("5 inputs required.");
} else if(nlhs>4) {
mexErrMsgTxt("Too many output arguments");
}
/* The input must be a noncomplex scalar double.*/
mrows = mxGetM(prhs[0]);
ncols = mxGetN(prhs[0]);
if( !mxIsDouble(prhs[0]) || mxIsComplex(prhs[0]) ||
!(mrows==1 && ncols==1) ) {
mexErrMsgTxt("Input must be a noncomplex scalar double.");
}
/* Set precision and initialize mpfr variables */
prec = mxGetPr(prhs[0]);
mpfr_set_default_prec(*prec);
mpfr_init(xr); mpfr_init(xi);
mpfr_init(yr); mpfr_init(yi);
mpfr_init(zr); mpfr_init(zi);
mpfr_init(temp); mpfr_init(temp1);
/* Read the input strings into mpfr x real */
buflen = (mxGetM(prhs[1]) * mxGetN(prhs[1])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[1], input_buf, buflen);
mpfr_set_str(xr,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr x imag */
buflen = (mxGetM(prhs[2]) * mxGetN(prhs[2])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[2], input_buf, buflen);
mpfr_set_str(xi,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr y real */
buflen = (mxGetM(prhs[3]) * mxGetN(prhs[3])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[3], input_buf, buflen);
mpfr_set_str(yr,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr y imag */
buflen = (mxGetM(prhs[4]) * mxGetN(prhs[4])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[4], input_buf, buflen);
mpfr_set_str(yi,input_buf,10,GMP_RNDN);
/* Mathematical operation */
/* denominator */
mpfr_mul(temp,yr,yr,GMP_RNDN);
mpfr_mul(temp1,yi,yi,GMP_RNDN);
mpfr_add(temp,temp,temp1,GMP_RNDN);
/* real part */
mpfr_mul(temp1,xr,yr,GMP_RNDN);
mpfr_mul(zr,xi,yi,GMP_RNDN);
mpfr_add(zr,temp1,zr,GMP_RNDN);
/* imag part */
mpfr_mul(temp1,xi,yr,GMP_RNDN);
mpfr_mul(zi,xr,yi,GMP_RNDN);
mpfr_sub(zi,temp1,zi,GMP_RNDN);
/* divide by denominator */
mpfr_div(zr,zr,temp,GMP_RNDN);
mpfr_div(zi,zi,temp,GMP_RNDN);
/* Retrieve results */
mxFree(input_buf);
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, zr, GMP_RNDN);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[0] = mxCreateString(w1);
/* plhs[1] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eoutr=mxGetPr(plhs[1]); */
/* *eoutr=expptr; */
mpfr_free_str(input_buf);
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, zi, GMP_RNDN);
free(w1);
free(w2);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[1] = mxCreateString(w1);
/* plhs[3] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eouti=mxGetPr(plhs[3]); */
/* *eouti=expptr; */
mpfr_clear(xr); mpfr_clear(xi);
mpfr_clear(yr); mpfr_clear(yi);
mpfr_clear(zr); mpfr_clear(zi);
mpfr_clear(temp); mpfr_clear(temp1);
mpfr_free_str(input_buf);
free(w1);
free(w2);
}
int
mpfr_exp_3 (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_t t, x_copy, tmp;
mpz_t uk;
mp_exp_t ttt, shift_x;
unsigned long twopoweri;
mpz_t *P;
mp_prec_t *mult;
int i, k, loop;
int prec_x;
mp_prec_t realprec, Prec;
int iter;
int inexact = 0;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (ziv_loop);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
MPFR_SAVE_EXPO_MARK (expo);
/* decompose x */
/* we first write x = 1.xxxxxxxxxxxxx
----- k bits -- */
prec_x = MPFR_INT_CEIL_LOG2 (MPFR_PREC (x)) - MPFR_LOG2_BITS_PER_MP_LIMB;
if (prec_x < 0)
prec_x = 0;
ttt = MPFR_GET_EXP (x);
mpfr_init2 (x_copy, MPFR_PREC(x));
mpfr_set (x_copy, x, GMP_RNDD);
/* we shift to get a number less than 1 */
if (ttt > 0)
{
shift_x = ttt;
mpfr_div_2ui (x_copy, x, ttt, GMP_RNDN);
ttt = MPFR_GET_EXP (x_copy);
}
else
shift_x = 0;
MPFR_ASSERTD (ttt <= 0);
/* Init prec and vars */
realprec = MPFR_PREC (y) + MPFR_INT_CEIL_LOG2 (prec_x + MPFR_PREC (y));
Prec = realprec + shift + 2 + shift_x;
mpfr_init2 (t, Prec);
mpfr_init2 (tmp, Prec);
mpz_init (uk);
/* Main loop */
MPFR_ZIV_INIT (ziv_loop, realprec);
for (;;)
{
int scaled = 0;
MPFR_BLOCK_DECL (flags);
k = MPFR_INT_CEIL_LOG2 (Prec) - MPFR_LOG2_BITS_PER_MP_LIMB;
/* now we have to extract */
twopoweri = BITS_PER_MP_LIMB;
/* Allocate tables */
P = (mpz_t*) (*__gmp_allocate_func) (3*(k+2)*sizeof(mpz_t));
for (i = 0; i < 3*(k+2); i++)
mpz_init (P[i]);
mult = (mp_prec_t*) (*__gmp_allocate_func) (2*(k+2)*sizeof(mp_prec_t));
/* Particular case for i==0 */
mpfr_extract (uk, x_copy, 0);
MPFR_ASSERTD (mpz_cmp_ui (uk, 0) != 0);
mpfr_exp_rational (tmp, uk, shift + twopoweri - ttt, k + 1, P, mult);
for (loop = 0; loop < shift; loop++)
mpfr_sqr (tmp, tmp, GMP_RNDD);
twopoweri *= 2;
/* General case */
iter = (k <= prec_x) ? k : prec_x;
for (i = 1; i <= iter; i++)
{
mpfr_extract (uk, x_copy, i);
if (MPFR_LIKELY (mpz_cmp_ui (uk, 0) != 0))
{
mpfr_exp_rational (t, uk, twopoweri - ttt, k - i + 1, P, mult);
mpfr_mul (tmp, tmp, t, GMP_RNDD);
}
MPFR_ASSERTN (twopoweri <= LONG_MAX/2);
twopoweri *=2;
}
/* Clear tables */
for (i = 0; i < 3*(k+2); i++)
mpz_clear (P[i]);
(*__gmp_free_func) (P, 3*(k+2)*sizeof(mpz_t));
(*__gmp_free_func) (mult, 2*(k+2)*sizeof(mp_prec_t));
if (shift_x > 0)
{
MPFR_BLOCK (flags, {
for (loop = 0; loop < shift_x - 1; loop++)
mpfr_sqr (tmp, tmp, GMP_RNDD);
mpfr_sqr (t, tmp, GMP_RNDD);
} );
if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags)))
{
/* tmp <= exact result, so that it is a real overflow. */
inexact = mpfr_overflow (y, rnd_mode, 1);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags)))
{
/* This may be a spurious underflow. So, let's scale
the result. */
mpfr_mul_2ui (tmp, tmp, 1, GMP_RNDD); /* no overflow, exact */
mpfr_sqr (t, tmp, GMP_RNDD);
if (MPFR_IS_ZERO (t))
{
/* approximate result < 2^(emin - 3), thus
exact result < 2^(emin - 2). */
inexact = mpfr_underflow (y, (rnd_mode == GMP_RNDN) ?
GMP_RNDZ : rnd_mode, 1);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW);
break;
}
scaled = 1;
}
}
static void
check_inexact (void)
{
mpfr_t x, y, z, u;
mp_prec_t px, py, pu;
int inexact, cmp;
mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (u);
mpfr_set_prec (x, 28);
mpfr_set_prec (y, 28);
mpfr_set_prec (z, 1023);
mpfr_set_str_binary (x, "0.1000001001101101111100010011E0");
mpfr_set_str (z, "48284762641021308813686974720835219181653367326353400027913400579340343320519877153813133510034402932651132854764198688352364361009429039801248971901380781746767119334993621199563870113045276395603170432175354501451429471578325545278975153148347684600400321033502982713296919861760382863826626093689036010394", 10, GMP_RNDN);
mpfr_div (x, x, z, GMP_RNDN);
mpfr_set_str_binary (y, "0.1111001011001101001001111100E-1023");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_div for prec=28, RNDN\n");
printf ("Expected "); mpfr_dump (y);
printf ("Got "); mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "0.11101100110010100011011000000100001111011111110010101E0");
mpfr_set_prec (u, 127);
mpfr_set_str_binary (u, "0.1000001100110110110101110110101101111000110000001111111110000000011111001010110100110010111111111101000001011011101011101101000E-2");
mpfr_set_prec (y, 95);
inexact = test_div (y, x, u, GMP_RNDN);
if (inexact != (cmp = get_inexact (y, x, u)))
{
printf ("Wrong inexact flag (0): expected %d, got %d\n", cmp, inexact);
printf ("x="); mpfr_out_str (stdout, 10, 99, x, GMP_RNDN); printf ("\n");
printf ("u="); mpfr_out_str (stdout, 10, 99, u, GMP_RNDN); printf ("\n");
printf ("y="); mpfr_out_str (stdout, 10, 99, y, GMP_RNDN); printf ("\n");
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_str_binary (x, "0.101111100011011101010011101100001E0");
mpfr_set_prec (u, 2);
mpfr_set_str_binary (u, "0.1E0");
mpfr_set_prec (y, 28);
if ((inexact = test_div (y, x, u, GMP_RNDN) >= 0))
{
printf ("Wrong inexact flag (1): expected -1, got %d\n",
inexact);
exit (1);
}
mpfr_set_prec (x, 129);
mpfr_set_str_binary (x, "0.111110101111001100000101011100101100110011011101010001000110110101100101000010000001110110100001101010001010100010001111001101010E-2");
mpfr_set_prec (u, 15);
mpfr_set_str_binary (u, "0.101101000001100E-1");
mpfr_set_prec (y, 92);
if ((inexact = test_div (y, x, u, GMP_RNDN)) <= 0)
{
printf ("Wrong inexact flag for rnd=GMP_RNDN(1): expected 1, got %d\n",
inexact);
mpfr_dump (x);
mpfr_dump (u);
mpfr_dump (y);
exit (1);
}
for (px=2; px<MAX_PREC; px++)
{
mpfr_set_prec (x, px);
mpfr_random (x);
for (pu=2; pu<=MAX_PREC; pu++)
{
mpfr_set_prec (u, pu);
do { mpfr_random (u); } while (mpfr_cmp_ui (u, 0) == 0);
{
py = MPFR_PREC_MIN + (randlimb () % (MAX_PREC - MPFR_PREC_MIN));
mpfr_set_prec (y, py);
mpfr_set_prec (z, py + pu);
{
rnd = (mp_rnd_t) RND_RAND ();
inexact = test_div (y, x, u, rnd);
if (mpfr_mul (z, y, u, rnd))
{
printf ("z <- y * u should be exact\n");
exit (1);
}
cmp = mpfr_cmp (z, x);
if (((inexact == 0) && (cmp != 0)) ||
((inexact > 0) && (cmp <= 0)) ||
((inexact < 0) && (cmp >= 0)))
{
printf ("Wrong inexact flag for rnd=%s\n",
mpfr_print_rnd_mode(rnd));
printf ("expected %d, got %d\n", cmp, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
printf ("u="); mpfr_print_binary (u); puts ("");
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("y*u="); mpfr_print_binary (z); puts ("");
exit (1);
}
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (u);
}
static void
bug_mul_div_q_20100818 (void)
{
mpq_t qa, qb;
mpfr_t x1, x2, y1, y2, y3;
mpfr_exp_t emin, emax, e;
int inex;
int rnd;
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
set_emin (MPFR_EMIN_MIN);
set_emax (MPFR_EMAX_MAX);
mpq_init (qa);
mpq_init (qb);
mpfr_inits2 (32, x1, x2, y1, y2, y3, (mpfr_ptr) 0);
mpq_set_ui (qa, 3, 17);
mpq_set_ui (qb, 17, 3);
inex = mpfr_set_ui (x1, 7, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
e = MPFR_EMAX_MAX - 3;
inex = mpfr_set_ui_2exp (x2, 7, e, MPFR_RNDN); /* x2 = x1 * 2^e */
MPFR_ASSERTN (inex == 0);
RND_LOOP(rnd)
{
mpfr_mul_q (y1, x1, qa, (mpfr_rnd_t) rnd);
mpfr_div_q (y3, x1, qb, (mpfr_rnd_t) rnd);
MPFR_ASSERTN (mpfr_equal_p (y1, y3));
inex = mpfr_set_ui_2exp (y3, 1, e, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
inex = mpfr_mul (y3, y3, y1, MPFR_RNDN); /* y3 = y1 * 2^e */
MPFR_ASSERTN (inex == 0);
mpfr_mul_q (y2, x2, qa, (mpfr_rnd_t) rnd);
if (! mpfr_equal_p (y2, y3))
{
printf ("Error 1 in bug_mul_div_q_20100818 (rnd = %d)\n", rnd);
printf ("Expected "); mpfr_dump (y3);
printf ("Got "); mpfr_dump (y2);
exit (1);
}
mpfr_div_q (y2, x2, qb, (mpfr_rnd_t) rnd);
if (! mpfr_equal_p (y2, y3))
{
printf ("Error 2 in bug_mul_div_q_20100818 (rnd = %d)\n", rnd);
printf ("Expected "); mpfr_dump (y3);
printf ("Got "); mpfr_dump (y2);
exit (1);
}
}
e = MPFR_EMIN_MIN;
inex = mpfr_set_ui_2exp (x2, 7, e, MPFR_RNDN); /* x2 = x1 * 2^e */
MPFR_ASSERTN (inex == 0);
RND_LOOP(rnd)
{
mpfr_div_q (y1, x1, qa, (mpfr_rnd_t) rnd);
mpfr_mul_q (y3, x1, qb, (mpfr_rnd_t) rnd);
MPFR_ASSERTN (mpfr_equal_p (y1, y3));
inex = mpfr_set_ui_2exp (y3, 1, e, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
inex = mpfr_mul (y3, y3, y1, MPFR_RNDN); /* y3 = y1 * 2^e */
MPFR_ASSERTN (inex == 0);
mpfr_div_q (y2, x2, qa, (mpfr_rnd_t) rnd);
if (! mpfr_equal_p (y2, y3))
{
printf ("Error 3 in bug_mul_div_q_20100818 (rnd = %d)\n", rnd);
printf ("Expected "); mpfr_dump (y3);
printf ("Got "); mpfr_dump (y2);
exit (1);
}
mpfr_mul_q (y2, x2, qb, (mpfr_rnd_t) rnd);
if (! mpfr_equal_p (y2, y3))
{
printf ("Error 4 in bug_mul_div_q_20100818 (rnd = %d)\n", rnd);
printf ("Expected "); mpfr_dump (y3);
printf ("Got "); mpfr_dump (y2);
exit (1);
}
}
mpq_clear (qa);
mpq_clear (qb);
mpfr_clears (x1, x2, y1, y2, y3, (mpfr_ptr) 0);
set_emin (emin);
set_emax (emax);
}
static void
special (void)
{
mpfr_t x, y, z;
int inexact;
mpfr_prec_t p;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_set_prec (x, 64);
mpfr_set_str_binary (x, "1010000010100011011001010101010010001100001101011101110001011001E-1");
mpfr_set_prec (y, 32);
test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 2405743844UL))
{
printf ("Error for n^2+n+1/2 with n=2405743843\n");
exit (1);
}
mpfr_set_prec (x, 65);
mpfr_set_str_binary (x, "10100000101000110110010101010100100011000011010111011100010110001E-2");
mpfr_set_prec (y, 32);
test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 2405743844UL))
{
printf ("Error for n^2+n+1/4 with n=2405743843\n");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 66);
mpfr_set_str_binary (x, "101000001010001101100101010101001000110000110101110111000101100011E-3");
mpfr_set_prec (y, 32);
test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 2405743844UL))
{
printf ("Error for n^2+n+1/4+1/8 with n=2405743843\n");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 66);
mpfr_set_str_binary (x, "101000001010001101100101010101001000110000110101110111000101100001E-3");
mpfr_set_prec (y, 32);
test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 2405743843UL))
{
printf ("Error for n^2+n+1/8 with n=2405743843\n");
mpfr_dump (y);
exit (1);
}
mpfr_set_prec (x, 27);
mpfr_set_str_binary (x, "0.110100111010101000010001011");
if ((inexact = test_sqrt (x, x, MPFR_RNDZ)) >= 0)
{
printf ("Wrong inexact flag: expected -1, got %d\n", inexact);
exit (1);
}
mpfr_set_prec (x, 2);
for (p=2; p<1000; p++)
{
mpfr_set_prec (z, p);
mpfr_set_ui (z, 1, MPFR_RNDN);
mpfr_nexttoinf (z);
test_sqrt (x, z, MPFR_RNDU);
if (mpfr_cmp_ui_2exp(x, 3, -1))
{
printf ("Error: sqrt(1+ulp(1), up) should give 1.5 (prec=%u)\n",
(unsigned int) p);
printf ("got "); mpfr_print_binary (x); puts ("");
exit (1);
}
}
/* check inexact flag */
mpfr_set_prec (x, 5);
mpfr_set_str_binary (x, "1.1001E-2");
if ((inexact = test_sqrt (x, x, MPFR_RNDN)))
{
printf ("Wrong inexact flag: expected 0, got %d\n", inexact);
exit (1);
}
mpfr_set_prec (x, 2);
mpfr_set_prec (z, 2);
/* checks the sign is correctly set */
mpfr_set_si (x, 1, MPFR_RNDN);
mpfr_set_si (z, -1, MPFR_RNDN);
test_sqrt (z, x, MPFR_RNDN);
if (mpfr_cmp_ui (z, 0) < 0)
{
printf ("Error: square root of 1 gives ");
mpfr_print_binary(z);
putchar('\n');
exit (1);
}
mpfr_set_prec (x, 192);
mpfr_set_prec (z, 160);
mpfr_set_str_binary (z, "0.1011010100000100100100100110011001011100100100000011000111011001011101101101110000110100001000100001100001011000E1");
mpfr_set_prec (x, 160);
test_sqrt(x, z, MPFR_RNDN);
test_sqrt(z, x, MPFR_RNDN);
mpfr_set_prec (x, 53);
mpfr_set_str (x, "8093416094703476.0", 10, MPFR_RNDN);
mpfr_div_2exp (x, x, 1075, MPFR_RNDN);
test_sqrt (x, x, MPFR_RNDN);
mpfr_set_str (z, "1e55596835b5ef@-141", 16, MPFR_RNDN);
if (mpfr_cmp (x, z))
{
printf ("Error: square root of 8093416094703476*2^(-1075)\n");
printf ("expected "); mpfr_dump (z);
printf ("got "); mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_str_binary (x, "0.111011011011110001100111111001000e-10");
mpfr_set_prec (z, 157);
inexact = test_sqrt (z, x, MPFR_RNDN);
mpfr_set_prec (x, 157);
mpfr_set_str_binary (x, "0.11110110101100101111001011100011100011100001101010111011010000100111011000111110100001001011110011111100101110010110010110011001011011010110010000011001101E-5");
if (mpfr_cmp (x, z))
{
printf ("Error: square root (1)\n");
exit (1);
}
if (inexact <= 0)
{
printf ("Error: wrong inexact flag (1)\n");
exit (1);
}
/* case prec(result) << prec(input) */
mpfr_set_prec (z, 2);
for (p = 2; p < 1000; p++)
{
mpfr_set_prec (x, p);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_nextabove (x);
/* 1.0 < x <= 1.5 thus 1 < sqrt(x) <= 1.23 */
inexact = test_sqrt (z, x, MPFR_RNDN);
MPFR_ASSERTN(inexact < 0 && mpfr_cmp_ui (z, 1) == 0);
inexact = test_sqrt (z, x, MPFR_RNDZ);
MPFR_ASSERTN(inexact < 0 && mpfr_cmp_ui (z, 1) == 0);
inexact = test_sqrt (z, x, MPFR_RNDU);
MPFR_ASSERTN(inexact > 0 && mpfr_cmp_ui_2exp (z, 3, -1) == 0);
inexact = test_sqrt (z, x, MPFR_RNDD);
MPFR_ASSERTN(inexact < 0 && mpfr_cmp_ui (z, 1) == 0);
inexact = test_sqrt (z, x, MPFR_RNDA);
MPFR_ASSERTN(inexact > 0 && mpfr_cmp_ui_2exp (z, 3, -1) == 0);
}
/* corner case rw = 0 in rounding to nearest */
mpfr_set_prec (z, GMP_NUMB_BITS - 1);
mpfr_set_prec (y, GMP_NUMB_BITS - 1);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_mul_2exp (y, y, GMP_NUMB_BITS - 1, MPFR_RNDN);
mpfr_nextabove (y);
for (p = 2 * GMP_NUMB_BITS - 1; p <= 1000; p++)
{
mpfr_set_prec (x, p);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_set_exp (x, GMP_NUMB_BITS);
mpfr_add_ui (x, x, 1, MPFR_RNDN);
/* now x = 2^(GMP_NUMB_BITS - 1) + 1 (GMP_NUMB_BITS bits) */
inexact = mpfr_mul (x, x, x, MPFR_RNDN);
MPFR_ASSERTN (inexact == 0); /* exact */
inexact = test_sqrt (z, x, MPFR_RNDN);
/* even rule: z should be 2^(GMP_NUMB_BITS - 1) */
MPFR_ASSERTN (inexact < 0);
inexact = mpfr_cmp_ui_2exp (z, 1, GMP_NUMB_BITS - 1);
MPFR_ASSERTN (inexact == 0);
mpfr_nextbelow (x);
/* now x is just below [2^(GMP_NUMB_BITS - 1) + 1]^2 */
inexact = test_sqrt (z, x, MPFR_RNDN);
MPFR_ASSERTN(inexact < 0 &&
mpfr_cmp_ui_2exp (z, 1, GMP_NUMB_BITS - 1) == 0);
mpfr_nextabove (x);
mpfr_nextabove (x);
/* now x is just above [2^(GMP_NUMB_BITS - 1) + 1]^2 */
inexact = test_sqrt (z, x, MPFR_RNDN);
if (mpfr_cmp (z, y))
{
printf ("Error for sqrt(x) in rounding to nearest\n");
printf ("x="); mpfr_dump (x);
printf ("Expected "); mpfr_dump (y);
printf ("Got "); mpfr_dump (z);
exit (1);
}
if (inexact <= 0)
{
printf ("Wrong inexact flag in corner case for p = %lu\n", (unsigned long) p);
exit (1);
}
}
mpfr_set_prec (x, 1000);
mpfr_set_ui (x, 9, MPFR_RNDN);
mpfr_set_prec (y, 10);
inexact = test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 3) || inexact != 0)
{
printf ("Error in sqrt(9:1000) for prec=10\n");
exit (1);
}
mpfr_set_prec (y, GMP_NUMB_BITS);
mpfr_nextabove (x);
inexact = test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 3) || inexact >= 0)
{
printf ("Error in sqrt(9:1000) for prec=%d\n", (int) GMP_NUMB_BITS);
exit (1);
}
mpfr_set_prec (x, 2 * GMP_NUMB_BITS);
mpfr_set_prec (y, GMP_NUMB_BITS);
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_nextabove (y);
mpfr_set (x, y, MPFR_RNDN);
inexact = test_sqrt (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1) || inexact >= 0)
{
printf ("Error in sqrt(1) for prec=%d\n", (int) GMP_NUMB_BITS);
mpfr_dump (y);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
}
int
mpfi_blow (mpfi_ptr y, mpfi_srcptr x, double fact)
/* if c = mid (x) and r = rad (x), y = [c - (1+fact)*r , c + (1+fact)*r] */
{
mp_prec_t prec;
mpfr_t radius, factor;
mpfr_t centre;
int inex_diam, inex_div, inex_conv, inex_factor, inex_rad;
int inex_centre, inex_left, inex_right;
int inexact = 0;
if (MPFI_NAN_P (x)) {
mpfr_set_nan (&(y->left));
mpfr_set_nan (&(y->right));
MPFR_RET_NAN;
}
prec = mpfi_get_prec (x);
mpfr_init2 (radius, prec);
mpfr_init2 (factor, prec);
mpfr_init2 (centre, prec);
inex_diam = mpfi_diam_abs (radius, x);
if (mpfr_zero_p (radius)) {
/* x is a singleton */
return mpfi_set (y, x);
}
inex_div = mpfr_div_2exp (radius, radius, 1, MPFI_RNDU); /* either underflow
or exact*/
/* factor must be greater than 1 + |fact|, so it is not possible to perform
this addition directly in C with the double precision since the usual
rouding mode is rounding to nearest. */
inex_conv = mpfr_set_d (factor, fact < 0.0 ? -fact : fact, MPFI_RNDU);
inex_factor = mpfr_add_ui (factor, factor, 1, MPFI_RNDU);
inex_rad = mpfr_mul (radius, radius, factor, MPFI_RNDU);
inex_centre = mpfi_mid (centre, x);
inex_left = mpfr_sub (&(y->left), centre, radius, MPFI_RNDD);
inex_right = mpfr_add (&(y->right), centre, radius, MPFI_RNDU);
mpfr_clear (radius);
mpfr_clear (factor);
mpfr_clear (centre);
if ( MPFI_NAN_P (y) )
MPFR_RET_NAN;
/* do not allow -0 as lower bound */
if (mpfr_zero_p (&(y->left)) && mpfr_signbit (&(y->left))) {
mpfr_neg (&(y->left), &(y->left), MPFI_RNDU);
}
/* do not allow +0 as upper bound */
if (mpfr_zero_p (&(y->right)) && !mpfr_signbit (&(y->right))) {
mpfr_neg (&(y->right), &(y->right), MPFI_RNDD);
}
if (inex_diam || inex_div || inex_conv || inex_factor || inex_rad
|| inex_centre || inex_left)
inexact += 1;
if (inex_diam || inex_div || inex_conv || inex_factor || inex_rad
|| inex_centre || inex_right)
inexact += 2;
return inexact;
}
MpfrFloat& MpfrFloat::operator*=(const MpfrFloat& rhs)
{
copyIfShared();
mpfr_mul(mData->mFloat, mData->mFloat, rhs.mData->mFloat, GMP_RNDN);
return *this;
}
MpfrFloat MpfrFloat::operator*(const MpfrFloat& rhs) const
{
MpfrFloat retval(kNoInitialization);
mpfr_mul(retval.mData->mFloat, mData->mFloat, rhs.mData->mFloat, GMP_RNDN);
return retval;
}
int
mpfr_zeta (mpfr_t z, mpfr_srcptr s, mp_rnd_t rnd_mode)
{
mpfr_t z_pre, s1, y, p;
double sd, eps, m1, c;
long add;
mp_prec_t precz, prec1, precs, precs1;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (("s[%#R]=%R rnd=%d", s, s, rnd_mode),
("z[%#R]=%R inexact=%d", z, z, inex));
/* Zero, Nan or Inf ? */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s)))
{
if (MPFR_IS_NAN (s))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (s))
{
if (MPFR_IS_POS (s))
return mpfr_set_ui (z, 1, GMP_RNDN); /* Zeta(+Inf) = 1 */
MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */
MPFR_RET_NAN;
}
else /* s iz zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (s));
mpfr_set_ui (z, 1, rnd_mode);
mpfr_div_2ui (z, z, 1, rnd_mode);
MPFR_CHANGE_SIGN (z);
MPFR_RET (0);
}
}
/* s is neither Nan, nor Inf, nor Zero */
/* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0,
and for |s| <= 0.074, we have |zeta(s) + 1/2| <= |s|.
Thus if |s| <= 1/4*ulp(1/2), we can deduce the correct rounding
(the 1/4 covers the case where |zeta(s)| < 1/2 and rounding to nearest).
A sufficient condition is that EXP(s) + 1 < -PREC(z). */
if (MPFR_EXP(s) + 1 < - (mp_exp_t) MPFR_PREC(z))
{
int signs = MPFR_SIGN(s);
mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */
if ((rnd_mode == GMP_RNDU || rnd_mode == GMP_RNDZ) && signs < 0)
{
mpfr_nextabove (z); /* z = -1/2 + epsilon */
inex = 1;
}
else if (rnd_mode == GMP_RNDD && signs > 0)
{
mpfr_nextbelow (z); /* z = -1/2 - epsilon */
inex = -1;
}
else
{
if (rnd_mode == GMP_RNDU) /* s > 0: z = -1/2 */
inex = 1;
else if (rnd_mode == GMP_RNDD)
inex = -1; /* s < 0: z = -1/2 */
else /* (GMP_RNDZ and s > 0) or GMP_RNDN: z = -1/2 */
inex = (signs > 0) ? 1 : -1;
}
return mpfr_check_range (z, inex, rnd_mode);
}
/* Check for case s= -2n */
if (MPFR_IS_NEG (s))
{
mpfr_t tmp;
tmp[0] = *s;
MPFR_EXP (tmp) = MPFR_EXP (s) - 1;
if (mpfr_integer_p (tmp))
{
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute Zeta */
if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */
inex = mpfr_zeta_pos (z, s, rnd_mode);
else /* use reflection formula
zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */
{
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Precision precs1 needed to represent 1 - s, and s + 2,
without any truncation */
precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s));
sd = mpfr_get_d (s, GMP_RNDN) - 1.0;
if (sd < 0.0)
sd = -sd; /* now sd = abs(s-1.0) */
/* Precision prec1 is the precision on elementary computations;
it ensures a final precision prec1 - add for zeta(s) */
/* eps = pow (2.0, - (double) precz - 14.0); */
eps = __gmpfr_ceil_exp2 (- (double) precz - 14.0);
m1 = 1.0 + MAX(1.0 / eps, 2.0 * sd) * (1.0 + eps);
c = (1.0 + eps) * (1.0 + eps * MAX(8.0, m1));
/* add = 1 + floor(log(c*c*c*(13 + m1))/log(2)); */
add = __gmpfr_ceil_log2 (c * c * c * (13.0 + m1));
prec1 = precz + add;
prec1 = MAX (prec1, precs1) + 10;
MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p);
MPFR_ZIV_INIT (loop, prec1);
for (;;)
{
mpfr_sub (s1, __gmpfr_one, s, GMP_RNDN);/* s1 = 1-s */
mpfr_zeta_pos (z_pre, s1, GMP_RNDN); /* zeta(1-s) */
mpfr_gamma (y, s1, GMP_RNDN); /* gamma(1-s) */
if (MPFR_IS_INF (y)) /* Zeta(s) < 0 for -4k-2 < s < -4k,
Zeta(s) > 0 for -4k < s < -4k+2 */
{
MPFR_SET_INF (z_pre);
mpfr_div_2ui (s1, s, 2, GMP_RNDN); /* s/4, exact */
mpfr_frac (s1, s1, GMP_RNDN); /* exact, -1 < s1 < 0 */
if (mpfr_cmp_si_2exp (s1, -1, -1) > 0)
MPFR_SET_NEG (z_pre);
else
MPFR_SET_POS (z_pre);
break;
}
mpfr_mul (z_pre, z_pre, y, GMP_RNDN); /* gamma(1-s)*zeta(1-s) */
mpfr_const_pi (p, GMP_RNDD);
mpfr_mul (y, s, p, GMP_RNDN);
mpfr_div_2ui (y, y, 1, GMP_RNDN); /* s*Pi/2 */
mpfr_sin (y, y, GMP_RNDN); /* sin(Pi*s/2) */
mpfr_mul (z_pre, z_pre, y, GMP_RNDN);
mpfr_mul_2ui (y, p, 1, GMP_RNDN); /* 2*Pi */
mpfr_neg (s1, s1, GMP_RNDN); /* s-1 */
mpfr_pow (y, y, s1, GMP_RNDN); /* (2*Pi)^(s-1) */
mpfr_mul (z_pre, z_pre, y, GMP_RNDN);
mpfr_mul_2ui (z_pre, z_pre, 1, GMP_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz,
rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec1);
MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inex, rnd_mode);
}
int main(int argc, char **argv) {
mpfr_t tmp1;
mpfr_t tmp2;
mpfr_t tmp3;
mpfr_t s1;
mpfr_t s2;
mpfr_t r;
mpfr_t a1;
mpfr_t a2;
time_t start_time;
time_t end_time;
// Parse command line opts
int hide_pi = 0;
if(argc == 2) {
if(strcmp(argv[1], "--hide-pi") == 0) {
hide_pi = 1;
} else if((precision = atoi(argv[1])) == 0) {
fprintf(stderr, "Invalid precision specified. Aborting.\n");
return 1;
}
} else if(argc == 3) {
if(strcmp(argv[1], "--hide-pi") == 0) {
hide_pi = 1;
}
if((precision = atoi(argv[2])) == 0) {
fprintf(stderr, "Invalid precision specified. Aborting.\n");
return 1;
}
}
// If the precision was not specified, default it
if(precision == 0) {
precision = DEFAULT_PRECISION;
}
// Actual number of correct digits is roughly 3.35 times the requested precision
precision *= 3.35;
mpfr_set_default_prec(precision);
mpfr_inits(tmp1, tmp2, tmp3, s1, s2, r, a1, a2, NULL);
start_time = time(NULL);
// a0 = 1/3
mpfr_set_ui(a1, 1, MPFR_RNDN);
mpfr_div_ui(a1, a1, 3, MPFR_RNDN);
// s0 = (3^.5 - 1) / 2
mpfr_sqrt_ui(s1, 3, MPFR_RNDN);
mpfr_sub_ui(s1, s1, 1, MPFR_RNDN);
mpfr_div_ui(s1, s1, 2, MPFR_RNDN);
unsigned long i = 0;
while(i < MAX_ITERS) {
// r = 3 / (1 + 2(1-s^3)^(1/3))
mpfr_pow_ui(tmp1, s1, 3, MPFR_RNDN);
mpfr_ui_sub(r, 1, tmp1, MPFR_RNDN);
mpfr_root(r, r, 3, MPFR_RNDN);
mpfr_mul_ui(r, r, 2, MPFR_RNDN);
mpfr_add_ui(r, r, 1, MPFR_RNDN);
mpfr_ui_div(r, 3, r, MPFR_RNDN);
// s = (r - 1) / 2
mpfr_sub_ui(s2, r, 1, MPFR_RNDN);
mpfr_div_ui(s2, s2, 2, MPFR_RNDN);
// a = r^2 * a - 3^i(r^2-1)
mpfr_pow_ui(tmp1, r, 2, MPFR_RNDN);
mpfr_mul(a2, tmp1, a1, MPFR_RNDN);
mpfr_sub_ui(tmp1, tmp1, 1, MPFR_RNDN);
mpfr_ui_pow_ui(tmp2, 3UL, i, MPFR_RNDN);
mpfr_mul(tmp1, tmp1, tmp2, MPFR_RNDN);
mpfr_sub(a2, a2, tmp1, MPFR_RNDN);
// s1 = s2
mpfr_set(s1, s2, MPFR_RNDN);
// a1 = a2
mpfr_set(a1, a2, MPFR_RNDN);
i++;
}
// pi = 1/a
mpfr_ui_div(a2, 1, a2, MPFR_RNDN);
end_time = time(NULL);
mpfr_clears(tmp1, tmp2, tmp3, s1, s2, r, a1, NULL);
// Write the digits to a string for accuracy comparison
char *pi = malloc(precision + 100);
if(pi == NULL) {
fprintf(stderr, "Failed to allocated memory for output string.\n");
return 1;
}
mpfr_sprintf(pi, "%.*R*f", precision, MPFR_RNDN, a2);
// Check out accurate we are
unsigned long accuracy = check_digits(pi);
// Print the results (only print the digits that are accurate)
if(!hide_pi) {
// Plus two for the "3." at the beginning
for(unsigned long i=0; i<(unsigned long)(precision/3.35)+2; i++) {
printf("%c", pi[i]);
}
printf("\n");
} // Send the time and accuracy to stderr so pi can be redirected to a file if necessary
fprintf(stderr, "Time: %d seconds\nAccuracy: %lu digits\n", (int)(end_time - start_time), accuracy);
mpfr_clear(a2);
free(pi);
pi = NULL;
return 0;
}
/* The computation of z = pow(x,y) is done by
z = exp(y * log(x)) = x^y
For the special cases, see Section F.9.4.4 of the C standard:
_ pow(±0, y) = ±inf for y an odd integer < 0.
_ pow(±0, y) = +inf for y < 0 and not an odd integer.
_ pow(±0, y) = ±0 for y an odd integer > 0.
_ pow(±0, y) = +0 for y > 0 and not an odd integer.
_ pow(-1, ±inf) = 1.
_ pow(+1, y) = 1 for any y, even a NaN.
_ pow(x, ±0) = 1 for any x, even a NaN.
_ pow(x, y) = NaN for finite x < 0 and finite non-integer y.
_ pow(x, -inf) = +inf for |x| < 1.
_ pow(x, -inf) = +0 for |x| > 1.
_ pow(x, +inf) = +0 for |x| < 1.
_ pow(x, +inf) = +inf for |x| > 1.
_ pow(-inf, y) = -0 for y an odd integer < 0.
_ pow(-inf, y) = +0 for y < 0 and not an odd integer.
_ pow(-inf, y) = -inf for y an odd integer > 0.
_ pow(-inf, y) = +inf for y > 0 and not an odd integer.
_ pow(+inf, y) = +0 for y < 0.
_ pow(+inf, y) = +inf for y > 0. */
int
mpfr_pow (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode)
{
int inexact;
int cmp_x_1;
int y_is_integer;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x,
mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (z), mpfr_log_prec, z, inexact));
if (MPFR_ARE_SINGULAR (x, y))
{
/* pow(x, 0) returns 1 for any x, even a NaN. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (y)))
return mpfr_set_ui (z, 1, rnd_mode);
else if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_NAN (y))
{
/* pow(+1, NaN) returns 1. */
if (mpfr_cmp_ui (x, 1) == 0)
return mpfr_set_ui (z, 1, rnd_mode);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (y))
{
if (MPFR_IS_INF (x))
{
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int cmp;
cmp = mpfr_cmpabs (x, __gmpfr_one) * MPFR_INT_SIGN (y);
MPFR_SET_POS (z);
if (cmp > 0)
{
/* Return +inf. */
MPFR_SET_INF (z);
MPFR_RET (0);
}
else if (cmp < 0)
{
/* Return +0. */
MPFR_SET_ZERO (z);
MPFR_RET (0);
}
else
{
/* Return 1. */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
}
else if (MPFR_IS_INF (x))
{
int negative;
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG (x) && is_odd (y);
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int negative;
MPFR_ASSERTD (MPFR_IS_ZERO (x));
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG(x) && is_odd (y);
if (MPFR_IS_NEG (y))
{
MPFR_ASSERTD (! MPFR_IS_INF (y));
MPFR_SET_INF (z);
mpfr_set_divby0 ();
}
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* x^y for x < 0 and y not an integer is not defined */
y_is_integer = mpfr_integer_p (y);
if (MPFR_IS_NEG (x) && ! y_is_integer)
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
/* now the result cannot be NaN:
(1) either x > 0
(2) or x < 0 and y is an integer */
cmp_x_1 = mpfr_cmpabs (x, __gmpfr_one);
if (cmp_x_1 == 0)
return mpfr_set_si (z, MPFR_IS_NEG (x) && is_odd (y) ? -1 : 1, rnd_mode);
/* now we have:
(1) either x > 0
(2) or x < 0 and y is an integer
and in addition |x| <> 1.
*/
/* detect overflow: an overflow is possible if
(a) |x| > 1 and y > 0
(b) |x| < 1 and y < 0.
FIXME: this assumes 1 is always representable.
FIXME2: maybe we can test overflow and underflow simultaneously.
The idea is the following: first compute an approximation to
y * log2|x|, using rounding to nearest. If |x| is not too near from 1,
this approximation should be accurate enough, and in most cases enable
one to prove that there is no underflow nor overflow.
Otherwise, it should enable one to check only underflow or overflow,
instead of both cases as in the present case.
*/
if (cmp_x_1 * MPFR_SIGN (y) > 0)
{
mpfr_t t;
int negative, overflow;
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (t, 53);
/* we want a lower bound on y*log2|x|:
(i) if x > 0, it suffices to round log2(x) toward zero, and
to round y*o(log2(x)) toward zero too;
(ii) if x < 0, we first compute t = o(-x), with rounding toward 1,
and then follow as in case (1). */
if (MPFR_SIGN (x) > 0)
mpfr_log2 (t, x, MPFR_RNDZ);
else
{
mpfr_neg (t, x, (cmp_x_1 > 0) ? MPFR_RNDZ : MPFR_RNDU);
mpfr_log2 (t, t, MPFR_RNDZ);
}
mpfr_mul (t, t, y, MPFR_RNDZ);
overflow = mpfr_cmp_si (t, __gmpfr_emax) > 0;
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
if (overflow)
{
MPFR_LOG_MSG (("early overflow detection\n", 0));
negative = MPFR_SIGN(x) < 0 && is_odd (y);
return mpfr_overflow (z, rnd_mode, negative ? -1 : 1);
}
}
/* Basic underflow checking. One has:
* - if y > 0, |x^y| < 2^(EXP(x) * y);
* - if y < 0, |x^y| <= 2^((EXP(x) - 1) * y);
* so that one can compute a value ebound such that |x^y| < 2^ebound.
* If we have ebound <= emin - 2 (emin - 1 in directed rounding modes),
* then there is an underflow and we can decide the return value.
*/
if (MPFR_IS_NEG (y) ? (MPFR_GET_EXP (x) > 1) : (MPFR_GET_EXP (x) < 0))
{
mpfr_t tmp;
mpfr_eexp_t ebound;
int inex2;
/* We must restore the flags. */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, sizeof (mpfr_exp_t) * CHAR_BIT);
inex2 = mpfr_set_exp_t (tmp, MPFR_GET_EXP (x), MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
if (MPFR_IS_NEG (y))
{
inex2 = mpfr_sub_ui (tmp, tmp, 1, MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
}
mpfr_mul (tmp, tmp, y, MPFR_RNDU);
if (MPFR_IS_NEG (y))
mpfr_nextabove (tmp);
/* tmp doesn't necessarily fit in ebound, but that doesn't matter
since we get the minimum value in such a case. */
ebound = mpfr_get_exp_t (tmp, MPFR_RNDU);
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
if (MPFR_UNLIKELY (ebound <=
__gmpfr_emin - (rnd_mode == MPFR_RNDN ? 2 : 1)))
{
/* warning: mpfr_underflow rounds away from 0 for MPFR_RNDN */
MPFR_LOG_MSG (("early underflow detection\n", 0));
return mpfr_underflow (z,
rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
MPFR_SIGN (x) < 0 && is_odd (y) ? -1 : 1);
}
}
/* If y is an integer, we can use mpfr_pow_z (based on multiplications),
but if y is very large (I'm not sure about the best threshold -- VL),
we shouldn't use it, as it can be very slow and take a lot of memory
(and even crash or make other programs crash, as several hundred of
MBs may be necessary). Note that in such a case, either x = +/-2^b
(this case is handled below) or x^y cannot be represented exactly in
any precision supported by MPFR (the general case uses this property).
*/
if (y_is_integer && (MPFR_GET_EXP (y) <= 256))
{
mpz_t zi;
MPFR_LOG_MSG (("special code for y not too large integer\n", 0));
mpz_init (zi);
mpfr_get_z (zi, y, MPFR_RNDN);
inexact = mpfr_pow_z (z, x, zi, rnd_mode);
mpz_clear (zi);
return inexact;
}
/* Special case (+/-2^b)^Y which could be exact. If x is negative, then
necessarily y is a large integer. */
{
mpfr_exp_t b = MPFR_GET_EXP (x) - 1;
MPFR_ASSERTN (b >= LONG_MIN && b <= LONG_MAX); /* FIXME... */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), b) == 0)
{
mpfr_t tmp;
int sgnx = MPFR_SIGN (x);
MPFR_LOG_MSG (("special case (+/-2^b)^Y\n", 0));
/* now x = +/-2^b, so x^y = (+/-1)^y*2^(b*y) is exact whenever b*y is
an integer */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_PREC (y) + sizeof (long) * CHAR_BIT);
inexact = mpfr_mul_si (tmp, y, b, MPFR_RNDN); /* exact */
MPFR_ASSERTN (inexact == 0);
/* Note: as the exponent range has been extended, an overflow is not
possible (due to basic overflow and underflow checking above, as
the result is ~ 2^tmp), and an underflow is not possible either
because b is an integer (thus either 0 or >= 1). */
MPFR_CLEAR_FLAGS ();
inexact = mpfr_exp2 (z, tmp, rnd_mode);
mpfr_clear (tmp);
if (sgnx < 0 && is_odd (y))
{
mpfr_neg (z, z, rnd_mode);
inexact = -inexact;
}
/* Without the following, the overflows3 test in tpow.c fails. */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Case where |y * log(x)| is very small. Warning: x can be negative, in
that case y is a large integer. */
{
mpfr_t t;
mpfr_exp_t err;
/* We need an upper bound on the exponent of y * log(x). */
mpfr_init2 (t, 16);
if (MPFR_IS_POS(x))
mpfr_log (t, x, cmp_x_1 < 0 ? MPFR_RNDD : MPFR_RNDU); /* away from 0 */
else
{
/* if x < -1, round to +Inf, else round to zero */
mpfr_neg (t, x, (mpfr_cmp_si (x, -1) < 0) ? MPFR_RNDU : MPFR_RNDD);
mpfr_log (t, t, (mpfr_cmp_ui (t, 1) < 0) ? MPFR_RNDD : MPFR_RNDU);
}
MPFR_ASSERTN (MPFR_IS_PURE_FP (t));
err = MPFR_GET_EXP (y) + MPFR_GET_EXP (t);
mpfr_clear (t);
MPFR_CLEAR_FLAGS ();
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (z, __gmpfr_one, - err, 0,
(MPFR_SIGN (y) > 0) ^ (cmp_x_1 < 0),
rnd_mode, expo, {});
}
/* General case */
inexact = mpfr_pow_general (z, x, y, rnd_mode, y_is_integer, &expo);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
static void
check_hard (void)
{
mpfr_t u, v, q, q2;
mp_prec_t precu, precv, precq;
int rnd;
int inex, inex2, i, j;
mpfr_init (q);
mpfr_init (q2);
mpfr_init (u);
mpfr_init (v);
for (precq = MPFR_PREC_MIN; precq <= 64; precq ++)
{
mpfr_set_prec (q, precq);
mpfr_set_prec (q2, precq + 1);
for (j = 0; j < 2; j++)
{
if (j == 0)
{
do
{
mpfr_random (q2);
}
while (mpfr_cmp_ui (q2, 0) == 0);
}
else /* use q2=1 */
mpfr_set_ui (q2, 1, GMP_RNDN);
for (precv = precq; precv <= 10 * precq; precv += precq)
{
mpfr_set_prec (v, precv);
do
{
mpfr_random (v);
}
while (mpfr_cmp_ui (v, 0) == 0);
for (precu = precq; precu <= 10 * precq; precu += precq)
{
mpfr_set_prec (u, precu);
mpfr_mul (u, v, q2, GMP_RNDN);
mpfr_nextbelow (u);
for (i = 0; i <= 2; i++)
{
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
inex = test_div (q, u, v, (mp_rnd_t) rnd);
inex2 = get_inexact (q, u, v);
if (inex_cmp (inex, inex2))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d\n",
mpfr_print_rnd_mode ((mp_rnd_t) rnd), inex2, inex);
printf ("u= "); mpfr_dump (u);
printf ("v= "); mpfr_dump (v);
printf ("q= "); mpfr_dump (q);
mpfr_set_prec (q2, precq + precv);
mpfr_mul (q2, q, v, GMP_RNDN);
printf ("q*v="); mpfr_dump (q2);
exit (1);
}
}
mpfr_nextabove (u);
}
}
}
}
}
mpfr_clear (q);
mpfr_clear (q2);
mpfr_clear (u);
mpfr_clear (v);
}
void FixComplexKCM::emulate(TestCase * tc) {
/* first we are going to format the entries */
mpz_class reIn = tc->getInputValue("ReIN");
mpz_class imIn = tc->getInputValue("ImIN");
/* Sign handling */
// Msb index counting from one
bool reInNeg = (
signedInput &&
(mpz_tstbit(reIn.get_mpz_t(), input_width - 1) == 1)
);
bool imInNeg = (
signedInput &&
(mpz_tstbit(imIn.get_mpz_t(), input_width - 1) == 1)
);
// 2's complement -> absolute value unsigned representation
if(reInNeg)
{
reIn = (mpz_class(1) << input_width) - reIn;
}
if(imInNeg)
{
imIn = (mpz_class(1) << input_width) - imIn;
}
//Cast to mp floating point number
mpfr_t reIn_mpfr, imIn_mpfr;
mpfr_init2(reIn_mpfr, input_width + 1);
mpfr_init2(imIn_mpfr, input_width + 1);
//Exact
mpfr_set_z(reIn_mpfr, reIn.get_mpz_t(), GMP_RNDN);
mpfr_set_z(imIn_mpfr, imIn.get_mpz_t(), GMP_RNDN);
//Scaling : Exact
mpfr_mul_2si(reIn_mpfr, reIn_mpfr, lsb_in, GMP_RNDN);
mpfr_mul_2si(imIn_mpfr, imIn_mpfr, lsb_in, GMP_RNDN);
mpfr_t re_prod, im_prod, crexim_prod, xrecim_prod;
mpfr_t reOut, imOut;
mpfr_inits2(
2 * input_width + 1,
re_prod,
im_prod,
crexim_prod,
xrecim_prod,
NULL
);
mpfr_inits2(5 * max(outputim_width, outputre_width) + 1, reOut, imOut, NULL);
// c_r * x_r -> re_prod
mpfr_mul(re_prod, reIn_mpfr, mpfr_constant_re, GMP_RNDN);
// c_i * x_i -> im_prod
mpfr_mul(im_prod, imIn_mpfr, mpfr_constant_im, GMP_RNDN);
// c_r * x_i -> crexim_prod
mpfr_mul(crexim_prod, mpfr_constant_re, imIn_mpfr, GMP_RNDN);
// x_r * c_im -> xrecim_prod
mpfr_mul(xrecim_prod, reIn_mpfr, mpfr_constant_im, GMP_RNDN);
/* Input sign correction */
if(reInNeg)
{
//Exact
mpfr_neg(re_prod, re_prod, GMP_RNDN);
mpfr_neg(xrecim_prod, xrecim_prod, GMP_RNDN);
}
if(imInNeg)
{
//Exact
mpfr_neg(im_prod, im_prod, GMP_RNDN);
mpfr_neg(crexim_prod, crexim_prod, GMP_RNDN);
}
mpfr_sub(reOut, re_prod, im_prod, GMP_RNDN);
mpfr_add(imOut, crexim_prod, xrecim_prod, GMP_RNDN);
bool reOutNeg = (mpfr_sgn(reOut) < 0);
bool imOutNeg = (mpfr_sgn(imOut) < 0);
if(reOutNeg)
{
//Exact
mpfr_abs(reOut, reOut, GMP_RNDN);
}
if(imOutNeg)
{
//Exact
mpfr_abs(imOut, imOut, GMP_RNDN);
}
//Scale back (Exact)
mpfr_mul_2si(reOut, reOut, -lsb_out, GMP_RNDN);
mpfr_mul_2si(imOut, imOut, -lsb_out, GMP_RNDN);
//Get bits vector
mpz_class reUp, reDown, imUp, imDown, carry;
mpfr_get_z(reUp.get_mpz_t(), reOut, GMP_RNDU);
mpfr_get_z(reDown.get_mpz_t(), reOut, GMP_RNDD);
mpfr_get_z(imDown.get_mpz_t(), imOut, GMP_RNDD);
mpfr_get_z(imUp.get_mpz_t(), imOut, GMP_RNDU);
carry = 0;
//If result was negative, compute 2's complement
if(reOutNeg)
{
reUp = (mpz_class(1) << outputre_width) - reUp;
reDown = (mpz_class(1) << outputre_width) - reDown;
}
if(imOutNeg)
{
imUp = (mpz_class(1) << outputim_width) - imUp;
imDown = (mpz_class(1) << outputim_width) - imDown;
}
//Handle border cases
if(imUp > (mpz_class(1) << outputim_width) - 1 )
{
imUp = 0;
}
if(reUp > (mpz_class(1) << outputre_width) - 1)
{
reUp = 0;
}
if(imDown > (mpz_class(1) << outputim_width) - 1 )
{
imDown = 0;
}
if(reDown > (mpz_class(1) << outputre_width) - 1)
{
reDown = 0;
}
//Add expected results to corresponding outputs
tc->addExpectedOutput("ReOut", reUp);
tc->addExpectedOutput("ReOut", reDown);
tc->addExpectedOutput("ImOut", imUp);
tc->addExpectedOutput("ImOut", imDown);
mpfr_clears(
reOut,
imOut,
re_prod,
im_prod,
crexim_prod,
xrecim_prod,
reIn_mpfr,
imIn_mpfr,
NULL
);
}
static void
check_lowr (void)
{
mpfr_t x, y, z, z2, z3, tmp;
int k, c, c2;
mpfr_init2 (x, 1000);
mpfr_init2 (y, 100);
mpfr_init2 (tmp, 850);
mpfr_init2 (z, 10);
mpfr_init2 (z2, 10);
mpfr_init2 (z3, 50);
for (k = 1; k < KMAX; k++)
{
do
{
mpfr_random (z);
}
while (mpfr_cmp_ui (z, 0) == 0);
do
{
mpfr_random (tmp);
}
while (mpfr_cmp_ui (tmp, 0) == 0);
mpfr_mul (x, z, tmp, GMP_RNDN); /* exact */
c = test_div (z2, x, tmp, GMP_RNDN);
if (c || mpfr_cmp (z2, z))
{
printf ("Error in mpfr_div rnd=GMP_RNDN\n");
printf ("got "); mpfr_print_binary(z2); puts ("");
printf ("instead of "); mpfr_print_binary(z); puts ("");
printf ("inex flag = %d, expected 0\n", c);
exit (1);
}
}
/* x has still precision 1000, z precision 10, and tmp prec 850 */
mpfr_set_prec (z2, 9);
for (k = 1; k < KMAX; k++)
{
mpfr_random (z);
do
{
mpfr_random (tmp);
}
while (mpfr_cmp_ui (tmp, 0) == 0);
mpfr_mul (x, z, tmp, GMP_RNDN); /* exact */
c = test_div (z2, x, tmp, GMP_RNDN);
/* since z2 has one less bit that z, either the division is exact
if z is representable on 9 bits, or we have an even round case */
c2 = get_inexact (z2, x, tmp);
if ((mpfr_cmp (z2, z) == 0 && c) || inex_cmp (c, c2))
{
printf ("Error in mpfr_div rnd=GMP_RNDN\n");
printf ("got "); mpfr_print_binary(z2); puts ("");
printf ("instead of "); mpfr_print_binary(z); puts ("");
printf ("inex flag = %d, expected %d\n", c, c2);
exit (1);
}
else if (c == 2)
{
mpfr_nexttoinf (z);
if (mpfr_cmp(z2, z))
{
printf ("Error in mpfr_div [even rnd?] rnd=GMP_RNDN\n");
printf ("Dividing ");
printf ("got "); mpfr_print_binary(z2); puts ("");
printf ("instead of "); mpfr_print_binary(z); puts ("");
printf ("inex flag = %d\n", 1);
exit (1);
}
}
else if (c == -2)
{
mpfr_nexttozero (z);
if (mpfr_cmp(z2, z))
{
printf ("Error in mpfr_div [even rnd?] rnd=GMP_RNDN\n");
printf ("Dividing ");
printf ("got "); mpfr_print_binary(z2); puts ("");
printf ("instead of "); mpfr_print_binary(z); puts ("");
printf ("inex flag = %d\n", 1);
exit (1);
}
}
}
mpfr_set_prec(x, 1000);
mpfr_set_prec(y, 100);
mpfr_set_prec(tmp, 850);
mpfr_set_prec(z, 10);
mpfr_set_prec(z2, 10);
/* almost exact divisions */
for (k = 1; k < KMAX; k++)
{
do
{
mpfr_random(z);
}
while (mpfr_cmp_ui (z, 0) == 0);
do
{
mpfr_random (tmp);
}
while (mpfr_cmp_ui (tmp, 0) == 0);
mpfr_mul(x, z, tmp, GMP_RNDN);
mpfr_set(y, tmp, GMP_RNDD);
mpfr_nexttoinf (x);
c = test_div(z2, x, y, GMP_RNDD);
test_div(z3, x, y, GMP_RNDD);
mpfr_set(z, z3, GMP_RNDD);
if (c != -1 || mpfr_cmp(z2, z))
{
printf ("Error in mpfr_div rnd=GMP_RNDD\n");
printf ("got "); mpfr_print_binary(z2); puts ("");
printf ("instead of "); mpfr_print_binary(z); puts ("");
printf ("inex flag = %d\n", c);
exit (1);
}
mpfr_set (y, tmp, GMP_RNDU);
test_div (z3, x, y, GMP_RNDU);
mpfr_set (z, z3, GMP_RNDU);
c = test_div (z2, x, y, GMP_RNDU);
if (c != 1 || mpfr_cmp (z2, z))
{
printf ("Error in mpfr_div rnd=GMP_RNDU\n");
printf ("u="); mpfr_dump (x);
printf ("v="); mpfr_dump (y);
printf ("got "); mpfr_print_binary (z2); puts ("");
printf ("instead of "); mpfr_print_binary (z); puts ("");
printf ("inex flag = %d\n", c);
exit (1);
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (z2);
mpfr_clear (z3);
mpfr_clear (tmp);
}
int
mpfr_ui_pow_ui (mpfr_ptr x, unsigned long int y, unsigned long int n,
mpfr_rnd_t rnd)
{
mpfr_exp_t err;
unsigned long m;
mpfr_t res;
mpfr_prec_t prec;
int size_n;
int inexact;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
if (MPFR_UNLIKELY (n <= 1))
{
if (n == 1)
return mpfr_set_ui (x, y, rnd); /* y^1 = y */
else
return mpfr_set_ui (x, 1, rnd); /* y^0 = 1 for any y */
}
else if (MPFR_UNLIKELY (y <= 1))
{
if (y == 1)
return mpfr_set_ui (x, 1, rnd); /* 1^n = 1 for any n > 0 */
else
return mpfr_set_ui (x, 0, rnd); /* 0^n = 0 for any n > 0 */
}
for (size_n = 0, m = n; m; size_n++, m >>= 1);
MPFR_SAVE_EXPO_MARK (expo);
prec = MPFR_PREC (x) + 3 + size_n;
mpfr_init2 (res, prec);
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
int i = size_n;
inexact = mpfr_set_ui (res, y, MPFR_RNDU);
err = 1;
/* now 2^(i-1) <= n < 2^i: i=1+floor(log2(n)) */
for (i -= 2; i >= 0; i--)
{
inexact |= mpfr_mul (res, res, res, MPFR_RNDU);
err++;
if (n & (1UL << i))
inexact |= mpfr_mul_ui (res, res, y, MPFR_RNDU);
}
/* since the loop is executed floor(log2(n)) times,
we have err = 1+floor(log2(n)).
Since prec >= MPFR_PREC(x) + 4 + floor(log2(n)), prec > err */
err = prec - err;
if (MPFR_LIKELY (inexact == 0
|| MPFR_CAN_ROUND (res, err, MPFR_PREC (x), rnd)))
break;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, prec);
mpfr_set_prec (res, prec);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (x, res, rnd);
mpfr_clear (res);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (x, inexact, rnd);
}
/* (y, z) <- (sin(x), cos(x)), return value is 0 iff both results are exact */
int
mpfr_sin_cos (mpfr_ptr y, mpfr_ptr z, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int prec, m, ok, e, inexact, neg;
mpfr_t c, k;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_SET_NAN(z);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
MPFR_CLEAR_FLAGS(y);
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y, x);
mpfr_set_ui (z, 1, GMP_RNDN);
MPFR_RET(0);
}
prec = MAX(MPFR_PREC(y), MPFR_PREC(z));
m = prec + _mpfr_ceil_log2 ((double) prec) + ABS(MPFR_EXP(x)) + 13;
mpfr_init2 (c, m);
mpfr_init2 (k, m);
/* first determine sign */
mpfr_const_pi (c, GMP_RNDN);
mpfr_mul_2ui (c, c, 1, GMP_RNDN); /* 2*Pi */
mpfr_div (k, x, c, GMP_RNDN); /* x/(2*Pi) */
mpfr_floor (k, k); /* floor(x/(2*Pi)) */
mpfr_mul (c, k, c, GMP_RNDN);
mpfr_sub (k, x, c, GMP_RNDN); /* 0 <= k < 2*Pi */
mpfr_const_pi (c, GMP_RNDN); /* cached */
neg = mpfr_cmp (k, c) > 0;
mpfr_clear (k);
do
{
mpfr_cos (c, x, GMP_RNDZ);
if ((ok = mpfr_can_round (c, m, GMP_RNDZ, rnd_mode, MPFR_PREC(z))))
{
inexact = mpfr_set (z, c, rnd_mode);
mpfr_mul (c, c, c, GMP_RNDU);
mpfr_ui_sub (c, 1, c, GMP_RNDN);
e = 2 + (-MPFR_EXP(c)) / 2;
mpfr_sqrt (c, c, GMP_RNDN);
if (neg)
mpfr_neg (c, c, GMP_RNDN);
/* the absolute error on c is at most 2^(e-m) = 2^(EXP(c)-err) */
e = MPFR_EXP(c) + m - e;
ok = (e >= 0) && mpfr_can_round (c, e, GMP_RNDN, rnd_mode,
MPFR_PREC(y));
}
if (ok == 0)
{
m += _mpfr_ceil_log2 ((double) m);
mpfr_set_prec (c, m);
}
}
while (ok == 0);
inexact = mpfr_set (y, c, rnd_mode) || inexact;
mpfr_clear (c);
return inexact; /* inexact */
}
int
mpfr_sin (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t c, xr;
mpfr_srcptr xx;
mpfr_exp_t expx, err;
mpfr_prec_t precy, m;
int inexact, sign, reduce;
MPFR_ZIV_DECL (loop);
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_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);
}
}
/* sin(x) = x - x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 2, 0,
rnd_mode, {});
MPFR_SAVE_EXPO_MARK (expo);
/* Compute initial precision */
precy = MPFR_PREC (y);
if (precy >= MPFR_SINCOS_THRESHOLD)
return mpfr_sin_fast (y, x, rnd_mode);
m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13;
expx = MPFR_GET_EXP (x);
mpfr_init (c);
mpfr_init (xr);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* first perform argument reduction modulo 2*Pi (if needed),
also helps to determine the sign of sin(x) */
if (expx >= 2) /* If Pi < x < 4, we need to reduce too, to determine
the sign of sin(x). For 2 <= |x| < Pi, we could avoid
the reduction. */
{
reduce = 1;
/* As expx + m - 1 will silently be converted into mpfr_prec_t
in the mpfr_set_prec call, the assert below may be useful to
avoid undefined behavior. */
MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
mpfr_set_prec (c, expx + m - 1);
mpfr_set_prec (xr, m);
mpfr_const_pi (c, MPFR_RNDN);
mpfr_mul_2ui (c, c, 1, MPFR_RNDN);
mpfr_remainder (xr, x, c, MPFR_RNDN);
/* The analysis is similar to that of cos.c:
|xr - x - 2kPi| <= 2^(2-m). Thus we can decide the sign
of sin(x) if xr is at distance at least 2^(2-m) of both
0 and +/-Pi. */
mpfr_div_2ui (c, c, 1, MPFR_RNDN);
/* Since c approximates Pi with an error <= 2^(2-expx-m) <= 2^(-m),
it suffices to check that c - |xr| >= 2^(2-m). */
if (MPFR_SIGN (xr) > 0)
mpfr_sub (c, c, xr, MPFR_RNDZ);
else
mpfr_add (c, c, xr, MPFR_RNDZ);
if (MPFR_IS_ZERO(xr)
|| MPFR_EXP(xr) < (mpfr_exp_t) 3 - (mpfr_exp_t) m
|| MPFR_EXP(c) < (mpfr_exp_t) 3 - (mpfr_exp_t) m)
goto ziv_next;
/* |xr - x - 2kPi| <= 2^(2-m), thus |sin(xr) - sin(x)| <= 2^(2-m) */
xx = xr;
}
else /* the input argument is already reduced */
{
reduce = 0;
xx = x;
}
sign = MPFR_SIGN(xx);
/* now that the argument is reduced, precision m is enough */
mpfr_set_prec (c, m);
mpfr_cos (c, xx, MPFR_RNDZ); /* can't be exact */
mpfr_nexttoinf (c); /* now c = cos(x) rounded away */
mpfr_mul (c, c, c, MPFR_RNDU); /* away */
mpfr_ui_sub (c, 1, c, MPFR_RNDZ);
mpfr_sqrt (c, c, MPFR_RNDZ);
if (MPFR_IS_NEG_SIGN(sign))
MPFR_CHANGE_SIGN(c);
/* Warning: c may be 0! */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (c)))
{
/* Huge cancellation: increase prec a lot! */
m = MAX (m, MPFR_PREC (x));
m = 2 * m;
}
else
{
/* the absolute error on c is at most 2^(3-m-EXP(c)),
plus 2^(2-m) if there was an argument reduction.
Since EXP(c) <= 1, 3-m-EXP(c) >= 2-m, thus the error
is at most 2^(3-m-EXP(c)) in case of argument reduction. */
err = 2 * MPFR_GET_EXP (c) + (mpfr_exp_t) m - 3 - (reduce != 0);
if (MPFR_CAN_ROUND (c, err, precy, rnd_mode))
break;
/* check for huge cancellation (Near 0) */
if (err < (mpfr_exp_t) MPFR_PREC (y))
m += MPFR_PREC (y) - err;
/* Check if near 1 */
if (MPFR_GET_EXP (c) == 1)
m += m;
}
ziv_next:
/* Else generic increase */
MPFR_ZIV_NEXT (loop, m);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, c, rnd_mode);
/* inexact cannot be 0, since this would mean that c was representable
within the target precision, but in that case mpfr_can_round will fail */
mpfr_clear (c);
mpfr_clear (xr);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t K0, K, precy, m, k, l;
int inexact, reduce = 0;
mpfr_t r, s, xr, c;
mpfr_exp_t exps, cancel = 0, expx;
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
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* cos(x) = 1-x^2/2 + ..., so error < 2^(2*EXP(x)-1) */
expx = MPFR_GET_EXP (x);
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, -2 * expx,
1, 0, rnd_mode, expo, {});
/* Compute initial precision */
precy = MPFR_PREC (y);
if (precy >= MPFR_SINCOS_THRESHOLD)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_cos_fast (y, x, rnd_mode);
}
K0 = __gmpfr_isqrt (precy / 3);
m = precy + 2 * MPFR_INT_CEIL_LOG2 (precy) + 2 * K0;
if (expx >= 3)
{
reduce = 1;
/* As expx + m - 1 will silently be converted into mpfr_prec_t
in the mpfr_init2 call, the assert below may be useful to
avoid undefined behavior. */
MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
mpfr_init2 (c, expx + m - 1);
mpfr_init2 (xr, m);
}
MPFR_GROUP_INIT_2 (group, m, r, s);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* If |x| >= 4, first reduce x cmod (2*Pi) into xr, using mpfr_remainder:
let e = EXP(x) >= 3, and m the target precision:
(1) c <- 2*Pi [precision e+m-1, nearest]
(2) xr <- remainder (x, c) [precision m, nearest]
We have |c - 2*Pi| <= 1/2ulp(c) = 2^(3-e-m)
|xr - x - k c| <= 1/2ulp(xr) <= 2^(1-m)
|k| <= |x|/(2*Pi) <= 2^(e-2)
Thus |xr - x - 2kPi| <= |k| |c - 2Pi| + 2^(1-m) <= 2^(2-m).
It follows |cos(xr) - cos(x)| <= 2^(2-m). */
if (reduce)
{
mpfr_const_pi (c, MPFR_RNDN);
mpfr_mul_2ui (c, c, 1, MPFR_RNDN); /* 2Pi */
mpfr_remainder (xr, x, c, MPFR_RNDN);
if (MPFR_IS_ZERO(xr))
goto ziv_next;
/* now |xr| <= 4, thus r <= 16 below */
mpfr_mul (r, xr, xr, MPFR_RNDU); /* err <= 1 ulp */
}
else
mpfr_mul (r, x, x, MPFR_RNDU); /* err <= 1 ulp */
/* now |x| < 4 (or xr if reduce = 1), thus |r| <= 16 */
/* we need |r| < 1/2 for mpfr_cos2_aux, i.e., EXP(r) - 2K <= -1 */
K = K0 + 1 + MAX(0, MPFR_GET_EXP(r)) / 2;
/* since K0 >= 0, if EXP(r) < 0, then K >= 1, thus EXP(r) - 2K <= -3;
otherwise if EXP(r) >= 0, then K >= 1/2 + EXP(r)/2, thus
EXP(r) - 2K <= -1 */
MPFR_SET_EXP (r, MPFR_GET_EXP (r) - 2 * K); /* Can't overflow! */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
/* l is the error bound in ulps on s */
MPFR_SET_ONE (r);
for (k = 0; k < K; k++)
{
mpfr_sqr (s, s, MPFR_RNDU); /* err <= 2*olderr */
MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1); /* Can't overflow */
mpfr_sub (s, s, r, MPFR_RNDN); /* err <= 4*olderr */
if (MPFR_IS_ZERO(s))
goto ziv_next;
MPFR_ASSERTD (MPFR_GET_EXP (s) <= 1);
}
/* The absolute error on s is bounded by (2l+1/3)*2^(2K-m)
2l+1/3 <= 2l+1.
If |x| >= 4, we need to add 2^(2-m) for the argument reduction
by 2Pi: if K = 0, this amounts to add 4 to 2l+1/3, i.e., to add
2 to l; if K >= 1, this amounts to add 1 to 2*l+1/3. */
l = 2 * l + 1;
if (reduce)
l += (K == 0) ? 4 : 1;
k = MPFR_INT_CEIL_LOG2 (l) + 2*K;
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
exps = MPFR_GET_EXP (s);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, exps + m - k, precy, rnd_mode)))
break;
if (MPFR_UNLIKELY (exps == 1))
/* s = 1 or -1, and except x=0 which was already checked above,
cos(x) cannot be 1 or -1, so we can round if the error is less
than 2^(-precy) for directed rounding, or 2^(-precy-1) for rounding
to nearest. */
{
if (m > k && (m - k >= precy + (rnd_mode == MPFR_RNDN)))
{
/* If round to nearest or away, result is s = 1 or -1,
otherwise it is round(nexttoward (s, 0)). However in order to
have the inexact flag correctly set below, we set |s| to
1 - 2^(-m) in all cases. */
mpfr_nexttozero (s);
break;
}
}
if (exps < cancel)
{
m += cancel - exps;
cancel = exps;
}
ziv_next:
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_2 (group, m, r, s);
if (reduce)
{
mpfr_set_prec (xr, m);
mpfr_set_prec (c, expx + m - 1);
}
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
MPFR_GROUP_CLEAR (group);
if (reduce)
{
mpfr_clear (xr);
mpfr_clear (c);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
static void
check_regression (void)
{
mpfr_t x, y, z;
int i;
FILE *fp;
char s[BUFSIZE];
mpfr_inits2 (6177, x, y, z, (mpfr_ptr) 0);
/* we read long strings from a file since ISO C90 does not support strings of
length > 509 */
fp = src_fopen ("tmul.dat", "r");
if (fp == NULL)
{
fprintf (stderr, "Error, cannot open tmul.dat in srcdir\n");
exit (1);
}
get_string (s, fp);
mpfr_set_str (y, s, 16, MPFR_RNDN);
get_string (s, fp);
mpfr_set_str (z, s, 16, MPFR_RNDN);
i = mpfr_mul (x, y, z, MPFR_RNDN);
get_string (s, fp);
if (mpfr_cmp_str (x, s, 16, MPFR_RNDN) != 0 || i != -1)
{
printf ("Regression test 1 failed (i=%d, expected -1)\nx=", i);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
fclose (fp);
mpfr_set_prec (x, 606);
mpfr_set_prec (y, 606);
mpfr_set_prec (z, 606);
mpfr_set_str (y, "-f.ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff92daefc3f8052ca9f58736564d9e93e62d324@-1", 16, MPFR_RNDN);
mpfr_set_str (z, "-f.ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff92daefc3f8052ca9f58736564d9e93e62d324@-1", 16, MPFR_RNDN);
i = mpfr_mul (x, y, z, MPFR_RNDU);
mpfr_set_str (y, "f.ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff25b5df87f00a5953eb0e6cac9b3d27cc5a64c@-1", 16, MPFR_RNDN);
if (mpfr_cmp (x, y) || i <= 0)
{
printf ("Regression test (2) failed! (i=%d - Expected 1)\n", i);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_set_prec (x, 184);
mpfr_set_prec (y, 92);
mpfr_set_prec (z, 1023);
mpfr_set_str (y, "6.9b8c8498882770d8038c3b0@-1", 16, MPFR_RNDN);
mpfr_set_str (z, "7.44e24b986e7fb296f1e936ce749fec3504cbf0d5ba769466b1c9f1578115efd5d29b4c79271191a920a99280c714d3a657ad6e3afbab77ffce9d697e9bb9110e26d676069afcea8b69f1d1541f2365042d80a97c21dcccd8ace4f1bb58b49922003e738e6f37bb82ef653cb2e87f763974e6ae50ae54e7724c38b80653e3289@255", 16, MPFR_RNDN);
i = mpfr_mul (x, y, z, MPFR_RNDU);
mpfr_set_prec (y, 184);
mpfr_set_str (y, "3.0080038f2ac5054e3e71ccbb95f76aaab2221715025a28@255",
16, MPFR_RNDN);
if (mpfr_cmp (x, y) || i <= 0)
{
printf ("Regression test (4) failed! (i=%d - expected 1)\n", i);
printf ("Ref: 3.0080038f2ac5054e3e71ccbb95f76aaab2221715025a28@255\n"
"Got: ");
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 908);
mpfr_set_prec (y, 908);
mpfr_set_prec (z, 908);
mpfr_set_str (y, "-f.fffffffffffffffffffffffffffffffffffffffffffffffffffffff"
"fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"
"ffffffffffffffffffffffffffffffffffffffffffffffffffffff99be91f83ec6f0ed28a3d42"
"e6e9a327230345ea6@-1", 16, MPFR_RNDN);
mpfr_set_str (z, "-f.fffffffffffffffffffffffffffffffffffffffffffffffffffffff"
"fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"
"ffffffffffffffffffffffffffffffffffffffffffffffffffffff99be91f83ec6f0ed28a3d42"
"e6e9a327230345ea6@-1", 16, MPFR_RNDN);
i = mpfr_mul (x, y, z, MPFR_RNDU);
mpfr_set_str (y, "f.ffffffffffffffffffffffffffffffffffffffffffffffffffffffff"
"fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"
"fffffffffffffffffffffffffffffffffffffffffffffffffffff337d23f07d8de1da5147a85c"
"dd3464e46068bd4d@-1", 16, MPFR_RNDN);
if (mpfr_cmp (x, y) || i <= 0)
{
printf ("Regression test (5) failed! (i=%d - expected 1)\n", i);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 50);
mpfr_set_prec (y, 40);
mpfr_set_prec (z, 53);
mpfr_set_str (y, "4.1ffffffff8", 16, MPFR_RNDN);
mpfr_set_str (z, "4.2000000ffe0000@-4", 16, MPFR_RNDN);
i = mpfr_mul (x, y, z, MPFR_RNDN);
if (mpfr_cmp_str (x, "1.104000041d6c0@-3", 16, MPFR_RNDN) != 0
|| i <= 0)
{
printf ("Regression test (6) failed! (i=%d - expected 1)\nx=", i);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\nMore prec=");
mpfr_set_prec (x, 93);
mpfr_mul (x, y, z, MPFR_RNDN);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 439);
mpfr_set_prec (y, 393);
mpfr_set_str (y, "-1.921fb54442d18469898cc51701b839a252049c1114cf98e804177d"
"4c76273644a29410f31c6809bbdf2a33679a748636600",
16, MPFR_RNDN);
i = mpfr_mul (x, y, y, MPFR_RNDU);
if (mpfr_cmp_str (x, "2.77a79937c8bbcb495b89b36602306b1c2159a8ff834288a19a08"
"84094f1cda3dc426da61174c4544a173de83c2500f8bfea2e0569e3698",
16, MPFR_RNDN) != 0
|| i <= 0)
{
printf ("Regression test (7) failed! (i=%d - expected 1)\nx=", i);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 1023);
mpfr_set_prec (y, 1023);
mpfr_set_prec (z, 511);
mpfr_set_ui (x, 17, MPFR_RNDN);
mpfr_set_ui (y, 42, MPFR_RNDN);
i = mpfr_mul (z, x, y, MPFR_RNDN);
if (mpfr_cmp_ui (z, 17*42) != 0 || i != 0)
{
printf ("Regression test (8) failed! (i=%d - expected 0)\nz=", i);
mpfr_out_str (stdout, 16, 0, z, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, z, s;
MPFR_SAVE_EXPO_DECL (expo);
tests_start_mpfr ();
mpfr_init (x);
mpfr_init (s);
mpfr_init (y);
mpfr_init (z);
/* check special cases */
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 2);
mpfr_set_prec (z, 2);
mpfr_set_prec (s, 2);
mpfr_set_str (x, "-0.75", 10, MPFR_RNDN);
mpfr_set_str (y, "0.5", 10, MPFR_RNDN);
mpfr_set_str (z, "0.375", 10, MPFR_RNDN);
mpfr_fma (s, x, y, z, MPFR_RNDU); /* result is 0 */
if (mpfr_cmp_ui(s, 0))
{
printf("Error: -0.75 * 0.5 + 0.375 should be equal to 0 for prec=2\n");
exit(1);
}
mpfr_set_prec (x, 27);
mpfr_set_prec (y, 27);
mpfr_set_prec (z, 27);
mpfr_set_prec (s, 27);
mpfr_set_str_binary (x, "1.11111111111111111111111111e-1");
mpfr_set (y, x, MPFR_RNDN);
mpfr_set_str_binary (z, "-1.00011110100011001011001001e-1");
if (mpfr_fma (s, x, y, z, MPFR_RNDN) >= 0)
{
printf ("Wrong inexact flag for x=y=1-2^(-27)\n");
exit (1);
}
mpfr_set_nan (x);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=NAN does not return NAN");
exit (1);
}
mpfr_set_nan (y);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p(s))
{
printf ("evaluation of function in y=NAN does not return NAN");
exit (1);
}
mpfr_set_nan (z);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (x, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in z=NAN does not return NAN");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_set_inf (y, 1);
mpfr_set_inf (z, 1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("Error for (+inf) * (+inf) + (+inf)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_set_inf (y, -1);
mpfr_set_inf (z, 1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("Error for (-inf) * (-inf) + (+inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_set_inf (y, -1);
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) > 0)
{
printf ("Error for (+inf) * (-inf) + (-inf)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_set_inf (y, 1);
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) > 0)
{
printf ("Error for (-inf) * (+inf) + (-inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=INF y=0 does not return NAN");
exit (1);
}
mpfr_set_inf (y, 1);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=0 y=INF does not return NAN");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_urandomb (y, RANDS); /* always positive */
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=INF y>0 z=-INF does not return NAN");
exit (1);
}
mpfr_set_inf (y, 1);
mpfr_urandomb (x, RANDS);
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x>0 y=INF z=-INF does not return NAN");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("evaluation of function in x=INF does not return INF");
exit (1);
}
mpfr_set_inf (y, 1);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("evaluation of function in y=INF does not return INF");
exit (1);
}
mpfr_set_inf (z, 1);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (y, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("evaluation of function in z=INF does not return INF");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (mpfr_cmp (s, z))
{
printf ("evaluation of function in x=0 does not return z\n");
exit (1);
}
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (mpfr_cmp (s, z))
{
printf ("evaluation of function in y=0 does not return z\n");
exit (1);
}
{
mpfr_prec_t prec;
mpfr_t t, slong;
mpfr_rnd_t rnd;
int inexact, compare;
unsigned int n;
mpfr_prec_t p0=2, p1=200;
unsigned int N=200;
mpfr_init (t);
mpfr_init (slong);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (s, prec);
mpfr_set_prec (t, prec);
for (n=0; n<N; n++)
{
mpfr_urandomb (x, RANDS);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
if (randlimb () % 2)
mpfr_neg (x, x, MPFR_RNDN);
if (randlimb () % 2)
mpfr_neg (y, y, MPFR_RNDN);
if (randlimb () % 2)
mpfr_neg (z, z, MPFR_RNDN);
rnd = RND_RAND ();
mpfr_set_prec (slong, 2 * prec);
if (mpfr_mul (slong, x, y, rnd))
{
printf ("x*y should be exact\n");
exit (1);
}
compare = mpfr_add (t, slong, z, rnd);
inexact = mpfr_fma (s, x, y, z, rnd);
if (mpfr_cmp (s, t))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf (" y=");
mpfr_out_str (stdout, 2, prec, y, MPFR_RNDN);
printf (" z=");
mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN);
printf (" prec=%u rnd_mode=%s\n", (unsigned int) prec,
mpfr_print_rnd_mode (rnd));
printf ("got ");
mpfr_out_str (stdout, 2, prec, s, MPFR_RNDN);
puts ("");
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, MPFR_RNDN);
puts ("");
printf ("approx ");
mpfr_print_binary (slong);
puts ("");
exit (1);
}
if (((inexact == 0) && (compare != 0)) ||
((inexact < 0) && (compare >= 0)) ||
((inexact > 0) && (compare <= 0)))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d\n",
mpfr_print_rnd_mode (rnd), compare, inexact);
printf (" x="); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf (" y="); mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf (" z="); mpfr_out_str (stdout, 2, 0, z, MPFR_RNDN);
printf (" s="); mpfr_out_str (stdout, 2, 0, s, MPFR_RNDN);
printf ("\n");
exit (1);
}
}
}
mpfr_clear (t);
mpfr_clear (slong);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (s);
test_exact ();
MPFR_SAVE_EXPO_MARK (expo);
test_overflow1 ();
test_overflow2 ();
test_underflow1 ();
test_underflow2 ();
MPFR_SAVE_EXPO_FREE (expo);
tests_end_mpfr ();
return 0;
}
int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
int K0, K, precy, m, k, l, inexact;
mpfr_t r, s;
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
if (MPFR_IS_ZERO(x))
{
mpfr_set_ui (y, 1, GMP_RNDN);
return 0;
}
precy = MPFR_PREC(y);
K0 = _mpfr_isqrt(precy / 2);
/* we need at least K + log2(precy/K) extra bits */
m = precy + 3 * K0 + 3;
mpfr_init2 (r, m);
mpfr_init2 (s, m);
do
{
mpfr_mul (r, x, x, GMP_RNDU); /* err <= 1 ulp */
/* we need that |r| < 1 for mpfr_cos2_aux, i.e. up(x^2)/2^(2K) < 1 */
K = K0 + MAX(MPFR_EXP(r), 0);
mpfr_div_2ui (r, r, 2 * K, GMP_RNDN); /* r = (x/2^K)^2, err <= 1 ulp */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
for (k = 0; k < K; k++)
{
mpfr_mul (s, s, s, GMP_RNDU); /* err <= 2*olderr */
mpfr_mul_2ui (s, s, 1, GMP_RNDU); /* err <= 4*olderr */
mpfr_sub_ui (s, s, 1, GMP_RNDN);
}
/* absolute error on s is bounded by (2l+1/3)*2^(2K-m) */
for (k = 2 * K, l = 2 * l + 1; l > 1; k++, l = (l + 1) >> 1);
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
l = mpfr_can_round (s, MPFR_EXP(s) + m - k, GMP_RNDN, rnd_mode, precy);
if (l == 0)
{
m += BITS_PER_MP_LIMB;
mpfr_set_prec (r, m);
mpfr_set_prec (s, m);
}
}
while (l == 0);
inexact = mpfr_set (y, s, rnd_mode);
mpfr_clear (r);
mpfr_clear (s);
return inexact;
}
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
from Abramowitz & Stegun).
Assumes |z| > p log(2)/2, where p is the target precision
(z can be negative only for jn).
Return 0 if the expansion does not converge enough (the value 0 as inexact
flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
mpfr_prec_t w;
long k;
int inex, stop, diverge = 0;
mpfr_exp_t err2, err;
MPFR_ZIV_DECL (loop);
mpfr_init (c);
w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;
MPFR_ZIV_INIT (loop, w);
for (;;)
{
mpfr_set_prec (c, w);
mpfr_init2 (s, w);
mpfr_init2 (P, w);
mpfr_init2 (Q, w);
mpfr_init2 (t, w);
mpfr_init2 (iz, w);
mpfr_init2 (err_t, 31);
mpfr_init2 (err_s, 31);
mpfr_init2 (err_u, 31);
/* Approximate sin(z) and cos(z). In the following, err <= k means that
the approximate value y and the true value x are related by
y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
mpfr_sin_cos (s, c, z, MPFR_RNDN);
if (MPFR_IS_NEG(z))
mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
/* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
mpfr_add (t, s, c, MPFR_RNDN);
mpfr_sub (c, s, c, MPFR_RNDN);
mpfr_swap (s, t);
/* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
with total absolute error bounded by 2^(1-w). */
/* precompute 1/(8|z|) */
mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN); /* err <= 1 */
mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);
/* compute P and Q */
mpfr_set_ui (P, 1, MPFR_RNDN);
mpfr_set_ui (Q, 0, MPFR_RNDN);
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
for (k = 1, stop = 0; stop < 4; k++)
{
/* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
mpfr_div_ui (t, t, k, MPFR_RNDN); /* err <= err_k + 3 */
mpfr_mul (t, t, iz, MPFR_RNDN); /* err <= err_k + 5 */
/* the relative error on t is bounded by (1+u)^(5k)-1, which is
bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
/* the absolute error on t is bounded by err_t * 2^(-w) */
mpfr_abs (err_u, t, MPFR_RNDU);
mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
if (stop >= 2)
{
/* take into account the neglected terms: t * 2^w */
mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
if (MPFR_IS_POS(t))
mpfr_add (err_s, err_s, t, MPFR_RNDU);
else
mpfr_sub (err_s, err_s, t, MPFR_RNDU);
mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
stop ++;
}
/* if k is odd, add to Q, otherwise to P */
else if (k & 1)
{
/* if k = 1 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (Q, Q, t, MPFR_RNDN);
else
mpfr_sub (Q, Q, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(Q): if EXP(err_u)
<= EXP(Q), since the current term is bounded by
err_u * 2^(-w), it is bounded by ulp(Q) */
if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
stop ++;
else
stop = 0;
}
else
{
/* if k = 0 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (P, P, t, MPFR_RNDN);
else
mpfr_sub (P, P, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(P) */
if (MPFR_EXP(err_u) <= MPFR_EXP(P))
stop ++;
else
stop = 0;
}
mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
/* the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w) */
/* stop when start to diverge */
if (stop < 2 &&
((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
(MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
{
/* if we have to stop the series because it diverges, then
increasing the precision will most probably fail, since
we will stop to the same point, and thus compute a very
similar approximation */
diverge = 1;
stop = 2; /* force stop */
}
}
/* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */
/* Now combine: the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
Q * (sin + cos) + P (sin - cos) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_sub (s, s, c, MPFR_RNDN);
#else
mpfr_add (s, s, c, MPFR_RNDN);
#endif
}
else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
Q * (sin - cos) - P (cos + sin) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_add (s, s, c, MPFR_RNDN);
#else
mpfr_sub (s, c, s, MPFR_RNDN);
#endif
}
if ((n & 2) != 0)
mpfr_neg (s, s, MPFR_RNDN);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
/* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
+ err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
<= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
since |c|, |old_s| <= 2. */
err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
/* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
/* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
err2 = (err >= err2) ? err + 1 : err2 + 1;
/* now the absolute error on s is bounded by 2^(err2 - w) */
/* multiply by sqrt(1/(Pi*z)) */
mpfr_const_pi (c, MPFR_RNDN); /* Pi, err <= 1 */
mpfr_mul (c, c, z, MPFR_RNDN); /* err <= 2 */
mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
mpfr_sqrt (c, c, MPFR_RNDN); /* err<=5/2, thus the absolute error is
bounded by 3*u*|c| for |u| <= 0.25 */
mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDU);
mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
/* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
err2 += MPFR_EXP(c);
/* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
mpfr_mul (c, c, s, MPFR_RNDN); /* the absolute error on c is bounded by
1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
+ |old_c| * 2^(err2 - w) */
/* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
/* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
/* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
err = (err >= err2) ? err + 1 : err2 + 1;
/* the absolute error on c is bounded by 2^(err - w) */
mpfr_clear (s);
mpfr_clear (P);
mpfr_clear (Q);
mpfr_clear (t);
mpfr_clear (iz);
mpfr_clear (err_t);
mpfr_clear (err_s);
mpfr_clear (err_u);
err -= MPFR_EXP(c);
if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
break;
if (diverge != 0)
{
mpfr_set (c, z, r); /* will force inex=0 below, which means the
asymptotic expansion failed */
break;
}
MPFR_ZIV_NEXT (loop, w);
}
MPFR_ZIV_FREE (loop);
inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
: mpfr_neg (res, c, r);
mpfr_clear (c);
return inex;
}
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
int ok_re = 0, ok_im = 0;
mpc_t res, c_conj;
mpfr_t q;
mpfr_prec_t prec;
int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
int saved_underflow, saved_overflow;
int tmpsgn;
mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
mpc_t b_scaled, c_scaled;
mpfr_t b_re, b_im, c_re, c_im;
/* According to the C standard G.3, there are three types of numbers: */
/* finite (both parts are usual real numbers; contains 0), infinite */
/* (at least one part is a real infinity) and all others; the latter */
/* are numbers containing a nan, but no infinity, and could reasonably */
/* be called nan. */
/* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */
/* all other divisions that are not finite/finite return nan+i*nan. */
/* Division by 0 could be handled by the following case of division by */
/* a real; we handle it separately instead. */
if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
return mpc_div_zero (a, b, c, rnd);
else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
and both Re(c) and Im(c) are ordinary */
return mpc_div_inf_fin (a, b, c);
else if (mpc_fin_p (b) && mpc_inf_p (c))
return mpc_div_fin_inf (a, b, c);
else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
mpc_set_nan (a);
return MPC_INEX (0, 0);
}
else if (mpfr_zero_p(mpc_imagref(c)))
return mpc_div_real (a, b, c, rnd);
else if (mpfr_zero_p(mpc_realref(c)))
return mpc_div_imag (a, b, c, rnd);
prec = MPC_MAX_PREC(a);
mpc_init2 (res, 2);
mpfr_init (q);
/* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
but one of Re(b) or Im(b) could be zero */
e = mpfr_get_exp (mpc_realref (c));
emin = emax = e;
e = mpfr_get_exp (mpc_imagref (c));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
if (!mpfr_zero_p (mpc_realref (b)))
{
e = mpfr_get_exp (mpc_realref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
if (!mpfr_zero_p (mpc_imagref (b)))
{
e = mpfr_get_exp (mpc_imagref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
/* all input exponents are in [emin, emax] */
emid = emin / 2 + emax / 2;
/* scale the inputs */
b_re[0] = mpc_realref (b)[0];
if (!mpfr_zero_p (mpc_realref (b)))
MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
b_im[0] = mpc_imagref (b)[0];
if (!mpfr_zero_p (mpc_imagref (b)))
MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
c_re[0] = mpc_realref (c)[0];
MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
c_im[0] = mpc_imagref (c)[0];
MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;
/* create the scaled inputs without allocating new memory */
mpc_realref (b_scaled)[0] = b_re[0];
mpc_imagref (b_scaled)[0] = b_im[0];
mpc_realref (c_scaled)[0] = c_re[0];
mpc_imagref (c_scaled)[0] = c_im[0];
/* create the conjugate of c in c_conj without allocating new memory */
mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
MPFR_CHANGE_SIGN (mpc_imagref (c_conj));
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do {
loops ++;
prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;
mpc_set_prec (res, prec);
mpfr_set_prec (q, prec);
/* first compute norm(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
underflow_norm = mpfr_underflow_p ();
overflow_norm = mpfr_overflow_p ();
if (underflow_norm)
mpfr_set_ui (q, 0ul, MPFR_RNDN);
/* to obtain divisions by 0 later on */
/* now compute b_scaled*conjugate(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
inexact_re = MPC_INEX_RE (inexact_prod);
inexact_im = MPC_INEX_IM (inexact_prod);
underflow_prod = mpfr_underflow_p ();
overflow_prod = mpfr_overflow_p ();
/* unfortunately, does not distinguish between under-/overflow
in real or imaginary parts
hopefully, the side-effects of mpc_mul do indeed raise the
mpfr exceptions */
if (overflow_prod) {
/* FIXME: in case overflow_norm is also true, the code below is wrong,
since the after division by the norm, we might end up with finite
real and/or imaginary parts. A workaround would be to scale the
inputs (in case the exponents are within the same range). */
int isinf = 0;
/* determine if the real part of res is the maximum or the minimum
representable number */
tmpsgn = mpfr_sgn (mpc_realref(res));
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextbelow (mpc_realref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextabove (mpc_realref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_realref(res), tmpsgn);
overflow_re = 1;
}
/* same for the imaginary part */
tmpsgn = mpfr_sgn (mpc_imagref(res));
isinf = 0;
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextbelow (mpc_imagref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextabove (mpc_imagref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_imagref(res), tmpsgn);
overflow_im = 1;
}
mpc_set (a, res, rnd);
goto end;
}
/* divide the product by the norm */
if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
/* The division has good chances to be exact in at least one part. */
/* Since this can cause problems when not rounding to the nearest, */
/* we use the division code of mpfr, which handles the situation. */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
else {
/* The division is inexact, so for efficiency reasons we invert q */
/* only once and multiply by the inverse. */
if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
/* if 1/q is inexact, the approximations of the real and
imaginary part below will be inexact, unless RE(res)
or IM(res) is zero */
inexact_re |= !mpfr_zero_p (mpc_realref (res));
inexact_im |= !mpfr_zero_p (mpc_imagref (res));
}
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
} while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
&& !underflow_prod && !overflow_prod);
inex = mpc_set (a, res, rnd);
inexact_re = MPC_INEX_RE (inex);
inexact_im = MPC_INEX_IM (inex);
end:
/* fix values and inexact flags in case of overflow/underflow */
/* FIXME: heuristic, certainly does not cover all cases */
if (overflow_re || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
inexact_re = mpfr_sgn (mpc_realref (res));
}
else if (underflow_re || (overflow_norm && !overflow_prod)) {
inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
mpfr_set_zero (mpc_realref (a), -inexact_re);
}
if (overflow_im || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
inexact_im = mpfr_sgn (mpc_imagref (res));
}
else if (underflow_im || (overflow_norm && !overflow_prod)) {
inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
mpfr_set_zero (mpc_imagref (a), -inexact_im);
}
mpc_clear (res);
mpfr_clear (q);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX (inexact_re, inexact_im);
}
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;
}
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok;
mpfr_t u, v;
mpfr_t x;
/* temporary variable to hold the real part of op,
needed in the case rop==op */
mpfr_prec_t prec;
int inex_re, inex_im, inexact;
mpfr_exp_t emin;
int saved_underflow;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
else if (mpfr_inf_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op))) {
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_nan (mpc_realref (rop));
}
else {
if (mpfr_zero_p (mpc_imagref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), +1);
}
}
else /* IM(op) is infinity, RE(op) is not */ {
if (mpfr_zero_p (mpc_realref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), -1);
}
return MPC_INEX (0, 0); /* exact */
}
prec = MPC_MAX_PREC(rop);
/* Check for real resp. purely imaginary number */
if (mpfr_zero_p (mpc_imagref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (rop == op)
{
mpfr_init2 (x, MPC_PREC_RE (op));
mpfr_set (x, op->re, MPFR_RNDN);
}
else
x [0] = op->re [0];
/* From here on, use x instead of op->re and safely overwrite rop->re. */
/* Compute real part of result. */
if (SAFE_ABS (mpfr_exp_t,
mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
> (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
/* If the real and imaginary parts of the argument have very different
exponents, it is not reasonable to use Karatsuba squaring; compute
exactly with the standard formulae instead, even if this means an
additional multiplication. Using the approach copied from mul, over-
and underflows are also handled correctly. */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
}
else {
/* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
naive algorithm, which computes x^2-y^2 and 2*y*y */
mpfr_init (u);
mpfr_init (v);
emin = mpfr_get_emin ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
/* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */
/* The error is bounded above by 1 ulp. */
/* We first let inexact be 1 if the real part is not computed */
/* exactly and determine the sign later. */
inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
| mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);
/* compute the real part as u*v, rounded away */
/* determine also the sign of inex_re */
if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
/* as we have rounded away, the result is exact */
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
inex_re = 0;
ok = 1;
}
else {
inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
/* under- or overflow */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
ok = 1;
}
else {
ok = (!inexact) | mpfr_can_round (u, prec - 3,
MPFR_RNDA, MPFR_RNDZ,
MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
if (ok) {
inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
if (inex_re == 0)
/* remember that u was already rounded */
inex_re = inexact;
}
}
}
}
while (!ok);
mpfr_clear (u);
mpfr_clear (v);
}
saved_underflow = mpfr_underflow_p ();
mpfr_clear_underflow ();
inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
if (!mpfr_underflow_p ())
inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
/* We must not multiply by 2 if rop->im has been set to the smallest
representable number. */
if (saved_underflow)
mpfr_set_underflow ();
if (rop == op)
mpfr_clear (x);
return MPC_INEX (inex_re, inex_im);
}
/* Put in s an approximation of digamma(x).
Assumes x >= 2.
Assumes s does not overlap with x.
Returns an integer e such that the error is bounded by 2^e ulps
of the result s.
*/
static mpfr_exp_t
mpfr_digamma_approx (mpfr_ptr s, mpfr_srcptr x)
{
mpfr_prec_t p = MPFR_PREC (s);
mpfr_t t, u, invxx;
mpfr_exp_t e, exps, f, expu;
mpz_t *INITIALIZED(B); /* variable B declared as initialized */
unsigned long n0, n; /* number of allocated B[] */
MPFR_ASSERTN(MPFR_IS_POS(x) && (MPFR_EXP(x) >= 2));
mpfr_init2 (t, p);
mpfr_init2 (u, p);
mpfr_init2 (invxx, p);
mpfr_log (s, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_ui_div (t, 1, x, MPFR_RNDN); /* error <= 1/2 ulp */
mpfr_div_2exp (t, t, 1, MPFR_RNDN); /* exact */
mpfr_sub (s, s, t, MPFR_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(olds)-EXP(s)) + 1/2*2^(EXP(t)-EXP(s)).
For x >= 2, log(x) >= 2*(1/(2x)), thus olds >= 2t, and olds - t >= olds/2,
thus 0 <= EXP(olds)-EXP(s) <= 1, and EXP(t)-EXP(s) <= 0, thus
error <= 1/2 + 1/2*2 + 1/2 <= 2 ulps. */
e = 2; /* initial error */
mpfr_mul (invxx, x, x, MPFR_RNDZ); /* invxx = x^2 * (1 + theta)
for |theta| <= 2^(-p) */
mpfr_ui_div (invxx, 1, invxx, MPFR_RNDU); /* invxx = 1/x^2 * (1 + theta)^2 */
/* in the following we note err=xxx when the ratio between the approximation
and the exact result can be written (1 + theta)^xxx for |theta| <= 2^(-p),
following Higham's method */
B = mpfr_bernoulli_internal ((mpz_t *) 0, 0);
mpfr_set_ui (t, 1, MPFR_RNDN); /* err = 0 */
for (n = 1;; n++)
{
/* compute next Bernoulli number */
B = mpfr_bernoulli_internal (B, n);
/* The main term is Bernoulli[2n]/(2n)/x^(2n) = B[n]/(2n+1)!(2n)/x^(2n)
= B[n]*t[n]/(2n) where t[n]/t[n-1] = 1/(2n)/(2n+1)/x^2. */
mpfr_mul (t, t, invxx, MPFR_RNDU); /* err = err + 3 */
mpfr_div_ui (t, t, 2 * n, MPFR_RNDU); /* err = err + 1 */
mpfr_div_ui (t, t, 2 * n + 1, MPFR_RNDU); /* err = err + 1 */
/* we thus have err = 5n here */
mpfr_div_ui (u, t, 2 * n, MPFR_RNDU); /* err = 5n+1 */
mpfr_mul_z (u, u, B[n], MPFR_RNDU); /* err = 5n+2, and the
absolute error is bounded
by 10n+4 ulp(u) [Rule 11] */
/* if the terms 'u' are decreasing by a factor two at least,
then the error coming from those is bounded by
sum((10n+4)/2^n, n=1..infinity) = 24 */
exps = mpfr_get_exp (s);
expu = mpfr_get_exp (u);
if (expu < exps - (mpfr_exp_t) p)
break;
mpfr_sub (s, s, u, MPFR_RNDN); /* error <= 24 + n/2 */
if (mpfr_get_exp (s) < exps)
e <<= exps - mpfr_get_exp (s);
e ++; /* error in mpfr_sub */
f = 10 * n + 4;
while (expu < exps)
{
f = (1 + f) / 2;
expu ++;
}
e += f; /* total rouding error coming from 'u' term */
}
n0 = ++n;
while (n--)
mpz_clear (B[n]);
(*__gmp_free_func) (B, n0 * sizeof (mpz_t));
mpfr_clear (t);
mpfr_clear (u);
mpfr_clear (invxx);
f = 0;
while (e > 1)
{
f++;
e = (e + 1) / 2;
/* Invariant: 2^f * e does not decrease */
}
return f;
}
int
main (void)
{
mpfr_t a;
mp_limb_t *p, tmp;
mp_size_t s;
mpfr_prec_t pr;
int max;
tests_start_mpfr ();
for(pr = MPFR_PREC_MIN ; pr < 500 ; pr++)
{
mpfr_init2 (a, pr);
if (!mpfr_check(a)) ERROR("for init");
/* Check special cases */
MPFR_SET_NAN(a);
if (!mpfr_check(a)) ERROR("for nan");
MPFR_SET_POS(a);
MPFR_SET_INF(a);
if (!mpfr_check(a)) ERROR("for inf");
MPFR_SET_ZERO(a);
if (!mpfr_check(a)) ERROR("for zero");
MPFR_EXP (a) = MPFR_EXP_MIN;
if (mpfr_check(a)) ERROR("for EXP = MPFR_EXP_MIN");
/* Check var */
mpfr_set_ui(a, 2, MPFR_RNDN);
if (!mpfr_check(a)) ERROR("for set_ui");
mpfr_clear_overflow();
max = 1000; /* Allows max 2^1000 bits for the exponent */
while ((!mpfr_overflow_p()) && (max>0))
{
mpfr_mul(a, a, a, MPFR_RNDN);
if (!mpfr_check(a)) ERROR("for mul");
max--;
}
if (max==0) ERROR("can't reach overflow");
mpfr_set_ui(a, 2137, MPFR_RNDN);
/* Corrupt a and check for it */
MPFR_SIGN(a) = 2;
if (mpfr_check(a)) ERROR("sgn");
MPFR_SET_POS(a);
/* Check prec */
MPFR_PREC(a) = MPFR_PREC_MIN - 1;
if (mpfr_check(a)) ERROR("precmin");
#if MPFR_VERSION_MAJOR < 3
/* Disable the test with MPFR >= 3 since mpfr_prec_t is now signed.
The "if" below is sufficient, but the MPFR_PREC_MAX+1 generates
a warning with GCC 4.4.4 even though the test is always false. */
if ((mpfr_prec_t) 0 - 1 > 0)
{
MPFR_PREC(a) = MPFR_PREC_MAX+1;
if (mpfr_check(a)) ERROR("precmax");
}
#endif
MPFR_PREC(a) = pr;
if (!mpfr_check(a)) ERROR("prec");
/* Check exponent */
MPFR_EXP(a) = MPFR_EXP_INVALID;
if (mpfr_check(a)) ERROR("exp invalid");
MPFR_EXP(a) = -MPFR_EXP_INVALID;
if (mpfr_check(a)) ERROR("-exp invalid");
MPFR_EXP(a) = 0;
if (!mpfr_check(a)) ERROR("exp 0");
/* Check Mantissa */
p = MPFR_MANT(a);
MPFR_MANT(a) = NULL;
if (mpfr_check(a)) ERROR("Mantissa Null Ptr");
MPFR_MANT(a) = p;
/* Check size */
s = MPFR_GET_ALLOC_SIZE(a);
MPFR_SET_ALLOC_SIZE(a, 0);
if (mpfr_check(a)) ERROR("0 size");
MPFR_SET_ALLOC_SIZE(a, MP_SIZE_T_MIN);
if (mpfr_check(a)) ERROR("min size");
MPFR_SET_ALLOC_SIZE(a, MPFR_LIMB_SIZE(a)-1 );
if (mpfr_check(a)) ERROR("size < prec");
MPFR_SET_ALLOC_SIZE(a, s);
/* Check normal form */
tmp = MPFR_MANT(a)[0];
if ((pr % GMP_NUMB_BITS) != 0)
{
MPFR_MANT(a)[0] = MPFR_LIMB_MAX;
if (mpfr_check(a)) ERROR("last bits non 0");
}
MPFR_MANT(a)[0] = tmp;
MPFR_MANT(a)[MPFR_LIMB_SIZE(a)-1] &= MPFR_LIMB_MASK (GMP_NUMB_BITS-1);
if (mpfr_check(a)) ERROR("last bits non 0");
/* Final */
mpfr_set_ui(a, 2137, MPFR_RNDN);
if (!mpfr_check(a)) ERROR("after last set");
mpfr_clear (a);
if (mpfr_check(a)) ERROR("after clear");
}
tests_end_mpfr ();
return 0;
}
