static int mpfr_rem1 (mpfr_ptr rem, long *quo, mpfr_rnd_t rnd_q, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd) { mpfr_exp_t ex, ey; int compare, inex, q_is_odd, sign, signx = MPFR_SIGN (x); mpz_t mx, my, r; int tiny = 0; MPFR_ASSERTD (rnd_q == MPFR_RNDN || rnd_q == MPFR_RNDZ); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y))) { if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x) || MPFR_IS_ZERO (y)) { /* for remquo, quo is undefined */ MPFR_SET_NAN (rem); MPFR_RET_NAN; } else /* either y is Inf and x is 0 or non-special, or x is 0 and y is non-special, in both cases the quotient is zero. */ { if (quo) *quo = 0; return mpfr_set (rem, x, rnd); } } /* now neither x nor y is NaN, Inf or zero */ mpz_init (mx); mpz_init (my); mpz_init (r); ex = mpfr_get_z_2exp (mx, x); /* x = mx*2^ex */ ey = mpfr_get_z_2exp (my, y); /* y = my*2^ey */ /* to get rid of sign problems, we compute it separately: quo(-x,-y) = quo(x,y), rem(-x,-y) = -rem(x,y) quo(-x,y) = -quo(x,y), rem(-x,y) = -rem(x,y) thus quo = sign(x/y)*quo(|x|,|y|), rem = sign(x)*rem(|x|,|y|) */ sign = (signx == MPFR_SIGN (y)) ? 1 : -1; mpz_abs (mx, mx); mpz_abs (my, my); q_is_odd = 0; /* divide my by 2^k if possible to make operations mod my easier */ { unsigned long k = mpz_scan1 (my, 0); ey += k; mpz_fdiv_q_2exp (my, my, k); } if (ex <= ey) { /* q = x/y = mx/(my*2^(ey-ex)) */ /* First detect cases where q=0, to avoid creating a huge number my*2^(ey-ex): if sx = mpz_sizeinbase (mx, 2) and sy = mpz_sizeinbase (my, 2), we have x < 2^(ex + sx) and y >= 2^(ey + sy - 1), thus if ex + sx <= ey + sy - 1 the quotient is 0 */ if (ex + (mpfr_exp_t) mpz_sizeinbase (mx, 2) < ey + (mpfr_exp_t) mpz_sizeinbase (my, 2)) { tiny = 1; mpz_set (r, mx); mpz_set_ui (mx, 0); } else { mpz_mul_2exp (my, my, ey - ex); /* divide mx by my*2^(ey-ex) */ /* since mx > 0 and my > 0, we can use mpz_tdiv_qr in all cases */ mpz_tdiv_qr (mx, r, mx, my); /* 0 <= |r| <= |my|, r has the same sign as mx */ } if (rnd_q == MPFR_RNDN) q_is_odd = mpz_tstbit (mx, 0); if (quo) /* mx is the quotient */ { mpz_tdiv_r_2exp (mx, mx, WANTED_BITS); *quo = mpz_get_si (mx); } } else /* ex > ey */ { if (quo) /* remquo case */ /* for remquo, to get the low WANTED_BITS more bits of the quotient, we first compute R = X mod Y*2^WANTED_BITS, where X and Y are defined below. Then the low WANTED_BITS of the quotient are floor(R/Y). */ mpz_mul_2exp (my, my, WANTED_BITS); /* 2^WANTED_BITS*Y */ else if (rnd_q == MPFR_RNDN) /* remainder case */ /* Let X = mx*2^(ex-ey) and Y = my. Then both X and Y are integers. Assume X = R mod Y, then x = X*2^ey = R*2^ey mod (Y*2^ey=y). To be able to perform the rounding, we need the least significant bit of the quotient, i.e., one more bit in the remainder, which is obtained by dividing by 2Y. */ mpz_mul_2exp (my, my, 1); /* 2Y */ mpz_set_ui (r, 2); mpz_powm_ui (r, r, ex - ey, my); /* 2^(ex-ey) mod my */ mpz_mul (r, r, mx); mpz_mod (r, r, my); if (quo) /* now 0 <= r < 2^WANTED_BITS*Y */ { mpz_fdiv_q_2exp (my, my, WANTED_BITS); /* back to Y */ mpz_tdiv_qr (mx, r, r, my); /* oldr = mx*my + newr */ *quo = mpz_get_si (mx); q_is_odd = *quo & 1; } else if (rnd_q == MPFR_RNDN) /* now 0 <= r < 2Y in the remainder case */ { mpz_fdiv_q_2exp (my, my, 1); /* back to Y */ /* least significant bit of q */ q_is_odd = mpz_cmpabs (r, my) >= 0; if (q_is_odd) mpz_sub (r, r, my); } /* now 0 <= |r| < |my|, and if needed, q_is_odd is the least significant bit of q */ } if (mpz_cmp_ui (r, 0) == 0) { inex = mpfr_set_ui (rem, 0, MPFR_RNDN); /* take into account sign of x */ if (signx < 0) mpfr_neg (rem, rem, MPFR_RNDN); } else { if (rnd_q == MPFR_RNDN) { /* FIXME: the comparison 2*r < my could be done more efficiently at the mpn level */ mpz_mul_2exp (r, r, 1); /* if tiny=1, we should compare r with my*2^(ey-ex) */ if (tiny) { if (ex + (mpfr_exp_t) mpz_sizeinbase (r, 2) < ey + (mpfr_exp_t) mpz_sizeinbase (my, 2)) compare = 0; /* r*2^ex < my*2^ey */ else { mpz_mul_2exp (my, my, ey - ex); compare = mpz_cmpabs (r, my); } } else compare = mpz_cmpabs (r, my); mpz_fdiv_q_2exp (r, r, 1); compare = ((compare > 0) || ((rnd_q == MPFR_RNDN) && (compare == 0) && q_is_odd)); /* if compare != 0, we need to subtract my to r, and add 1 to quo */ if (compare) { mpz_sub (r, r, my); if (quo && (rnd_q == MPFR_RNDN)) *quo += 1; } } /* take into account sign of x */ if (signx < 0) mpz_neg (r, r); inex = mpfr_set_z_2exp (rem, r, ex > ey ? ey : ex, rnd); } if (quo) *quo *= sign; mpz_clear (mx); mpz_clear (my); mpz_clear (r); return inex; }

/* 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 mpfr_digamma (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { int inex; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(y), mpfr_log_prec, y, inex)); if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(x))) { if (MPFR_IS_NAN(x)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } else if (MPFR_IS_INF(x)) { if (MPFR_IS_POS(x)) /* Digamma(+Inf) = +Inf */ { MPFR_SET_SAME_SIGN(y, x); MPFR_SET_INF(y); MPFR_RET(0); } else /* Digamma(-Inf) = NaN */ { MPFR_SET_NAN(y); MPFR_RET_NAN; } } else /* Zero case */ { /* the following works also in case of overlap */ MPFR_SET_INF(y); MPFR_SET_OPPOSITE_SIGN(y, x); mpfr_set_divby0 (); MPFR_RET(0); } } /* Digamma is undefined for negative integers */ if (MPFR_IS_NEG(x) && mpfr_integer_p (x)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } /* now x is a normal number */ MPFR_SAVE_EXPO_MARK (expo); /* for x very small, we have Digamma(x) = -1/x - gamma + O(x), more precisely -1 < Digamma(x) + 1/x < 0 for -0.2 < x < 0.2, thus: (i) either x is a power of two, then 1/x is exactly representable, and as long as 1/2*ulp(1/x) > 1, we can conclude; (ii) otherwise assume x has <= n bits, and y has <= n+1 bits, then |y + 1/x| >= 2^(-2n) ufp(y), where ufp means unit in first place. Since |Digamma(x) + 1/x| <= 1, if 2^(-2n) ufp(y) >= 2, then |y - Digamma(x)| >= 2^(-2n-1)ufp(y), and rounding -1/x gives the correct result. If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1). A sufficient condition is thus EXP(x) <= -2 MAX(PREC(x),PREC(Y)). */ if (MPFR_EXP(x) < -2) { if (MPFR_EXP(x) <= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(y))) { int signx = MPFR_SIGN(x); inex = mpfr_si_div (y, -1, x, rnd_mode); if (inex == 0) /* x is a power of two */ { /* result always -1/x, except when rounding down */ if (rnd_mode == MPFR_RNDA) rnd_mode = (signx > 0) ? MPFR_RNDD : MPFR_RNDU; if (rnd_mode == MPFR_RNDZ) rnd_mode = (signx > 0) ? MPFR_RNDU : MPFR_RNDD; if (rnd_mode == MPFR_RNDU) inex = 1; else if (rnd_mode == MPFR_RNDD) { mpfr_nextbelow (y); inex = -1; } else /* nearest */ inex = 1; } MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags); goto end; } } if (MPFR_IS_NEG(x)) inex = mpfr_digamma_reflection (y, x, rnd_mode); /* if x < 1/2 we use the reflection formula */ else if (MPFR_EXP(x) < 0) inex = mpfr_digamma_reflection (y, x, rnd_mode); else inex = mpfr_digamma_positive (y, x, rnd_mode); end: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inex, rnd_mode); }

int mpfr_acos (mpfr_ptr acos, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xp, arcc, tmp; mpfr_exp_t supplement; mpfr_prec_t prec; int sign, compared, inexact; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode), ("acos[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(acos), mpfr_log_prec, acos, inexact)); /* Singular cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (acos); MPFR_RET_NAN; } else /* necessarily x=0 */ { MPFR_ASSERTD(MPFR_IS_ZERO(x)); /* acos(0)=Pi/2 */ MPFR_SAVE_EXPO_MARK (expo); inexact = mpfr_const_pi (acos, rnd_mode); mpfr_div_2ui (acos, acos, 1, rnd_mode); /* exact */ MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (acos, inexact, rnd_mode); } } /* Set x_p=|x| */ sign = MPFR_SIGN (x); mpfr_init2 (xp, MPFR_PREC (x)); mpfr_abs (xp, x, MPFR_RNDN); /* Exact */ compared = mpfr_cmp_ui (xp, 1); if (MPFR_UNLIKELY (compared >= 0)) { mpfr_clear (xp); if (compared > 0) /* acos(x) = NaN for x > 1 */ { MPFR_SET_NAN(acos); MPFR_RET_NAN; } else { if (MPFR_IS_POS_SIGN (sign)) /* acos(+1) = +0 */ return mpfr_set_ui (acos, 0, rnd_mode); else /* acos(-1) = Pi */ return mpfr_const_pi (acos, rnd_mode); } } MPFR_SAVE_EXPO_MARK (expo); /* Compute the supplement */ mpfr_ui_sub (xp, 1, xp, MPFR_RNDD); if (MPFR_IS_POS_SIGN (sign)) supplement = 2 - 2 * MPFR_GET_EXP (xp); else supplement = 2 - MPFR_GET_EXP (xp); mpfr_clear (xp); prec = MPFR_PREC (acos); prec += MPFR_INT_CEIL_LOG2(prec) + 10 + supplement; /* VL: The following change concerning prec comes from r3145 "Optimize mpfr_acos by choosing a better initial precision." but it doesn't seem to be correct and leads to problems (assertion failure or very important inefficiency) with tiny arguments. Therefore, I've disabled it. */ /* If x ~ 2^-N, acos(x) ~ PI/2 - x - x^3/6 If Prec < 2*N, we can't round since x^3/6 won't be counted. */ #if 0 if (MPFR_PREC (acos) >= MPFR_PREC (x) && MPFR_GET_EXP (x) < 0) { mpfr_uexp_t pmin = (mpfr_uexp_t) (-2 * MPFR_GET_EXP (x)) + 5; MPFR_ASSERTN (pmin <= MPFR_PREC_MAX); if (prec < pmin) prec = pmin; } #endif mpfr_init2 (tmp, prec); mpfr_init2 (arcc, prec); MPFR_ZIV_INIT (loop, prec); for (;;) { /* acos(x) = Pi/2 - asin(x) = Pi/2 - atan(x/sqrt(1-x^2)) */ mpfr_sqr (tmp, x, MPFR_RNDN); mpfr_ui_sub (tmp, 1, tmp, MPFR_RNDN); mpfr_sqrt (tmp, tmp, MPFR_RNDN); mpfr_div (tmp, x, tmp, MPFR_RNDN); mpfr_atan (arcc, tmp, MPFR_RNDN); mpfr_const_pi (tmp, MPFR_RNDN); mpfr_div_2ui (tmp, tmp, 1, MPFR_RNDN); mpfr_sub (arcc, tmp, arcc, MPFR_RNDN); if (MPFR_LIKELY (MPFR_CAN_ROUND (arcc, prec - supplement, MPFR_PREC (acos), rnd_mode))) break; MPFR_ZIV_NEXT (loop, prec); mpfr_set_prec (tmp, prec); mpfr_set_prec (arcc, prec); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (acos, arcc, rnd_mode); mpfr_clear (tmp); mpfr_clear (arcc); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (acos, inexact, rnd_mode); }

static void overfl_exp10_0 (void) { mpfr_t x, y; int emax, i, inex, rnd, err = 0; mpfr_exp_t old_emax; old_emax = mpfr_get_emax (); mpfr_init2 (x, 8); mpfr_init2 (y, 8); for (emax = -1; emax <= 0; emax++) { mpfr_set_ui_2exp (y, 1, emax, MPFR_RNDN); mpfr_nextbelow (y); set_emax (emax); /* 1 is not representable. */ /* and if emax < 0, 1 - eps is not representable either. */ for (i = -1; i <= 1; i++) RND_LOOP (rnd) { mpfr_set_si_2exp (x, i, -512 * ABS (i), MPFR_RNDN); mpfr_clear_flags (); inex = mpfr_exp10 (x, x, (mpfr_rnd_t) rnd); if ((i >= 0 || emax < 0 || rnd == MPFR_RNDN || rnd == MPFR_RNDU) && ! mpfr_overflow_p ()) { printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n" " The overflow flag is not set.\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); err = 1; } if (rnd == MPFR_RNDZ || rnd == MPFR_RNDD) { if (inex >= 0) { printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n" " The inexact value must be negative.\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); err = 1; } if (! mpfr_equal_p (x, y)) { printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n" " Got ", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); mpfr_print_binary (x); printf (" instead of 0.11111111E%d.\n", emax); err = 1; } } else { if (inex <= 0) { printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n" " The inexact value must be positive.\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); err = 1; } if (! (mpfr_inf_p (x) && MPFR_SIGN (x) > 0)) { printf ("Error in overfl_exp10_0 (i = %d, rnd = %s):\n" " Got ", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); mpfr_print_binary (x); printf (" instead of +Inf.\n"); err = 1; } } } set_emax (old_emax); } if (err) exit (1); mpfr_clear (x); mpfr_clear (y); }

static int mpfr_mul3 (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { /* Old implementation */ int sign_product, cc, inexact; mpfr_exp_t ax; mp_limb_t *tmp; mp_limb_t b1; mpfr_prec_t bq, cq; mp_size_t bn, cn, tn, k; MPFR_TMP_DECL(marker); /* deal with special cases */ if (MPFR_ARE_SINGULAR(b,c)) { if (MPFR_IS_NAN(b) || MPFR_IS_NAN(c)) { MPFR_SET_NAN(a); MPFR_RET_NAN; } sign_product = MPFR_MULT_SIGN( MPFR_SIGN(b) , MPFR_SIGN(c) ); if (MPFR_IS_INF(b)) { if (MPFR_IS_INF(c) || MPFR_NOTZERO(c)) { MPFR_SET_SIGN(a,sign_product); MPFR_SET_INF(a); MPFR_RET(0); /* exact */ } else { MPFR_SET_NAN(a); MPFR_RET_NAN; } } else if (MPFR_IS_INF(c)) { if (MPFR_NOTZERO(b)) { MPFR_SET_SIGN(a, sign_product); MPFR_SET_INF(a); MPFR_RET(0); /* exact */ } else { MPFR_SET_NAN(a); MPFR_RET_NAN; } } else { MPFR_ASSERTD(MPFR_IS_ZERO(b) || MPFR_IS_ZERO(c)); MPFR_SET_SIGN(a, sign_product); MPFR_SET_ZERO(a); MPFR_RET(0); /* 0 * 0 is exact */ } } sign_product = MPFR_MULT_SIGN( MPFR_SIGN(b) , MPFR_SIGN(c) ); ax = MPFR_GET_EXP (b) + MPFR_GET_EXP (c); bq = MPFR_PREC(b); cq = MPFR_PREC(c); MPFR_ASSERTD(bq+cq > bq); /* PREC_MAX is /2 so no integer overflow */ bn = (bq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of b */ cn = (cq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of c */ k = bn + cn; /* effective nb of limbs used by b*c (= tn or tn+1) below */ tn = (bq + cq + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; /* <= k, thus no int overflow */ MPFR_ASSERTD(tn <= k); /* Check for no size_t overflow*/ MPFR_ASSERTD((size_t) k <= ((size_t) -1) / BYTES_PER_MP_LIMB); MPFR_TMP_MARK(marker); tmp = (mp_limb_t *) MPFR_TMP_ALLOC((size_t) k * BYTES_PER_MP_LIMB); /* multiplies two mantissa in temporary allocated space */ b1 = (MPFR_LIKELY(bn >= cn)) ? mpn_mul (tmp, MPFR_MANT(b), bn, MPFR_MANT(c), cn) : mpn_mul (tmp, MPFR_MANT(c), cn, MPFR_MANT(b), bn); /* now tmp[0]..tmp[k-1] contains the product of both mantissa, with tmp[k-1]>=2^(GMP_NUMB_BITS-2) */ b1 >>= GMP_NUMB_BITS - 1; /* msb from the product */ /* if the mantissas of b and c are uniformly distributed in ]1/2, 1], then their product is in ]1/4, 1/2] with probability 2*ln(2)-1 ~ 0.386 and in [1/2, 1] with probability 2-2*ln(2) ~ 0.614 */ tmp += k - tn; if (MPFR_UNLIKELY(b1 == 0)) mpn_lshift (tmp, tmp, tn, 1); /* tn <= k, so no stack corruption */ cc = mpfr_round_raw (MPFR_MANT (a), tmp, bq + cq, MPFR_IS_NEG_SIGN(sign_product), MPFR_PREC (a), rnd_mode, &inexact); /* cc = 1 ==> result is a power of two */ if (MPFR_UNLIKELY(cc)) MPFR_MANT(a)[MPFR_LIMB_SIZE(a)-1] = MPFR_LIMB_HIGHBIT; MPFR_TMP_FREE(marker); { mpfr_exp_t ax2 = ax + (mpfr_exp_t) (b1 - 1 + cc); if (MPFR_UNLIKELY( ax2 > __gmpfr_emax)) return mpfr_overflow (a, rnd_mode, sign_product); if (MPFR_UNLIKELY( ax2 < __gmpfr_emin)) { /* In the rounding to the nearest mode, if the exponent of the exact result (i.e. before rounding, i.e. without taking cc into account) is < __gmpfr_emin - 1 or the exact result is a power of 2 (i.e. if both arguments are powers of 2), then round to zero. */ if (rnd_mode == MPFR_RNDN && (ax + (mpfr_exp_t) b1 < __gmpfr_emin || (mpfr_powerof2_raw (b) && mpfr_powerof2_raw (c)))) rnd_mode = MPFR_RNDZ; return mpfr_underflow (a, rnd_mode, sign_product); } MPFR_SET_EXP (a, ax2); MPFR_SET_SIGN(a, sign_product); } MPFR_RET (inexact); }

static void test_overflow2 (void) { mpfr_t x, y, z, r; int i, inex, rnd, err = 0; mpfr_inits2 (8, x, y, z, r, (mpfr_ptr) 0); MPFR_SET_POS (x); mpfr_setmin (x, mpfr_get_emax ()); /* x = [email protected] */ mpfr_set_si (y, -2, MPFR_RNDN); /* y = -2 */ /* The intermediate multiplication x * y will overflow. */ for (i = -9; i <= 9; i++) RND_LOOP (rnd) { int inf, overflow; inf = rnd == MPFR_RNDN || rnd == MPFR_RNDD || rnd == MPFR_RNDA; overflow = inf || i <= 0; inex = mpfr_set_si_2exp (z, i, mpfr_get_emin (), MPFR_RNDN); MPFR_ASSERTN (inex == 0); mpfr_clear_flags (); /* One has: x * y = [email protected] exactly (but not representable). */ inex = mpfr_fma (r, x, y, z, (mpfr_rnd_t) rnd); if (overflow ^ (mpfr_overflow_p () != 0)) { printf ("Error in test_overflow2 (i = %d, %s): wrong overflow" " flag (should be %d)\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), overflow); err = 1; } if (mpfr_nanflag_p ()) { printf ("Error in test_overflow2 (i = %d, %s): NaN flag should" " not be set\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); err = 1; } if (mpfr_nan_p (r)) { printf ("Error in test_overflow2 (i = %d, %s): got NaN\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); err = 1; } else if (MPFR_SIGN (r) >= 0) { printf ("Error in test_overflow2 (i = %d, %s): wrong sign " "(+ instead of -)\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); err = 1; } else if (inf && ! mpfr_inf_p (r)) { printf ("Error in test_overflow2 (i = %d, %s): expected -Inf," " got\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); mpfr_dump (r); err = 1; } else if (!inf && (mpfr_inf_p (r) || (mpfr_nextbelow (r), ! mpfr_inf_p (r)))) { printf ("Error in test_overflow2 (i = %d, %s): expected -MAX," " got\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd)); mpfr_dump (r); err = 1; } if (inf ? inex >= 0 : inex <= 0) { printf ("Error in test_overflow2 (i = %d, %s): wrong inexact" " flag (got %d)\n", i, mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), inex); err = 1; } } if (err) exit (1); mpfr_clears (x, y, z, r, (mpfr_ptr) 0); }

int main (void) { mpfr_t x, y; float f, g, infp; int i; infp = (float) DBL_POS_INF; if (infp * 0.5 != infp) { fprintf (stderr, "Error, FLT_MAX + FLT_MAX does not yield INFP\n"); fprintf (stderr, "(this is probably a compiler bug, please report)\n"); exit (1); } tests_start_mpfr (); mpfr_init2 (x, 24); mpfr_init2 (y, 24); #if !defined(MPFR_ERRDIVZERO) mpfr_set_nan (x); f = mpfr_get_flt (x, MPFR_RNDN); if (f == f) { printf ("Error for mpfr_get_flt(NaN)\n"); exit (1); } mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_nan_p (x) == 0) { printf ("Error for mpfr_set_flt(NaN)\n"); exit (1); } mpfr_set_inf (x, 1); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_inf_p (x) == 0 || mpfr_sgn (x) < 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(+Inf)):\n"); printf ("f=%f, expected -Inf\n", f); printf ("got "); mpfr_dump (x); exit (1); } mpfr_set_inf (x, -1); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_inf_p (x) == 0 || mpfr_sgn (x) > 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(-Inf)):\n"); printf ("f=%f, expected -Inf\n", f); printf ("got "); mpfr_dump (x); exit (1); } #endif mpfr_set_ui (x, 0, MPFR_RNDN); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_zero_p (x) == 0 || MPFR_SIGN (x) < 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(+0))\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_neg (x, x, MPFR_RNDN); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_zero_p (x) == 0 || MPFR_SIGN (x) > 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(-0))\n"); exit (1); } mpfr_set_ui (x, 17, MPFR_RNDN); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_cmp_ui (x, 17) != 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(17))\n"); printf ("expected 17\n"); printf ("got "); mpfr_dump (x); exit (1); } mpfr_set_si (x, -42, MPFR_RNDN); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (x, f, MPFR_RNDN); if (mpfr_cmp_si (x, -42) != 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(-42))\n"); printf ("expected -42\n"); printf ("got "); mpfr_dump (x); exit (1); } mpfr_set_si_2exp (x, 1, -126, MPFR_RNDN); for (i = -126; i < 128; i++) { f = mpfr_get_flt (x, MPFR_RNDN); mpfr_set_flt (y, f, MPFR_RNDN); if (mpfr_cmp (x, y) != 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(x))\n"); printf ("expected "); mpfr_dump (x); printf ("got "); mpfr_dump (y); exit (1); } mpfr_mul_2exp (x, x, 1, MPFR_RNDN); } mpfr_set_prec (x, 53); mpfr_set_si_2exp (x, 1, -126, MPFR_RNDN); for (i = -126; i < 128; i++) { mpfr_nextbelow (x); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_nextabove (x); mpfr_set_flt (y, f, MPFR_RNDN); if (mpfr_cmp (x, y) != 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(x))\n"); printf ("expected "); mpfr_dump (x); printf ("got "); mpfr_dump (y); exit (1); } mpfr_mul_2exp (x, x, 1, MPFR_RNDN); } mpfr_set_prec (x, 53); mpfr_set_si_2exp (x, 1, -126, MPFR_RNDN); for (i = -126; i < 128; i++) { mpfr_nextabove (x); f = mpfr_get_flt (x, MPFR_RNDN); mpfr_nextbelow (x); mpfr_set_flt (y, f, MPFR_RNDN); if (mpfr_cmp (x, y) != 0) { printf ("Error for mpfr_set_flt(mpfr_get_flt(x))\n"); printf ("expected "); mpfr_dump (x); printf ("got "); mpfr_dump (y); exit (1); } mpfr_mul_2exp (x, x, 1, MPFR_RNDN); } mpfr_set_si_2exp (x, 1, -150, MPFR_RNDN); g = 0.0; f = mpfr_get_flt (x, MPFR_RNDN); if (f != g) { printf ("Error for mpfr_get_flt(2^(-150),RNDN)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDZ); if (f != g) { printf ("Error for mpfr_get_flt(2^(-150),RNDZ)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDD); if (f != g) { printf ("Error for mpfr_get_flt(2^(-150),RNDD)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } g = FLT_MIN * FLT_EPSILON; f = mpfr_get_flt (x, MPFR_RNDU); if (f != g) { printf ("Error for mpfr_get_flt(2^(-150),RNDU)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDA); if (f != g) { printf ("Error for mpfr_get_flt(2^(-150),RNDA)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } mpfr_set_si_2exp (x, 1, -151, MPFR_RNDN); g = 0.0; f = mpfr_get_flt (x, MPFR_RNDN); if (f != g) { printf ("Error for mpfr_get_flt(2^(-151),RNDN)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDZ); if (f != g) { printf ("Error for mpfr_get_flt(2^(-151),RNDZ)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDD); if (f != g) { printf ("Error for mpfr_get_flt(2^(-151),RNDD)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } g = FLT_MIN * FLT_EPSILON; f = mpfr_get_flt (x, MPFR_RNDU); if (f != g) { printf ("Error for mpfr_get_flt(2^(-151),RNDU)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDA); if (f != g) { printf ("Error for mpfr_get_flt(2^(-151),RNDA)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } mpfr_set_si_2exp (x, 1, -149, MPFR_RNDN); g = FLT_MIN * FLT_EPSILON; f = mpfr_get_flt (x, MPFR_RNDN); if (f != g) { printf ("Error for mpfr_get_flt(2^(-149),RNDN)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDZ); if (f != g) { printf ("Error for mpfr_get_flt(2^(-149),RNDZ)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDD); if (f != g) { printf ("Error for mpfr_get_flt(2^(-149),RNDD)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDU); if (f != g) { printf ("Error for mpfr_get_flt(2^(-149),RNDU)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDA); if (f != g) { printf ("Error for mpfr_get_flt(2^(-149),RNDA)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } mpfr_set_si_2exp (x, 1, 128, MPFR_RNDN); g = FLT_MAX; f = mpfr_get_flt (x, MPFR_RNDZ); if (f != g) { printf ("Error for mpfr_get_flt(2^128,RNDZ)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDD); if (f != g) { printf ("Error for mpfr_get_flt(2^128,RNDD)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } #if !defined(MPFR_ERRDIVZERO) f = mpfr_get_flt (x, MPFR_RNDN); /* 2^128 rounds to itself with extended exponent range, we should get +Inf */ g = infp; if (f != g) { printf ("Error for mpfr_get_flt(2^128,RNDN)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDU); if (f != g) { printf ("Error for mpfr_get_flt(2^128,RNDU)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDA); if (f != g) { printf ("Error for mpfr_get_flt(2^128,RNDA)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } #endif /* corner case: take x with 25 bits just below 2^128 */ mpfr_set_prec (x, 25); mpfr_set_si_2exp (x, 1, 128, MPFR_RNDN); mpfr_nextbelow (x); g = FLT_MAX; f = mpfr_get_flt (x, MPFR_RNDZ); if (f != g) { printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDZ)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDD); if (f != g) { printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDD)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDN); /* first round to 2^128 (even rule), thus we should get +Inf */ g = infp; if (f != g) { printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDN)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDU); if (f != g) { printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDU)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } f = mpfr_get_flt (x, MPFR_RNDA); if (f != g) { printf ("Error for mpfr_get_flt(2^128*(1-2^(-25)),RNDA)\n"); printf ("expected %.8e, got %.8e\n", g, f); exit (1); } mpfr_clear (x); mpfr_clear (y); tests_end_mpfr (); return 0; }

int mpfr_pow_si (mpfr_ptr y, mpfr_srcptr x, long int n, mpfr_rnd_t rnd) { MPFR_LOG_FUNC (("x[%Pu]=%.*Rg n=%ld rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, n, rnd), ("y[%Pu]=%.*Rg", mpfr_get_prec (y), mpfr_log_prec, y)); if (n >= 0) return mpfr_pow_ui (y, x, n, rnd); else { if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else { int positive = MPFR_IS_POS (x) || ((unsigned long) n & 1) == 0; if (MPFR_IS_INF (x)) MPFR_SET_ZERO (y); else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_INF (y); mpfr_set_divby0 (); } if (positive) MPFR_SET_POS (y); else MPFR_SET_NEG (y); MPFR_RET (0); } } /* detect exact powers: x^(-n) is exact iff x is a power of 2 */ if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), MPFR_EXP(x) - 1) == 0) { mpfr_exp_t expx = MPFR_EXP (x) - 1, expy; MPFR_ASSERTD (n < 0); /* Warning: n * expx may overflow! * * Some systems (apparently alpha-freebsd) abort with * LONG_MIN / 1, and LONG_MIN / -1 is undefined. * http://www.freebsd.org/cgi/query-pr.cgi?pr=72024 * * Proof of the overflow checking. The expressions below are * assumed to be on the rational numbers, but the word "overflow" * still has its own meaning in the C context. / still denotes * the integer (truncated) division, and // denotes the exact * division. * - First, (__gmpfr_emin - 1) / n and (__gmpfr_emax - 1) / n * cannot overflow due to the constraints on the exponents of * MPFR numbers. * - If n = -1, then n * expx = - expx, which is representable * because of the constraints on the exponents of MPFR numbers. * - If expx = 0, then n * expx = 0, which is representable. * - If n < -1 and expx > 0: * + If expx > (__gmpfr_emin - 1) / n, then * expx >= (__gmpfr_emin - 1) / n + 1 * > (__gmpfr_emin - 1) // n, * and * n * expx < __gmpfr_emin - 1, * i.e. * n * expx <= __gmpfr_emin - 2. * This corresponds to an underflow, with a null result in * the rounding-to-nearest mode. * + If expx <= (__gmpfr_emin - 1) / n, then n * expx cannot * overflow since 0 < expx <= (__gmpfr_emin - 1) / n and * 0 > n * expx >= n * ((__gmpfr_emin - 1) / n) * >= __gmpfr_emin - 1. * - If n < -1 and expx < 0: * + If expx < (__gmpfr_emax - 1) / n, then * expx <= (__gmpfr_emax - 1) / n - 1 * < (__gmpfr_emax - 1) // n, * and * n * expx > __gmpfr_emax - 1, * i.e. * n * expx >= __gmpfr_emax. * This corresponds to an overflow (2^(n * expx) has an * exponent > __gmpfr_emax). * + If expx >= (__gmpfr_emax - 1) / n, then n * expx cannot * overflow since 0 > expx >= (__gmpfr_emax - 1) / n and * 0 < n * expx <= n * ((__gmpfr_emax - 1) / n) * <= __gmpfr_emax - 1. * Note: one could use expx bounds based on MPFR_EXP_MIN and * MPFR_EXP_MAX instead of __gmpfr_emin and __gmpfr_emax. The * current bounds do not lead to noticeably slower code and * allow us to avoid a bug in Sun's compiler for Solaris/x86 * (when optimizations are enabled); known affected versions: * cc: Sun C 5.8 2005/10/13 * cc: Sun C 5.8 Patch 121016-02 2006/03/31 * cc: Sun C 5.8 Patch 121016-04 2006/10/18 */ expy = n != -1 && expx > 0 && expx > (__gmpfr_emin - 1) / n ? MPFR_EMIN_MIN - 2 /* Underflow */ : n != -1 && expx < 0 && expx < (__gmpfr_emax - 1) / n ? MPFR_EMAX_MAX /* Overflow */ : n * expx; return mpfr_set_si_2exp (y, n % 2 ? MPFR_INT_SIGN (x) : 1, expy, rnd); } /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t; /* Declaration of the size variable */ mpfr_prec_t Ny; /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_rnd_t rnd1; int size_n; int inexact; unsigned long abs_n; MPFR_SAVE_EXPO_DECL (expo); MPFR_ZIV_DECL (loop); abs_n = - (unsigned long) n; count_leading_zeros (size_n, (mp_limb_t) abs_n); size_n = GMP_NUMB_BITS - size_n; /* initial working precision */ Ny = MPFR_PREC (y); Nt = Ny + size_n + 3 + MPFR_INT_CEIL_LOG2 (Ny); MPFR_SAVE_EXPO_MARK (expo); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); /* We will compute rnd(rnd1(1/x) ^ |n|), where rnd1 is the rounding toward sign(x), to avoid spurious overflow or underflow, as in mpfr_pow_z. */ rnd1 = MPFR_EXP (x) < 1 ? MPFR_RNDZ : (MPFR_SIGN (x) > 0 ? MPFR_RNDU : MPFR_RNDD); MPFR_ZIV_INIT (loop, Nt); for (;;) { MPFR_BLOCK_DECL (flags); /* compute (1/x)^|n| */ MPFR_BLOCK (flags, mpfr_ui_div (t, 1, x, rnd1)); MPFR_ASSERTD (! MPFR_UNDERFLOW (flags)); /* t = (1/x)*(1+theta) where |theta| <= 2^(-Nt) */ if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags))) goto overflow; MPFR_BLOCK (flags, mpfr_pow_ui (t, t, abs_n, rnd)); /* t = (1/x)^|n|*(1+theta')^(|n|+1) where |theta'| <= 2^(-Nt). If (|n|+1)*2^(-Nt) <= 1/2, which is satisfied as soon as Nt >= bits(n)+2, then we can use Lemma \ref{lemma_graillat} from algorithms.tex, which yields x^n*(1+theta) with |theta| <= 2(|n|+1)*2^(-Nt), thus the error is bounded by 2(|n|+1) ulps <= 2^(bits(n)+2) ulps. */ if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags))) { overflow: MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); MPFR_LOG_MSG (("overflow\n", 0)); return mpfr_overflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) : MPFR_SIGN_POS); } if (MPFR_UNLIKELY (MPFR_UNDERFLOW (flags))) { MPFR_ZIV_FREE (loop); mpfr_clear (t); MPFR_LOG_MSG (("underflow\n", 0)); if (rnd == MPFR_RNDN) { mpfr_t y2, nn; /* We cannot decide now whether the result should be rounded toward zero or away from zero. So, like in mpfr_pow_pos_z, let's use the general case of mpfr_pow in precision 2. */ MPFR_ASSERTD (mpfr_cmp_si_2exp (x, MPFR_SIGN (x), MPFR_EXP (x) - 1) != 0); mpfr_init2 (y2, 2); mpfr_init2 (nn, sizeof (long) * CHAR_BIT); inexact = mpfr_set_si (nn, n, MPFR_RNDN); MPFR_ASSERTN (inexact == 0); inexact = mpfr_pow_general (y2, x, nn, rnd, 1, (mpfr_save_expo_t *) NULL); mpfr_clear (nn); mpfr_set (y, y2, MPFR_RNDN); mpfr_clear (y2); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_UNDERFLOW); goto end; } else { MPFR_SAVE_EXPO_FREE (expo); return mpfr_underflow (y, rnd, abs_n & 1 ? MPFR_SIGN (x) : MPFR_SIGN_POS); } } /* error estimate -- see pow function in algorithms.ps */ if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - size_n - 2, Ny, rnd))) break; /* actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, t, rnd); mpfr_clear (t); end: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd); } } }

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 main (int argc, char *argv[]) { mpfr_t x, y; unsigned long k, bd, nc, i; char *str, *str2; mpfr_exp_t e; int base, logbase, prec, baseprec, ret, obase; tests_start_mpfr (); if (argc >= 2) /* tset_str <string> [<prec>] [<ibase>] [<obase>] */ { prec = (argc >= 3) ? atoi (argv[2]) : 53; base = (argc >= 4) ? atoi (argv[3]) : 2; obase = (argc >= 5) ? atoi (argv[4]) : 10; mpfr_init2 (x, prec); mpfr_set_str (x, argv[1], base, MPFR_RNDN); mpfr_out_str (stdout, obase, 0, x, MPFR_RNDN); puts (""); mpfr_clear (x); return 0; } mpfr_init2 (x, 2); nc = (argc > 1) ? atoi(argv[1]) : 53; if (nc < 100) nc = 100; bd = randlimb () & 8; str2 = str = (char*) (*__gmp_allocate_func) (nc); if (bd) { for(k = 1; k <= bd; k++) *(str2++) = (randlimb () & 1) + '0'; } else *(str2++) = '0'; *(str2++) = '.'; for (k = 1; k < nc - 17 - bd; k++) *(str2++) = '0' + (char) (randlimb () & 1); *(str2++) = 'e'; sprintf (str2, "%d", (int) (randlimb () & INT_MAX) + INT_MIN/2); mpfr_set_prec (x, nc + 10); mpfr_set_str_binary (x, str); mpfr_set_prec (x, 54); mpfr_set_str_binary (x, "0.100100100110110101001010010101111000001011100100101010E-529"); mpfr_init2 (y, 54); mpfr_set_str (y, "[email protected]", 16, MPFR_RNDN); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (1a):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str_binary (x, "0.111111101101110010111010100110000111011001010100001101E-529"); mpfr_set_str (y, "0.fedcba98765434P-529", 16, MPFR_RNDN); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (1b):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } (*__gmp_free_func) (str, nc); mpfr_set_prec (x, 53); mpfr_set_str_binary (x, "+110101100.01010000101101000000100111001000101011101110E00"); mpfr_set_str_binary (x, "1.0"); if (mpfr_cmp_ui (x, 1)) { printf ("Error in mpfr_set_str_binary for s=1.0\n"); mpfr_clear(x); mpfr_clear(y); exit(1); } mpfr_set_str_binary (x, "+0000"); mpfr_set_str_binary (x, "+0000E0"); mpfr_set_str_binary (x, "0000E0"); if (mpfr_cmp_ui (x, 0)) { printf ("Error in mpfr_set_str_binary for s=0.0\n"); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (x, "+243495834958.53452345E1", 10, MPFR_RNDN); mpfr_set_str (x, "9007199254740993", 10, MPFR_RNDN); mpfr_set_str (x, "9007199254740992", 10, MPFR_RNDU); mpfr_set_str (x, "9007199254740992", 10, MPFR_RNDD); mpfr_set_str (x, "9007199254740992", 10, MPFR_RNDZ); /* check a random number printed and read is not modified */ prec = 53; mpfr_set_prec (x, prec); mpfr_set_prec (y, prec); for (i=0;i<N;i++) { mpfr_rnd_t rnd; mpfr_urandomb (x, RANDS); rnd = RND_RAND (); logbase = (randlimb () % 5) + 1; base = 1 << logbase; /* Warning: the number of bits needed to print exactly a number of 'prec' bits in base 2^logbase may be greater than ceil(prec/logbase), for example 0.11E-1 in base 2 cannot be written exactly with only one digit in base 4 */ if (base == 2) baseprec = prec; else baseprec = 1 + (prec - 2 + logbase) / logbase; str = mpfr_get_str (NULL, &e, base, baseprec, x, rnd); mpfr_set_str (y, str, base, rnd); MPFR_EXP(y) += logbase * (e - strlen (str)); if (mpfr_cmp (x, y)) { printf ("mpfr_set_str o mpfr_get_str <> id for rnd_mode=%s\n", mpfr_print_rnd_mode (rnd)); printf ("x="); mpfr_print_binary (x); puts (""); printf ("s=%s, exp=%d, base=%d\n", str, (int) e, base); printf ("y="); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } (*__gmp_free_func) (str, strlen (str) + 1); } for (i = 2; i <= 62; i++) { if (mpfr_set_str (x, "@[email protected](garbage)", i, MPFR_RNDN) != 0 || !mpfr_nan_p(x)) { printf ("mpfr_set_str failed on @[email protected](garbage)\n"); exit (1); } /* if (mpfr_set_str (x, "@[email protected]", i, MPFR_RNDN) != 0 || !mpfr_inf_p(x) || MPFR_SIGN(x) < 0) { printf ("mpfr_set_str failed on @[email protected]\n"); exit (1); } if (mpfr_set_str (x, "[email protected]@garbage", i, MPFR_RNDN) != 0 || !mpfr_inf_p(x) || MPFR_SIGN(x) > 0) { printf ("mpfr_set_str failed on [email protected]@garbage\n"); exit (1); } if (mpfr_set_str (x, "[email protected]@garbage", i, MPFR_RNDN) != 0 || !mpfr_inf_p(x) || MPFR_SIGN(x) < 0) { printf ("mpfr_set_str failed on [email protected]@garbage\n"); exit (1); } */ if (i > 16) continue; if (mpfr_set_str (x, "NaN", i, MPFR_RNDN) != 0 || !mpfr_nan_p(x)) { printf ("mpfr_set_str failed on NaN\n"); exit (1); } if (mpfr_set_str (x, "Inf", i, MPFR_RNDN) != 0 || !mpfr_inf_p(x) || MPFR_SIGN(x) < 0) { printf ("mpfr_set_str failed on Inf\n"); exit (1); } if (mpfr_set_str (x, "-Inf", i, MPFR_RNDN) != 0 || !mpfr_inf_p(x) || MPFR_SIGN(x) > 0) { printf ("mpfr_set_str failed on -Inf\n"); exit (1); } if (mpfr_set_str (x, "+Inf", i, MPFR_RNDN) != 0 || !mpfr_inf_p(x) || MPFR_SIGN(x) < 0) { printf ("mpfr_set_str failed on +Inf\n"); exit (1); } } /* check that mpfr_set_str works for uppercase letters too */ mpfr_set_prec (x, 10); mpfr_set_str (x, "B", 16, MPFR_RNDN); if (mpfr_cmp_ui (x, 11) != 0) { printf ("mpfr_set_str does not work for uppercase letters\n"); exit (1); } /* start of tests added by Alain Delplanque */ /* in this example an overflow can occur */ mpfr_set_prec (x, 64); mpfr_set_prec (y, 64); mpfr_set_str_binary (x, "1.0E-532"); mpfr_set_str (y, "[email protected]", 10, MPFR_RNDU); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (2):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } /* in this example, I think there was a pb in the old function : result of mpfr_set_str_old for the same number , but with more precision is: 1.111111111110000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100111000100001100000010101100111010e184 this result is the same as mpfr_set_str */ mpfr_set_prec (x, 64); mpfr_set_prec (y, 64); mpfr_set_str_binary (x, "1.111111111110000000000000000111111111111111111111111110000000001E184"); mpfr_set_str (y, "[email protected]", 27, MPFR_RNDU); /* y = 49027884868983130654865109690613178467841148597221480052 */ if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (3):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } /* not exact rounding in mpfr_set_str same number with more precision is : 1.111111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011011111101000001101110110010101101000010100110011101110010001110e195 this result is the same as mpfr_set_str */ /* problem was : can_round was call with MPFR_RNDN round mode, so can_round use an error : 1/2 * 2^err * ulp(y) instead of 2^err * ulp(y) I have increase err by 1 */ mpfr_set_prec (x, 64); /* it was round down instead of up */ mpfr_set_prec (y, 64); mpfr_set_str_binary (x, "1.111111111111111111111111111000000000000000000000000000000000001e195"); mpfr_set_str (y, "[email protected]", 21, MPFR_RNDU); /* y = 100433627392042473064661483711179345482301462325708736552078 */ if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (4):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } /* may be an error in mpfr_set_str_old with more precision : 1.111111100000001111110000000000011111011111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111110111101010001110111011000010111001011100110110e180 */ mpfr_set_prec (x, 64); /* it was round down instead of up */ mpfr_set_prec (y, 64); mpfr_set_str_binary (x, "1.111111100000001111110000000000011111011111111111111111111111111e180"); mpfr_set_str (y, "[email protected]", 23, MPFR_RNDZ); /* y = 3053110535624388280648330929253842828159081875986159414 */ if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (5):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_prec (x, 64); mpfr_set_prec (y, 64); mpfr_set_str (y, "[email protected]", 28, MPFR_RNDU); /* y = 196159429139499688661464718784226062699788036696626429952 */ mpfr_set_str_binary (x, "0.1111111111111111111111111111111000000000000011100000001111100001E187"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (6):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_prec (x, 64); mpfr_set_prec (y, 64); mpfr_set_str (y, "[email protected]", 24, MPFR_RNDZ); /* y = 52652933527468502324759448399183654588831274530295083078827114496 */ mpfr_set_str_binary (x, "0.1111111111111100000000001000000000000000000011111111111111101111E215"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (7):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } /* worst cases for rounding to nearest in double precision */ mpfr_set_prec (x, 53); mpfr_set_prec (y, 53); mpfr_set_str (y, "5e125", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10111101000101110110011000100000101001010000000111111E418"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (8):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "69e267", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10000101101111100101101100000110010011001010011011010E894"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (9):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "623e100", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10110010000001010011000101111001110101000001111011111E342"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (10):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "3571e263", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10110001001100100010011000110000111010100000110101010E886"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (11):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "75569e-254", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10101101001000110001011011001000111000110101010110011E-827"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (12):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "920657e-23", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10101001110101001100110000101110110111101111001101100E-56"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (13):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "9210917e80", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.11101101000100011001000110100011111100110000000110010E289"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (14):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "87575437e-309", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.11110000001110011001000000110000000100000010101101100E-1000"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (15):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "245540327e122", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10001101101100010001100011110000110001100010111001011E434"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (16):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "491080654e122", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10001101101100010001100011110000110001100010111001011E435"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (17):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } mpfr_set_str (y, "83356057653e193", 10, MPFR_RNDN); mpfr_set_str_binary (x, "0.10101010001001110011011011010111011100010101000011000E678"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_set_str (18):\n"); mpfr_print_binary (x); puts (""); mpfr_print_binary (y); puts (""); mpfr_clear (x); mpfr_clear (y); exit (1); } CHECK53(y, "83356057653e193", MPFR_RNDN, x, "0.10101010001001110011011011010111011100010101000011000E678", 18); CHECK53(y, "619534293513e124", MPFR_RNDN, x, "0.10001000011000010000000110000001111111110000011110001e452", 19); CHECK53(y, "3142213164987e-294", MPFR_RNDN, x, "0.11101001101000000100111011111101111001010001001101111e-935", 20); CHECK53(y, "36167929443327e-159", MPFR_RNDN, x, "0.11100111001110111110000101011001100110010100011111100e-483", 21); CHECK53(y, "904198236083175e-161", MPFR_RNDN, x, "0.11100111001110111110000101011001100110010100011111100e-485", 22); CHECK53(y, "3743626360493413e-165", MPFR_RNDN, x, "0.11000100000100011101001010111101011011011111011111001e-496", 23); CHECK53(y, "94080055902682397e-242", MPFR_RNDN, x, "0.10110010010011000000111100011100111100110011011001010e-747", 24); CHECK53(y, "7e-303", MPFR_RNDD, x, "0.10011001100111001000100110001110001000110111110001011e-1003", 25); CHECK53(y, "7e-303", MPFR_RNDU, x, "0.10011001100111001000100110001110001000110111110001100e-1003", 26); CHECK53(y, "93e-234", MPFR_RNDD, x, "0.10010011110110010111001001111001000010000000001110101E-770", 27); CHECK53(y, "93e-234", MPFR_RNDU, x, "0.10010011110110010111001001111001000010000000001110110E-770", 28); CHECK53(y, "755e174", MPFR_RNDD, x, "0.10111110110010011000110010011111101111000111111000101E588", 29); CHECK53(y, "755e174", MPFR_RNDU, x, "0.10111110110010011000110010011111101111000111111000110E588", 30); CHECK53(y, "8699e-276", MPFR_RNDD, x, "0.10010110100101101111100100100011011101100110100101100E-903", 31); CHECK53(y, "8699e-276", MPFR_RNDU, x, "0.10010110100101101111100100100011011101100110100101101E-903", 32); CHECK53(y, "82081e41", MPFR_RNDD, x, "0.10111000000010000010111011111001111010100011111001011E153", 33); CHECK53(y, "82081e41", MPFR_RNDU, x, "0.10111000000010000010111011111001111010100011111001100E153", 34); CHECK53(y, "584169e229", MPFR_RNDD, x, "0.11101011001010111000001011001110111000111100110101010E780", 35); CHECK53(y, "584169e229", MPFR_RNDU, x, "0.11101011001010111000001011001110111000111100110101011E780", 36); CHECK53(y, "5783893e-128", MPFR_RNDD, x, "0.10011000111100000110011110000101100111110011101110100E-402", 37); CHECK53(y, "5783893e-128", MPFR_RNDU, x, "0.10011000111100000110011110000101100111110011101110101E-402", 38); CHECK53(y, "87575437e-310", MPFR_RNDD, x, "0.11000000001011100000110011110011010000000010001010110E-1003", 39); CHECK53(y, "87575437e-310", MPFR_RNDU, x, "0.11000000001011100000110011110011010000000010001010111E-1003", 40); CHECK53(y, "245540327e121", MPFR_RNDD, x, "0.11100010101101001111010010110100011100000100101000100E430", 41); CHECK53(y, "245540327e121", MPFR_RNDU, x, "0.11100010101101001111010010110100011100000100101000101E430", 42); CHECK53(y, "9078555839e-109", MPFR_RNDD, x, "0.11111110001010111010110000110011100110001010011101101E-329", 43); CHECK53(y, "9078555839e-109", MPFR_RNDU, x, "0.11111110001010111010110000110011100110001010011101110E-329", 44); CHECK53(y, "42333842451e201", MPFR_RNDD, x, "0.10000000110001001101000100110110111110101011101011111E704", 45); CHECK53(y, "42333842451e201", MPFR_RNDU, x, "0.10000000110001001101000100110110111110101011101100000E704", 46); CHECK53(y, "778380362293e218", MPFR_RNDD, x, "0.11001101010111000001001100001100110010000001010010010E764", 47); CHECK53(y, "778380362293e218", MPFR_RNDU, x, "0.11001101010111000001001100001100110010000001010010011E764", 48); CHECK53(y, "7812878489261e-179", MPFR_RNDD, x, "0.10010011011011010111001111011101111101101101001110100E-551", 49); CHECK53(y, "7812878489261e-179", MPFR_RNDU, x, "0.10010011011011010111001111011101111101101101001110101E-551", 50); CHECK53(y, "77003665618895e-73", MPFR_RNDD, x, "0.11000101111110111111001111111101001101111000000101001E-196", 51); CHECK53(y, "77003665618895e-73", MPFR_RNDU, x, "0.11000101111110111111001111111101001101111000000101010E-196", 52); CHECK53(y, "834735494917063e-300", MPFR_RNDD, x, "0.11111110001101100001001101111100010011001110111010001E-947", 53); CHECK53(y, "834735494917063e-300", MPFR_RNDU, x, "0.11111110001101100001001101111100010011001110111010010E-947", 54); CHECK53(y, "6182410494241627e-119", MPFR_RNDD, x, "0.10001101110010110010001011000010001000101110100000111E-342", 55); CHECK53(y, "6182410494241627e-119", MPFR_RNDU, x, "0.10001101110010110010001011000010001000101110100001000E-342", 56); CHECK53(y, "26153245263757307e49", MPFR_RNDD, x, "0.10011110111100000000001011011110101100010000011011110E218", 57); CHECK53(y, "26153245263757307e49", MPFR_RNDU, x, "0.10011110111100000000001011011110101100010000011011111E218", 58); /* to check this problem : I convert limb (10--0 or 101--1) into base b with more than mp_bits_per_limb digits, so when convert into base 2 I should have the limb that I have choose */ /* this use mpfr_get_str */ { size_t nb_digit = mp_bits_per_limb; mp_limb_t check_limb[2] = {MPFR_LIMB_HIGHBIT, ~(MPFR_LIMB_HIGHBIT >> 1)}; int base[3] = {10, 16, 19}; mpfr_rnd_t rnd[3] = {MPFR_RNDU, MPFR_RNDN, MPFR_RNDD}; int cbase, climb, crnd; char *str; mpfr_set_prec (x, mp_bits_per_limb); /* x and y have only one limb */ mpfr_set_prec (y, mp_bits_per_limb); str = (char*) (*__gmp_allocate_func) (N + 20); mpfr_set_ui (x, 1, MPFR_RNDN); /* ensures that x is not NaN or Inf */ for (; nb_digit < N; nb_digit *= 10) for (cbase = 0; cbase < 3; cbase++) for (climb = 0; climb < 2; climb++) for (crnd = 0; crnd < 3; crnd++) { char *str1; mpfr_exp_t exp; *(MPFR_MANT(x)) = check_limb[climb]; MPFR_EXP(x) = 0; mpfr_get_str (str + 2, &exp, base[cbase], nb_digit, x, rnd[crnd]); str[0] = '-'; str[(str[2] == '-')] = '0'; str[(str[2] == '-') + 1] = '.'; for (str1 = str; *str1 != 0; str1++) ; sprintf (str1, "@%i", (int) exp); mpfr_set_str (y, str, base[cbase], rnd[2 - crnd]); if (mpfr_cmp (x, y) != 0) { printf ("Error in mpfr_set_str for nb_digit=%u, base=%d, " "rnd=%s:\n", (unsigned int) nb_digit, base[cbase], mpfr_print_rnd_mode (rnd[crnd])); printf ("instead of: "); mpfr_print_binary (x); puts (""); printf ("return : "); mpfr_print_binary (y); puts (""); exit (1); } } (*__gmp_free_func) (str, N + 20); } /* end of tests added by Alain Delplanque */ /* check that flags are correctly cleared */ mpfr_set_nan (x); mpfr_set_str (x, "+0.0", 10, MPFR_RNDN); if (!mpfr_number_p(x) || mpfr_cmp_ui (x, 0) != 0 || mpfr_sgn (x) < 0) { printf ("x <- +0.0 failed after x=NaN\n"); exit (1); } mpfr_set_str (x, "-0.0", 10, MPFR_RNDN); if (!mpfr_number_p(x) || mpfr_cmp_ui (x, 0) != 0 || mpfr_sgn (x) > 0) { printf ("x <- -0.0 failed after x=NaN\n"); exit (1); } /* check invalid input */ ret = mpfr_set_str (x, "1E10toto", 10, MPFR_RNDN); MPFR_ASSERTN (ret == -1); ret = mpfr_set_str (x, "1p10toto", 16, MPFR_RNDN); MPFR_ASSERTN (ret == -1); ret = mpfr_set_str (x, "", 16, MPFR_RNDN); MPFR_ASSERTN (ret == -1); ret = mpfr_set_str (x, "+", 16, MPFR_RNDN); MPFR_ASSERTN (ret == -1); ret = mpfr_set_str (x, "-", 16, MPFR_RNDN); MPFR_ASSERTN (ret == -1); ret = mpfr_set_str (x, "this_is_an_invalid_number_in_base_36", 36, MPFR_RNDN); MPFR_ASSERTN (ret == -1); ret = mpfr_set_str (x, "1.2.3", 10, MPFR_RNDN); MPFR_ASSERTN (ret == -1); mpfr_set_prec (x, 135); ret = mpfr_set_str (x, "thisisavalidnumberinbase36", 36, MPFR_RNDN); mpfr_set_prec (y, 135); mpfr_set_str (y, "23833565676460972739462619524519814462546", 10, MPFR_RNDN); MPFR_ASSERTN (mpfr_cmp (x, y) == 0 && ret == 0); /* coverage test for set_str_binary */ mpfr_set_str_binary (x, "NaN"); MPFR_ASSERTN(mpfr_nan_p (x)); mpfr_set_str_binary (x, "Inf"); MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0); mpfr_set_str_binary (x, "+Inf"); MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0); mpfr_set_str_binary (x, "-Inf"); MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0); mpfr_set_prec (x, 3); mpfr_set_str_binary (x, "0.01E2"); MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0); mpfr_set_str_binary (x, "-0.01E2"); MPFR_ASSERTN(mpfr_cmp_si (x, -1) == 0); mpfr_clear (x); mpfr_clear (y); check_underflow (); bug20081028 (); tests_end_mpfr (); return 0; }

/// Returns sign of the number inline int sign() const { return MPFR_SIGN(val); }

int main (void) { mpfr_t x, y, z; int i, j, k; tests_start_mpfr (); mpfr_init (x); mpfr_init (y); mpfr_init (z); for (i = 0; i <= 1; i++) for (j = 0; j <= 1; j++) for (k = 0; k <= 5; k++) { mpfr_set_nan (x); i ? MPFR_SET_NEG (x) : MPFR_SET_POS (x); mpfr_set_nan (y); j ? MPFR_SET_NEG (y) : MPFR_SET_POS (y); copysign_variant (z, x, y, GMP_RNDN, k); if (MPFR_SIGN (z) != MPFR_SIGN (y) || !mpfr_nanflag_p ()) { printf ("Error in mpfr_copysign (%cNaN, %cNaN)\n", i ? '-' : '+', j ? '-' : '+'); exit (1); } mpfr_set_si (x, i ? -1250 : 1250, GMP_RNDN); mpfr_set_nan (y); j ? MPFR_SET_NEG (y) : MPFR_SET_POS (y); copysign_variant (z, x, y, GMP_RNDN, k); if (i != j) mpfr_neg (x, x, GMP_RNDN); if (! mpfr_equal_p (z, x) || mpfr_nanflag_p ()) { printf ("Error in mpfr_copysign (%c1250, %cNaN)\n", i ? '-' : '+', j ? '-' : '+'); exit (1); } mpfr_set_si (x, i ? -1250 : 1250, GMP_RNDN); mpfr_set_si (y, j ? -1717 : 1717, GMP_RNDN); copysign_variant (z, x, y, GMP_RNDN, k); if (i != j) mpfr_neg (x, x, GMP_RNDN); if (! mpfr_equal_p (z, x) || mpfr_nanflag_p ()) { printf ("Error in mpfr_copysign (%c1250, %c1717)\n", i ? '-' : '+', j ? '-' : '+'); exit (1); } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); tests_end_mpfr (); return 0; }

int mpfr_sub1sp (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { mpfr_exp_t bx,cx; mpfr_uexp_t d; mpfr_prec_t p, sh, cnt; mp_size_t n; mp_limb_t *ap, *bp, *cp; mp_limb_t limb; int inexact; mp_limb_t bcp,bcp1; /* Cp and C'p+1 */ mp_limb_t bbcp = (mp_limb_t) -1, bbcp1 = (mp_limb_t) -1; /* Cp+1 and C'p+2, gcc claims that they might be used uninitialized. We fill them with invalid values, which should produce a failure if so. See README.dev file. */ MPFR_TMP_DECL(marker); MPFR_TMP_MARK(marker); MPFR_ASSERTD(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c)); MPFR_ASSERTD(MPFR_IS_PURE_FP(b)); MPFR_ASSERTD(MPFR_IS_PURE_FP(c)); /* Read prec and num of limbs */ p = MPFR_PREC (b); n = MPFR_PREC2LIMBS (p); /* Fast cmp of |b| and |c|*/ bx = MPFR_GET_EXP (b); cx = MPFR_GET_EXP (c); if (MPFR_UNLIKELY(bx == cx)) { mp_size_t k = n - 1; /* Check mantissa since exponent are equals */ bp = MPFR_MANT(b); cp = MPFR_MANT(c); while (k>=0 && MPFR_UNLIKELY(bp[k] == cp[k])) k--; if (MPFR_UNLIKELY(k < 0)) /* b == c ! */ { /* Return exact number 0 */ if (rnd_mode == MPFR_RNDD) MPFR_SET_NEG(a); else MPFR_SET_POS(a); MPFR_SET_ZERO(a); MPFR_RET(0); } else if (bp[k] > cp[k]) goto BGreater; else { MPFR_ASSERTD(bp[k]<cp[k]); goto CGreater; } } else if (MPFR_UNLIKELY(bx < cx)) { /* Swap b and c and set sign */ mpfr_srcptr t; mpfr_exp_t tx; CGreater: MPFR_SET_OPPOSITE_SIGN(a,b); t = b; b = c; c = t; tx = bx; bx = cx; cx = tx; } else { /* b > c */ BGreater: MPFR_SET_SAME_SIGN(a,b); } /* Now b > c */ MPFR_ASSERTD(bx >= cx); d = (mpfr_uexp_t) bx - cx; DEBUG (printf ("New with diff=%lu\n", (unsigned long) d)); if (MPFR_UNLIKELY(d <= 1)) { if (MPFR_LIKELY(d < 1)) { /* <-- b --> <-- c --> : exact sub */ ap = MPFR_MANT(a); mpn_sub_n (ap, MPFR_MANT(b), MPFR_MANT(c), n); /* Normalize */ ExactNormalize: limb = ap[n-1]; if (MPFR_LIKELY(limb)) { /* First limb is not zero. */ count_leading_zeros(cnt, limb); /* cnt could be == 0 <= SubD1Lose */ if (MPFR_LIKELY(cnt)) { mpn_lshift(ap, ap, n, cnt); /* Normalize number */ bx -= cnt; /* Update final expo */ } /* Last limb should be ok */ MPFR_ASSERTD(!(ap[0] & MPFR_LIMB_MASK((unsigned int) (-p) % GMP_NUMB_BITS))); } else { /* First limb is zero */ mp_size_t k = n-1, len; /* Find the first limb not equal to zero. FIXME:It is assume it exists (since |b| > |c| and same prec)*/ do { MPFR_ASSERTD( k > 0 ); limb = ap[--k]; } while (limb == 0); MPFR_ASSERTD(limb != 0); count_leading_zeros(cnt, limb); k++; len = n - k; /* Number of last limb */ MPFR_ASSERTD(k >= 0); if (MPFR_LIKELY(cnt)) mpn_lshift(ap+len, ap, k, cnt); /* Normalize the High Limb*/ else { /* Must use DECR since src and dest may overlap & dest>=src*/ MPN_COPY_DECR(ap+len, ap, k); } MPN_ZERO(ap, len); /* Zeroing the last limbs */ bx -= cnt + len*GMP_NUMB_BITS; /* Update Expo */ /* Last limb should be ok */ MPFR_ASSERTD(!(ap[len]&MPFR_LIMB_MASK((unsigned int) (-p) % GMP_NUMB_BITS))); } /* Check expo underflow */ if (MPFR_UNLIKELY(bx < __gmpfr_emin)) { MPFR_TMP_FREE(marker); /* inexact=0 */ DEBUG( printf("(D==0 Underflow)\n") ); if (rnd_mode == MPFR_RNDN && (bx < __gmpfr_emin - 1 || (/*inexact >= 0 &&*/ mpfr_powerof2_raw (a)))) rnd_mode = MPFR_RNDZ; return mpfr_underflow (a, rnd_mode, MPFR_SIGN(a)); } MPFR_SET_EXP (a, bx); /* No rounding is necessary since the result is exact */ MPFR_ASSERTD(ap[n-1] > ~ap[n-1]); MPFR_TMP_FREE(marker); return 0; } else /* if (d == 1) */ { /* | <-- b --> | <-- c --> */ mp_limb_t c0, mask; mp_size_t k; MPFR_UNSIGNED_MINUS_MODULO(sh, p); /* If we lose at least one bit, compute 2*b-c (Exact) * else compute b-c/2 */ bp = MPFR_MANT(b); cp = MPFR_MANT(c); k = n-1; limb = bp[k] - cp[k]/2; if (limb > MPFR_LIMB_HIGHBIT) { /* We can't lose precision: compute b-c/2 */ /* Shift c in the allocated temporary block */ SubD1NoLose: c0 = cp[0] & (MPFR_LIMB_ONE<<sh); cp = MPFR_TMP_LIMBS_ALLOC (n); mpn_rshift(cp, MPFR_MANT(c), n, 1); if (MPFR_LIKELY(c0 == 0)) { /* Result is exact: no need of rounding! */ ap = MPFR_MANT(a); mpn_sub_n (ap, bp, cp, n); MPFR_SET_EXP(a, bx); /* No expo overflow! */ /* No truncate or normalize is needed */ MPFR_ASSERTD(ap[n-1] > ~ap[n-1]); /* No rounding is necessary since the result is exact */ MPFR_TMP_FREE(marker); return 0; } ap = MPFR_MANT(a); mask = ~MPFR_LIMB_MASK(sh); cp[0] &= mask; /* Delete last bit of c */ mpn_sub_n (ap, bp, cp, n); MPFR_SET_EXP(a, bx); /* No expo overflow! */ MPFR_ASSERTD( !(ap[0] & ~mask) ); /* Check last bits */ /* No normalize is needed */ MPFR_ASSERTD(ap[n-1] > ~ap[n-1]); /* Rounding is necessary since c0 = 1*/ /* Cp =-1 and C'p+1=0 */ bcp = 1; bcp1 = 0; if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { /* Even Rule apply: Check Ap-1 */ if (MPFR_LIKELY( (ap[0] & (MPFR_LIMB_ONE<<sh)) == 0) ) goto truncate; else goto sub_one_ulp; } MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ) goto sub_one_ulp; else goto truncate; } else if (MPFR_LIKELY(limb < MPFR_LIMB_HIGHBIT)) { /* We lose at least one bit of prec */ /* Calcul of 2*b-c (Exact) */ /* Shift b in the allocated temporary block */ SubD1Lose: bp = MPFR_TMP_LIMBS_ALLOC (n); mpn_lshift (bp, MPFR_MANT(b), n, 1); ap = MPFR_MANT(a); mpn_sub_n (ap, bp, cp, n); bx--; goto ExactNormalize; } else { /* Case: limb = 100000000000 */ /* Check while b[k] == c'[k] (C' is C shifted by 1) */ /* If b[k]<c'[k] => We lose at least one bit*/ /* If b[k]>c'[k] => We don't lose any bit */ /* If k==-1 => We don't lose any bit AND the result is 100000000000 0000000000 00000000000 */ mp_limb_t carry; do { carry = cp[k]&MPFR_LIMB_ONE; k--; } while (k>=0 && bp[k]==(carry=cp[k]/2+(carry<<(GMP_NUMB_BITS-1)))); if (MPFR_UNLIKELY(k<0)) { /*If carry then (sh==0 and Virtual c'[-1] > Virtual b[-1]) */ if (MPFR_UNLIKELY(carry)) /* carry = cp[0]&MPFR_LIMB_ONE */ { /* FIXME: Can be faster? */ MPFR_ASSERTD(sh == 0); goto SubD1Lose; } /* Result is a power of 2 */ ap = MPFR_MANT (a); MPN_ZERO (ap, n); ap[n-1] = MPFR_LIMB_HIGHBIT; MPFR_SET_EXP (a, bx); /* No expo overflow! */ /* No Normalize is needed*/ /* No Rounding is needed */ MPFR_TMP_FREE (marker); return 0; } /* carry = cp[k]/2+(cp[k-1]&1)<<(GMP_NUMB_BITS-1) = c'[k]*/ else if (bp[k] > carry) goto SubD1NoLose; else { MPFR_ASSERTD(bp[k]<carry); goto SubD1Lose; } } } } else if (MPFR_UNLIKELY(d >= p)) { ap = MPFR_MANT(a); MPFR_UNSIGNED_MINUS_MODULO(sh, p); /* We can't set A before since we use cp for rounding... */ /* Perform rounding: check if a=b or a=b-ulp(b) */ if (MPFR_UNLIKELY(d == p)) { /* cp == -1 and c'p+1 = ? */ bcp = 1; /* We need Cp+1 later for a very improbable case. */ bbcp = (MPFR_MANT(c)[n-1] & (MPFR_LIMB_ONE<<(GMP_NUMB_BITS-2))); /* We need also C'p+1 for an even more unprobable case... */ if (MPFR_LIKELY( bbcp )) bcp1 = 1; else { cp = MPFR_MANT(c); if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && cp[k]==0); bcp1 = (k>=0); } else bcp1 = 1; } DEBUG( printf("(D=P) Cp=-1 Cp+1=%d C'p+1=%d \n", bbcp!=0, bcp1!=0) ); bp = MPFR_MANT (b); /* Even if src and dest overlap, it is ok using MPN_COPY */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { if (MPFR_UNLIKELY( bcp && bcp1==0 )) /* Cp=-1 and C'p+1=0: Even rule Apply! */ /* Check Ap-1 = Bp-1 */ if ((bp[0] & (MPFR_LIMB_ONE<<sh)) == 0) { MPN_COPY(ap, bp, n); goto truncate; } MPN_COPY(ap, bp, n); goto sub_one_ulp; } MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ) { MPN_COPY(ap, bp, n); goto sub_one_ulp; } else { MPN_COPY(ap, bp, n); goto truncate; } } else { /* Cp=0, Cp+1=-1 if d==p+1, C'p+1=-1 */ bcp = 0; bbcp = (d==p+1); bcp1 = 1; DEBUG( printf("(D>P) Cp=%d Cp+1=%d C'p+1=%d\n", bcp!=0,bbcp!=0,bcp1!=0) ); /* Need to compute C'p+2 if d==p+1 and if rnd_mode=NEAREST (Because of a very improbable case) */ if (MPFR_UNLIKELY(d==p+1 && rnd_mode==MPFR_RNDN)) { cp = MPFR_MANT(c); if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && cp[k]==0); bbcp1 = (k>=0); } else bbcp1 = 1; DEBUG( printf("(D>P) C'p+2=%d\n", bbcp1!=0) ); } /* Copy mantissa B in A */ MPN_COPY(ap, MPFR_MANT(b), n); /* Round */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) goto truncate; MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ) goto sub_one_ulp; else /* rnd_mode = AWAY */ goto truncate; } } else { mpfr_uexp_t dm; mp_size_t m; mp_limb_t mask; /* General case: 2 <= d < p */ MPFR_UNSIGNED_MINUS_MODULO(sh, p); cp = MPFR_TMP_LIMBS_ALLOC (n); /* Shift c in temporary allocated place */ dm = d % GMP_NUMB_BITS; m = d / GMP_NUMB_BITS; if (MPFR_UNLIKELY(dm == 0)) { /* dm = 0 and m > 0: Just copy */ MPFR_ASSERTD(m!=0); MPN_COPY(cp, MPFR_MANT(c)+m, n-m); MPN_ZERO(cp+n-m, m); } else if (MPFR_LIKELY(m == 0)) { /* dm >=2 and m == 0: just shift */ MPFR_ASSERTD(dm >= 2); mpn_rshift(cp, MPFR_MANT(c), n, dm); } else { /* dm > 0 and m > 0: shift and zero */ mpn_rshift(cp, MPFR_MANT(c)+m, n-m, dm); MPN_ZERO(cp+n-m, m); } DEBUG( mpfr_print_mant_binary("Before", MPFR_MANT(c), p) ); DEBUG( mpfr_print_mant_binary("B= ", MPFR_MANT(b), p) ); DEBUG( mpfr_print_mant_binary("After ", cp, p) ); /* Compute bcp=Cp and bcp1=C'p+1 */ if (MPFR_LIKELY(sh)) { /* Try to compute them from C' rather than C (FIXME: Faster?) */ bcp = (cp[0] & (MPFR_LIMB_ONE<<(sh-1))) ; if (MPFR_LIKELY( cp[0] & MPFR_LIMB_MASK(sh-1) )) bcp1 = 1; else { /* We can't compute C'p+1 from C'. Compute it from C */ /* Start from bit x=p-d+sh in mantissa C (+sh since we have already looked sh bits in C'!) */ mpfr_prec_t x = p-d+sh-1; if (MPFR_LIKELY(x>p)) /* We are already looked at all the bits of c, so C'p+1 = 0*/ bcp1 = 0; else { mp_limb_t *tp = MPFR_MANT(c); mp_size_t kx = n-1 - (x / GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); DEBUG (printf ("(First) x=%lu Kx=%ld Sx=%lu\n", (unsigned long) x, (long) kx, (unsigned long) sx)); /* Looks at the last bits of limb kx (if sx=0 does nothing)*/ if (tp[kx] & MPFR_LIMB_MASK(sx)) bcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bcp1 = (kx >= 0); } } } } else { /* Compute Cp and C'p+1 from C with sh=0 */ mp_limb_t *tp = MPFR_MANT(c); /* Start from bit x=p-d in mantissa C */ mpfr_prec_t x = p-d; mp_size_t kx = n-1 - (x / GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); MPFR_ASSERTD(p >= d); bcp = (tp[kx] & (MPFR_LIMB_ONE<<sx)); /* Looks at the last bits of limb kx (If sx=0, does nothing)*/ if (tp[kx] & MPFR_LIMB_MASK(sx)) bcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bcp1 = (kx>=0); } } DEBUG( printf("sh=%lu Cp=%d C'p+1=%d\n", sh, bcp!=0, bcp1!=0) ); /* Check if we can lose a bit, and if so compute Cp+1 and C'p+2 */ bp = MPFR_MANT(b); if (MPFR_UNLIKELY((bp[n-1]-cp[n-1]) <= MPFR_LIMB_HIGHBIT)) { /* We can lose a bit so we precompute Cp+1 and C'p+2 */ /* Test for trivial case: since C'p+1=0, Cp+1=0 and C'p+2 =0 */ if (MPFR_LIKELY(bcp1 == 0)) { bbcp = 0; bbcp1 = 0; } else /* bcp1 != 0 */ { /* We can lose a bit: compute Cp+1 and C'p+2 from mantissa C */ mp_limb_t *tp = MPFR_MANT(c); /* Start from bit x=(p+1)-d in mantissa C */ mpfr_prec_t x = p+1-d; mp_size_t kx = n-1 - (x/GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); MPFR_ASSERTD(p > d); DEBUG (printf ("(pre) x=%lu Kx=%ld Sx=%lu\n", (unsigned long) x, (long) kx, (unsigned long) sx)); bbcp = (tp[kx] & (MPFR_LIMB_ONE<<sx)) ; /* Looks at the last bits of limb kx (If sx=0, does nothing)*/ /* If Cp+1=0, since C'p+1!=0, C'p+2=1 ! */ if (MPFR_LIKELY(bbcp==0 || (tp[kx]&MPFR_LIMB_MASK(sx)))) bbcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bbcp1 = (kx>=0); DEBUG (printf ("(Pre) Scan done for %ld\n", (long) kx)); } } /*End of Bcp1 != 0*/ DEBUG( printf("(Pre) Cp+1=%d C'p+2=%d\n", bbcp!=0, bbcp1!=0) ); } /* End of "can lose a bit" */ /* Clean shifted C' */ mask = ~MPFR_LIMB_MASK (sh); cp[0] &= mask; /* Subtract the mantissa c from b in a */ ap = MPFR_MANT(a); mpn_sub_n (ap, bp, cp, n); DEBUG( mpfr_print_mant_binary("Sub= ", ap, p) ); /* Normalize: we lose at max one bit*/ if (MPFR_UNLIKELY(MPFR_LIMB_MSB(ap[n-1]) == 0)) { /* High bit is not set and we have to fix it! */ /* Ap >= 010000xxx001 */ mpn_lshift(ap, ap, n, 1); /* Ap >= 100000xxx010 */ if (MPFR_UNLIKELY(bcp!=0)) /* Check if Cp = -1 */ /* Since Cp == -1, we have to substract one more */ { mpn_sub_1(ap, ap, n, MPFR_LIMB_ONE<<sh); MPFR_ASSERTD(MPFR_LIMB_MSB(ap[n-1]) != 0); } /* Ap >= 10000xxx001 */ /* Final exponent -1 since we have shifted the mantissa */ bx--; /* Update bcp and bcp1 */ MPFR_ASSERTN(bbcp != (mp_limb_t) -1); MPFR_ASSERTN(bbcp1 != (mp_limb_t) -1); bcp = bbcp; bcp1 = bbcp1; /* We dont't have anymore a valid Cp+1! But since Ap >= 100000xxx001, the final sub can't unnormalize!*/ } MPFR_ASSERTD( !(ap[0] & ~mask) ); /* Rounding */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { if (MPFR_LIKELY(bcp==0)) goto truncate; else if ((bcp1) || ((ap[0] & (MPFR_LIMB_ONE<<sh)) != 0)) goto sub_one_ulp; else goto truncate; } /* Update rounding mode */ MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ && (MPFR_LIKELY(bcp || bcp1))) goto sub_one_ulp; goto truncate; } MPFR_RET_NEVER_GO_HERE (); /* Sub one ulp to the result */ sub_one_ulp: mpn_sub_1 (ap, ap, n, MPFR_LIMB_ONE << sh); /* Result should be smaller than exact value: inexact=-1 */ inexact = -1; /* Check normalisation */ if (MPFR_UNLIKELY(MPFR_LIMB_MSB(ap[n-1]) == 0)) { /* ap was a power of 2, and we lose a bit */ /* Now it is 0111111111111111111[00000 */ mpn_lshift(ap, ap, n, 1); bx--; /* And the lost bit x depends on Cp+1, and Cp */ /* Compute Cp+1 if it isn't already compute (ie d==1) */ /* FIXME: Is this case possible? */ if (MPFR_UNLIKELY(d == 1)) bbcp = 0; DEBUG( printf("(SubOneUlp)Cp=%d, Cp+1=%d C'p+1=%d\n", bcp!=0,bbcp!=0,bcp1!=0)); /* Compute the last bit (Since we have shifted the mantissa) we need one more bit!*/ MPFR_ASSERTN(bbcp != (mp_limb_t) -1); if ( (rnd_mode == MPFR_RNDZ && bcp==0) || (rnd_mode==MPFR_RNDN && bbcp==0) || (bcp && bcp1==0) ) /*Exact result*/ { ap[0] |= MPFR_LIMB_ONE<<sh; if (rnd_mode == MPFR_RNDN) inexact = 1; DEBUG( printf("(SubOneUlp) Last bit set\n") ); } /* Result could be exact if C'p+1 = 0 and rnd == Zero since we have had one more bit to the result */ /* Fixme: rnd_mode == MPFR_RNDZ needed ? */ if (bcp1==0 && rnd_mode==MPFR_RNDZ) { DEBUG( printf("(SubOneUlp) Exact result\n") ); inexact = 0; } } goto end_of_sub; truncate: /* Check if the result is an exact power of 2: 100000000000 in which cases, we could have to do sub_one_ulp due to some nasty reasons: If Result is a Power of 2: + If rnd = AWAY, | If Cp=-1 and C'p+1 = 0, SubOneUlp and the result is EXACT. If Cp=-1 and C'p+1 =-1, SubOneUlp and the result is above. Otherwise truncate + If rnd = NEAREST, If Cp= 0 and Cp+1 =-1 and C'p+2=-1, SubOneUlp and the result is above If cp=-1 and C'p+1 = 0, SubOneUlp and the result is exact. Otherwise truncate. X bit should always be set if SubOneUlp*/ if (MPFR_UNLIKELY(ap[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && ap[k]==0); if (MPFR_UNLIKELY(k<0)) { /* It is a power of 2! */ /* Compute Cp+1 if it isn't already compute (ie d==1) */ /* FIXME: Is this case possible? */ if (d == 1) bbcp=0; DEBUG( printf("(Truncate) Cp=%d, Cp+1=%d C'p+1=%d C'p+2=%d\n", \ bcp!=0, bbcp!=0, bcp1!=0, bbcp1!=0) ); MPFR_ASSERTN(bbcp != (mp_limb_t) -1); MPFR_ASSERTN((rnd_mode != MPFR_RNDN) || (bcp != 0) || (bbcp == 0) || (bbcp1 != (mp_limb_t) -1)); if (((rnd_mode != MPFR_RNDZ) && bcp) || ((rnd_mode == MPFR_RNDN) && (bcp == 0) && (bbcp) && (bbcp1))) { DEBUG( printf("(Truncate) Do sub\n") ); mpn_sub_1 (ap, ap, n, MPFR_LIMB_ONE << sh); mpn_lshift(ap, ap, n, 1); ap[0] |= MPFR_LIMB_ONE<<sh; bx--; /* FIXME: Explain why it works (or why not)... */ inexact = (bcp1 == 0) ? 0 : (rnd_mode==MPFR_RNDN) ? -1 : 1; goto end_of_sub; } } } /* Calcul of Inexact flag.*/ inexact = MPFR_LIKELY(bcp || bcp1) ? 1 : 0; end_of_sub: /* Update Expo */ /* FIXME: Is this test really useful? If d==0 : Exact case. This is never called. if 1 < d < p : bx=MPFR_EXP(b) or MPFR_EXP(b)-1 > MPFR_EXP(c) > emin if d == 1 : bx=MPFR_EXP(b). If we could lose any bits, the exact normalisation is called. if d >= p : bx=MPFR_EXP(b) >= MPFR_EXP(c) + p > emin After SubOneUlp, we could have one bit less. if 1 < d < p : bx >= MPFR_EXP(b)-2 >= MPFR_EXP(c) > emin if d == 1 : bx >= MPFR_EXP(b)-1 = MPFR_EXP(c) > emin. if d >= p : bx >= MPFR_EXP(b)-1 > emin since p>=2. */ MPFR_ASSERTD( bx >= __gmpfr_emin); /* if (MPFR_UNLIKELY(bx < __gmpfr_emin)) { DEBUG( printf("(Final Underflow)\n") ); if (rnd_mode == MPFR_RNDN && (bx < __gmpfr_emin - 1 || (inexact >= 0 && mpfr_powerof2_raw (a)))) rnd_mode = MPFR_RNDZ; MPFR_TMP_FREE(marker); return mpfr_underflow (a, rnd_mode, MPFR_SIGN(a)); } */ MPFR_SET_EXP (a, bx); MPFR_TMP_FREE(marker); MPFR_RET (inexact * MPFR_INT_SIGN (a)); }

static void check_for_zero (void) { /* Check that 0 is unsigned! */ mpq_t q; mpz_t z; mpfr_t x; int r; mpfr_sign_t i; mpfr_init (x); mpz_init (z); mpq_init (q); mpz_set_ui (z, 0); mpq_set_ui (q, 0, 1); MPFR_SET_ZERO (x); RND_LOOP (r) { for (i = MPFR_SIGN_NEG ; i <= MPFR_SIGN_POS ; i+=MPFR_SIGN_POS-MPFR_SIGN_NEG) { MPFR_SET_SIGN(x, i); mpfr_add_z (x, x, z, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for add_z & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_sub_z (x, x, z, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for sub_z & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_mul_z (x, x, z, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for mul_z & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_add_q (x, x, q, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for add_q & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } mpfr_sub_q (x, x, q, (mpfr_rnd_t) r); if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i) { printf("GMP Zero errors for sub_q & rnd=%s & s=%d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), i); mpfr_dump (x); exit (1); } } } mpq_clear (q); mpz_clear (z); mpfr_clear (x); }

int mpfr_add (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { MPFR_LOG_FUNC (("b[%#R]=%R c[%#R]=%R rnd=%d", b, b, c, c, rnd_mode), ("a[%#R]=%R", a, a)); if (MPFR_ARE_SINGULAR(b,c)) { if (MPFR_IS_NAN(b) || MPFR_IS_NAN(c)) { MPFR_SET_NAN(a); MPFR_RET_NAN; } /* neither b nor c is NaN here */ else if (MPFR_IS_INF(b)) { if (!MPFR_IS_INF(c) || MPFR_SIGN(b) == MPFR_SIGN(c)) { MPFR_SET_INF(a); MPFR_SET_SAME_SIGN(a, b); MPFR_RET(0); /* exact */ } else { MPFR_SET_NAN(a); MPFR_RET_NAN; } } else if (MPFR_IS_INF(c)) { MPFR_SET_INF(a); MPFR_SET_SAME_SIGN(a, c); MPFR_RET(0); /* exact */ } /* now either b or c is zero */ else if (MPFR_IS_ZERO(b)) { if (MPFR_IS_ZERO(c)) { /* for round away, we take the same convention for 0 + 0 as for round to zero or to nearest: it always gives +0, except (-0) + (-0) = -0. */ MPFR_SET_SIGN(a, (rnd_mode != MPFR_RNDD ? ((MPFR_IS_NEG(b) && MPFR_IS_NEG(c)) ? -1 : 1) : ((MPFR_IS_POS(b) && MPFR_IS_POS(c)) ? 1 : -1))); MPFR_SET_ZERO(a); MPFR_RET(0); /* 0 + 0 is exact */ } return mpfr_set (a, c, rnd_mode); } else { MPFR_ASSERTD(MPFR_IS_ZERO(c)); return mpfr_set (a, b, rnd_mode); } } MPFR_ASSERTD(MPFR_IS_PURE_FP(b) && MPFR_IS_PURE_FP(c)); if (MPFR_UNLIKELY(MPFR_SIGN(b) != MPFR_SIGN(c))) { /* signs differ, it's a subtraction */ if (MPFR_LIKELY(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c))) return mpfr_sub1sp(a,b,c,rnd_mode); else return mpfr_sub1(a, b, c, rnd_mode); } else { /* signs are equal, it's an addition */ if (MPFR_LIKELY(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c))) if (MPFR_GET_EXP(b) < MPFR_GET_EXP(c)) return mpfr_add1sp(a, c, b, rnd_mode); else return mpfr_add1sp(a, b, c, rnd_mode); else if (MPFR_GET_EXP(b) < MPFR_GET_EXP(c)) return mpfr_add1(a, c, b, rnd_mode); else return mpfr_add1(a, b, c, rnd_mode); } }

int mpfr_mul (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { int sign, inexact; mpfr_exp_t ax, ax2; mp_limb_t *tmp; mp_limb_t b1; mpfr_prec_t bq, cq; mp_size_t bn, cn, tn, k; MPFR_TMP_DECL (marker); MPFR_LOG_FUNC (("b[%#R]=%R c[%#R]=%R rnd=%d", b, b, c, c, rnd_mode), ("a[%#R]=%R inexact=%d", a, a, inexact)); /* deal with special cases */ if (MPFR_ARE_SINGULAR (b, c)) { if (MPFR_IS_NAN (b) || MPFR_IS_NAN (c)) { MPFR_SET_NAN (a); MPFR_RET_NAN; } sign = MPFR_MULT_SIGN (MPFR_SIGN (b), MPFR_SIGN (c)); if (MPFR_IS_INF (b)) { if (!MPFR_IS_ZERO (c)) { MPFR_SET_SIGN (a, sign); MPFR_SET_INF (a); MPFR_RET (0); } else { MPFR_SET_NAN (a); MPFR_RET_NAN; } } else if (MPFR_IS_INF (c)) { if (!MPFR_IS_ZERO (b)) { MPFR_SET_SIGN (a, sign); MPFR_SET_INF (a); MPFR_RET(0); } else { MPFR_SET_NAN (a); MPFR_RET_NAN; } } else { MPFR_ASSERTD (MPFR_IS_ZERO(b) || MPFR_IS_ZERO(c)); MPFR_SET_SIGN (a, sign); MPFR_SET_ZERO (a); MPFR_RET (0); } } sign = MPFR_MULT_SIGN (MPFR_SIGN (b), MPFR_SIGN (c)); ax = MPFR_GET_EXP (b) + MPFR_GET_EXP (c); /* Note: the exponent of the exact result will be e = bx + cx + ec with ec in {-1,0,1} and the following assumes that e is representable. */ /* FIXME: Useful since we do an exponent check after ? * It is useful iff the precision is big, there is an overflow * and we are doing further mults...*/ #ifdef HUGE if (MPFR_UNLIKELY (ax > __gmpfr_emax + 1)) return mpfr_overflow (a, rnd_mode, sign); if (MPFR_UNLIKELY (ax < __gmpfr_emin - 2)) return mpfr_underflow (a, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode, sign); #endif bq = MPFR_PREC (b); cq = MPFR_PREC (c); MPFR_ASSERTD (bq+cq > bq); /* PREC_MAX is /2 so no integer overflow */ bn = (bq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of b */ cn = (cq+GMP_NUMB_BITS-1)/GMP_NUMB_BITS; /* number of limbs of c */ k = bn + cn; /* effective nb of limbs used by b*c (= tn or tn+1) below */ tn = (bq + cq + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; MPFR_ASSERTD (tn <= k); /* tn <= k, thus no int overflow */ /* Check for no size_t overflow*/ MPFR_ASSERTD ((size_t) k <= ((size_t) -1) / BYTES_PER_MP_LIMB); MPFR_TMP_MARK (marker); tmp = (mp_limb_t *) MPFR_TMP_ALLOC ((size_t) k * BYTES_PER_MP_LIMB); /* multiplies two mantissa in temporary allocated space */ if (MPFR_UNLIKELY (bn < cn)) { mpfr_srcptr z = b; mp_size_t zn = bn; b = c; bn = cn; c = z; cn = zn; } MPFR_ASSERTD (bn >= cn); if (MPFR_LIKELY (bn <= 2)) { if (bn == 1) { /* 1 limb * 1 limb */ umul_ppmm (tmp[1], tmp[0], MPFR_MANT (b)[0], MPFR_MANT (c)[0]); b1 = tmp[1]; } else if (MPFR_UNLIKELY (cn == 1)) { /* 2 limbs * 1 limb */ mp_limb_t t; umul_ppmm (tmp[1], tmp[0], MPFR_MANT (b)[0], MPFR_MANT (c)[0]); umul_ppmm (tmp[2], t, MPFR_MANT (b)[1], MPFR_MANT (c)[0]); add_ssaaaa (tmp[2], tmp[1], tmp[2], tmp[1], 0, t); b1 = tmp[2]; } else { /* 2 limbs * 2 limbs */ mp_limb_t t1, t2, t3; /* First 2 limbs * 1 limb */ umul_ppmm (tmp[1], tmp[0], MPFR_MANT (b)[0], MPFR_MANT (c)[0]); umul_ppmm (tmp[2], t1, MPFR_MANT (b)[1], MPFR_MANT (c)[0]); add_ssaaaa (tmp[2], tmp[1], tmp[2], tmp[1], 0, t1); /* Second, the other 2 limbs * 1 limb product */ umul_ppmm (t1, t2, MPFR_MANT (b)[0], MPFR_MANT (c)[1]); umul_ppmm (tmp[3], t3, MPFR_MANT (b)[1], MPFR_MANT (c)[1]); add_ssaaaa (tmp[3], t1, tmp[3], t1, 0, t3); /* Sum those two partial products */ add_ssaaaa (tmp[2], tmp[1], tmp[2], tmp[1], t1, t2); tmp[3] += (tmp[2] < t1); b1 = tmp[3]; } b1 >>= (GMP_NUMB_BITS - 1); tmp += k - tn; if (MPFR_UNLIKELY (b1 == 0)) mpn_lshift (tmp, tmp, tn, 1); /* tn <= k, so no stack corruption */ } else /* Mulders' mulhigh. Disable if squaring, since it is not tuned for such a case */ if (MPFR_UNLIKELY (bn > MPFR_MUL_THRESHOLD && b != c))

int mpfr_rint (mpfr_ptr r, mpfr_srcptr u, mpfr_rnd_t rnd_mode) { int sign; int rnd_away; mpfr_exp_t exp; if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(u) )) { if (MPFR_IS_NAN(u)) { MPFR_SET_NAN(r); MPFR_RET_NAN; } MPFR_SET_SAME_SIGN(r, u); if (MPFR_IS_INF(u)) { MPFR_SET_INF(r); MPFR_RET(0); /* infinity is exact */ } else /* now u is zero */ { MPFR_ASSERTD(MPFR_IS_ZERO(u)); MPFR_SET_ZERO(r); MPFR_RET(0); /* zero is exact */ } } MPFR_SET_SAME_SIGN (r, u); /* Does nothing if r==u */ sign = MPFR_INT_SIGN (u); exp = MPFR_GET_EXP (u); rnd_away = rnd_mode == MPFR_RNDD ? sign < 0 : rnd_mode == MPFR_RNDU ? sign > 0 : rnd_mode == MPFR_RNDZ ? 0 : rnd_mode == MPFR_RNDA ? 1 : -1; /* round to nearest-even (RNDN) or nearest-away (RNDNA) */ /* rnd_away: 1 if round away from zero, 0 if round to zero, -1 if not decided yet. */ if (MPFR_UNLIKELY (exp <= 0)) /* 0 < |u| < 1 ==> round |u| to 0 or 1 */ { /* Note: in the MPFR_RNDN mode, 0.5 must be rounded to 0. */ if (rnd_away != 0 && (rnd_away > 0 || (exp == 0 && (rnd_mode == MPFR_RNDNA || !mpfr_powerof2_raw (u))))) { mp_limb_t *rp; mp_size_t rm; rp = MPFR_MANT(r); rm = (MPFR_PREC(r) - 1) / GMP_NUMB_BITS; rp[rm] = MPFR_LIMB_HIGHBIT; MPN_ZERO(rp, rm); MPFR_SET_EXP (r, 1); /* |r| = 1 */ MPFR_RET(sign > 0 ? 2 : -2); } else { MPFR_SET_ZERO(r); /* r = 0 */ MPFR_RET(sign > 0 ? -2 : 2); } } else /* exp > 0, |u| >= 1 */ { mp_limb_t *up, *rp; mp_size_t un, rn, ui; int sh, idiff; int uflags; /* * uflags will contain: * _ 0 if u is an integer representable in r, * _ 1 if u is an integer not representable in r, * _ 2 if u is not an integer. */ up = MPFR_MANT(u); rp = MPFR_MANT(r); un = MPFR_LIMB_SIZE(u); rn = MPFR_LIMB_SIZE(r); MPFR_UNSIGNED_MINUS_MODULO (sh, MPFR_PREC (r)); MPFR_SET_EXP (r, exp); /* Does nothing if r==u */ if ((exp - 1) / GMP_NUMB_BITS >= un) { ui = un; idiff = 0; uflags = 0; /* u is an integer, representable or not in r */ } else { mp_size_t uj; ui = (exp - 1) / GMP_NUMB_BITS + 1; /* #limbs of the int part */ MPFR_ASSERTD (un >= ui); uj = un - ui; /* lowest limb of the integer part */ idiff = exp % GMP_NUMB_BITS; /* #int-part bits in up[uj] or 0 */ uflags = idiff == 0 || (up[uj] << idiff) == 0 ? 0 : 2; if (uflags == 0) while (uj > 0) if (up[--uj] != 0) { uflags = 2; break; } } if (ui > rn) { /* More limbs in the integer part of u than in r. Just round u with the precision of r. */ MPFR_ASSERTD (rp != up && un > rn); MPN_COPY (rp, up + (un - rn), rn); /* r != u */ if (rnd_away < 0) { /* This is a rounding to nearest mode (MPFR_RNDN or MPFR_RNDNA). Decide the rounding direction here. */ if (rnd_mode == MPFR_RNDN && (rp[0] & (MPFR_LIMB_ONE << sh)) == 0) { /* halfway cases rounded toward zero */ mp_limb_t a, b; /* a: rounding bit and some of the following bits */ /* b: boundary for a (weight of the rounding bit in a) */ if (sh != 0) { a = rp[0] & ((MPFR_LIMB_ONE << sh) - 1); b = MPFR_LIMB_ONE << (sh - 1); } else { a = up[un - rn - 1]; b = MPFR_LIMB_HIGHBIT; } rnd_away = a > b; if (a == b) { mp_size_t i; for (i = un - rn - 1 - (sh == 0); i >= 0; i--) if (up[i] != 0) { rnd_away = 1; break; } } } else /* halfway cases rounded away from zero */ rnd_away = /* rounding bit */ ((sh != 0 && (rp[0] & (MPFR_LIMB_ONE << (sh - 1))) != 0) || (sh == 0 && (up[un - rn - 1] & MPFR_LIMB_HIGHBIT) != 0)); } if (uflags == 0) { /* u is an integer; determine if it is representable in r */ if (sh != 0 && rp[0] << (GMP_NUMB_BITS - sh) != 0) uflags = 1; /* u is not representable in r */ else { mp_size_t i; for (i = un - rn - 1; i >= 0; i--) if (up[i] != 0) { uflags = 1; /* u is not representable in r */ break; } } } } else /* ui <= rn */ { mp_size_t uj, rj; int ush; uj = un - ui; /* lowest limb of the integer part in u */ rj = rn - ui; /* lowest limb of the integer part in r */ if (MPFR_LIKELY (rp != up)) MPN_COPY(rp + rj, up + uj, ui); /* Ignore the lowest rj limbs, all equal to zero. */ rp += rj; rn = ui; /* number of fractional bits in whole rp[0] */ ush = idiff == 0 ? 0 : GMP_NUMB_BITS - idiff; if (rj == 0 && ush < sh) { /* If u is an integer (uflags == 0), we need to determine if it is representable in r, i.e. if its sh - ush bits in the non-significant part of r are all 0. */ if (uflags == 0 && (rp[0] & ((MPFR_LIMB_ONE << sh) - (MPFR_LIMB_ONE << ush))) != 0) uflags = 1; /* u is an integer not representable in r */ } else /* The integer part of u fits in r, we'll round to it. */ sh = ush; if (rnd_away < 0) { /* This is a rounding to nearest mode. Decide the rounding direction here. */ if (uj == 0 && sh == 0) rnd_away = 0; /* rounding bit = 0 (not represented in u) */ else if (rnd_mode == MPFR_RNDN && (rp[0] & (MPFR_LIMB_ONE << sh)) == 0) { /* halfway cases rounded toward zero */ mp_limb_t a, b; /* a: rounding bit and some of the following bits */ /* b: boundary for a (weight of the rounding bit in a) */ if (sh != 0) { a = rp[0] & ((MPFR_LIMB_ONE << sh) - 1); b = MPFR_LIMB_ONE << (sh - 1); } else { MPFR_ASSERTD (uj >= 1); /* see above */ a = up[uj - 1]; b = MPFR_LIMB_HIGHBIT; } rnd_away = a > b; if (a == b) { mp_size_t i; for (i = uj - 1 - (sh == 0); i >= 0; i--) if (up[i] != 0) { rnd_away = 1; break; } } } else /* halfway cases rounded away from zero */ rnd_away = /* rounding bit */ ((sh != 0 && (rp[0] & (MPFR_LIMB_ONE << (sh - 1))) != 0) || (sh == 0 && (MPFR_ASSERTD (uj >= 1), up[uj - 1] & MPFR_LIMB_HIGHBIT) != 0)); } /* Now we can make the low rj limbs to 0 */ MPN_ZERO (rp-rj, rj); } if (sh != 0) rp[0] &= MP_LIMB_T_MAX << sh; /* If u is a representable integer, there is no rounding. */ if (uflags == 0) MPFR_RET(0); MPFR_ASSERTD (rnd_away >= 0); /* rounding direction is defined */ if (rnd_away && mpn_add_1(rp, rp, rn, MPFR_LIMB_ONE << sh)) { if (exp == __gmpfr_emax) return mpfr_overflow(r, rnd_mode, MPFR_SIGN(r)) >= 0 ? uflags : -uflags; else { MPFR_SET_EXP(r, exp + 1); rp[rn-1] = MPFR_LIMB_HIGHBIT; } } MPFR_RET (rnd_away ^ (sign < 0) ? uflags : -uflags); } /* exp > 0, |u| >= 1 */ }

int mpfr_sinh_cosh (mpfr_ptr sh, mpfr_ptr ch, mpfr_srcptr xt, mpfr_rnd_t rnd_mode) { mpfr_t x; int inexact_sh, inexact_ch; MPFR_ASSERTN (sh != ch); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode), ("sh[%Pu]=%.*Rg ch[%Pu]=%.*Rg", mpfr_get_prec (sh), mpfr_log_prec, sh, mpfr_get_prec (ch), mpfr_log_prec, ch)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt))) { if (MPFR_IS_NAN (xt)) { MPFR_SET_NAN (ch); MPFR_SET_NAN (sh); MPFR_RET_NAN; } else if (MPFR_IS_INF (xt)) { MPFR_SET_INF (sh); MPFR_SET_SAME_SIGN (sh, xt); MPFR_SET_INF (ch); MPFR_SET_POS (ch); MPFR_RET (0); } else /* xt is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (xt)); MPFR_SET_ZERO (sh); /* sinh(0) = 0 */ MPFR_SET_SAME_SIGN (sh, xt); inexact_sh = 0; inexact_ch = mpfr_set_ui (ch, 1, rnd_mode); /* cosh(0) = 1 */ return INEX(inexact_sh,inexact_ch); } } /* Warning: if we use MPFR_FAST_COMPUTE_IF_SMALL_INPUT here, make sure that the code also works in case of overlap (see sin_cos.c) */ MPFR_TMP_INIT_ABS (x, xt); { mpfr_t s, c, ti; mpfr_exp_t d; mpfr_prec_t N; /* Precision of the intermediary variables */ 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 */ N = MPFR_PREC (ch); N = MAX (N, MPFR_PREC (sh)); /* the optimal number of bits : see algorithms.ps */ N = N + MPFR_INT_CEIL_LOG2 (N) + 4; /* initialise of intermediary variables */ MPFR_GROUP_INIT_3 (group, N, s, c, ti); /* First computation of sinh_cosh */ MPFR_ZIV_INIT (loop, N); for (;;) { MPFR_BLOCK_DECL (flags); /* compute sinh_cosh */ MPFR_BLOCK (flags, mpfr_exp (s, x, MPFR_RNDD)); if (MPFR_OVERFLOW (flags)) /* exp(x) does overflow */ { /* since cosh(x) >= exp(x), cosh(x) overflows too */ inexact_ch = mpfr_overflow (ch, rnd_mode, MPFR_SIGN_POS); /* sinh(x) may be representable */ inexact_sh = mpfr_sinh (sh, xt, rnd_mode); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW); break; } d = MPFR_GET_EXP (s); mpfr_ui_div (ti, 1, s, MPFR_RNDU); /* 1/exp(x) */ mpfr_add (c, s, ti, MPFR_RNDU); /* exp(x) + 1/exp(x) */ mpfr_sub (s, s, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */ mpfr_div_2ui (c, c, 1, MPFR_RNDN); /* 1/2(exp(x) + 1/exp(x)) */ mpfr_div_2ui (s, s, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */ /* it may be that s is zero (in fact, it can only occur when exp(x)=1, and thus ti=1 too) */ if (MPFR_IS_ZERO (s)) err = N; /* double the precision */ else { /* calculation of the error */ d = d - MPFR_GET_EXP (s) + 2; /* error estimate: err = N-(__gmpfr_ceil_log2(1+pow(2,d)));*/ err = N - (MAX (d, 0) + 1); if (MPFR_LIKELY (MPFR_CAN_ROUND (s, err, MPFR_PREC (sh), rnd_mode) && \ MPFR_CAN_ROUND (c, err, MPFR_PREC (ch), rnd_mode))) { inexact_sh = mpfr_set4 (sh, s, rnd_mode, MPFR_SIGN (xt)); inexact_ch = mpfr_set (ch, c, rnd_mode); break; } } /* actualisation of the precision */ N += err; MPFR_ZIV_NEXT (loop, N); MPFR_GROUP_REPREC_3 (group, N, s, c, ti); } MPFR_ZIV_FREE (loop); MPFR_GROUP_CLEAR (group); MPFR_SAVE_EXPO_FREE (expo); } /* now, let's raise the flags if needed */ inexact_sh = mpfr_check_range (sh, inexact_sh, rnd_mode); inexact_ch = mpfr_check_range (ch, inexact_ch, rnd_mode); return INEX(inexact_sh,inexact_ch); }

static void special (void) { mpfr_t x, y; int i; mpfr_init (x); mpfr_init (y); mpfr_set_nan (x); test_expm1 (y, x, MPFR_RNDN); if (!mpfr_nan_p (y)) { printf ("Error for expm1(NaN)\n"); exit (1); } mpfr_set_inf (x, 1); test_expm1 (y, x, MPFR_RNDN); if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0) { printf ("Error for expm1(+Inf)\n"); exit (1); } mpfr_set_inf (x, -1); test_expm1 (y, x, MPFR_RNDN); if (mpfr_cmp_si (y, -1)) { printf ("Error for expm1(-Inf)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); test_expm1 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0) { printf ("Error for expm1(+0)\n"); exit (1); } mpfr_neg (x, x, MPFR_RNDN); test_expm1 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0) { printf ("Error for expm1(-0)\n"); exit (1); } /* Check overflow of expm1(x) */ mpfr_clear_flags (); mpfr_set_str_binary (x, "1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDN); MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0); MPFR_ASSERTN (mpfr_overflow_p ()); MPFR_ASSERTN (i == 1); mpfr_clear_flags (); mpfr_set_str_binary (x, "1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDU); MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0); MPFR_ASSERTN (mpfr_overflow_p ()); MPFR_ASSERTN (i == 1); mpfr_clear_flags (); mpfr_set_str_binary (x, "1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDD); MPFR_ASSERTN (!MPFR_IS_INF (x) && MPFR_SIGN (x) > 0); MPFR_ASSERTN (mpfr_overflow_p ()); MPFR_ASSERTN (i == -1); /* Check internal underflow of expm1 (x) */ mpfr_set_prec (x, 2); mpfr_clear_flags (); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDN); MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == -1); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDD); MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == -1); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDZ); MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == 1); mpfr_set_str_binary (x, "-1.1E1000000000"); i = test_expm1 (x, x, MPFR_RNDU); MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0); MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ()); MPFR_ASSERTN (i == 1); mpfr_clear (x); mpfr_clear (y); }

/* Usage: tzeta - generic tests tzeta s prec rnd_mode - compute zeta(s) with precision 'prec' and rounding mode 'mode' */ int main (int argc, char *argv[]) { mpfr_t s, y, z; mpfr_prec_t prec; mpfr_rnd_t rnd_mode; int inex; tests_start_mpfr (); if (argc != 1 && argc != 4) { printf ("Usage: tzeta\n" " or tzeta s prec rnd_mode\n"); exit (1); } if (argc == 4) { prec = atoi(argv[2]); mpfr_init2 (s, prec); mpfr_init2 (z, prec); mpfr_set_str (s, argv[1], 10, MPFR_RNDN); rnd_mode = (mpfr_rnd_t) atoi(argv[3]); mpfr_zeta (z, s, rnd_mode); mpfr_out_str (stdout, 10, 0, z, MPFR_RNDN); printf ("\n"); mpfr_clear (s); mpfr_clear (z); return 0; } test1(); mpfr_init2 (s, MPFR_PREC_MIN); mpfr_init2 (y, MPFR_PREC_MIN); mpfr_init2 (z, MPFR_PREC_MIN); /* the following seems to loop */ mpfr_set_prec (s, 6); mpfr_set_prec (z, 6); mpfr_set_str_binary (s, "1.10010e4"); mpfr_zeta (z, s, MPFR_RNDZ); mpfr_set_prec (s, 53); mpfr_set_prec (y, 53); mpfr_set_prec (z, 53); mpfr_set_ui (s, 1, MPFR_RNDN); mpfr_clear_divby0(); mpfr_zeta (z, s, MPFR_RNDN); if (!mpfr_inf_p (z) || MPFR_SIGN (z) < 0 || !mpfr_divby0_p()) { printf ("Error in mpfr_zeta for s = 1 (should be +inf) with divby0 flag\n"); exit (1); } mpfr_set_str_binary (s, "0.1100011101110111111111111010000110010111001011001011"); mpfr_set_str_binary (y, "-0.11111101111011001001001111111000101010000100000100100E2"); mpfr_zeta (z, s, MPFR_RNDN); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (1,RNDN)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDZ); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (1,RNDZ)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDU); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (1,RNDU)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDD); mpfr_nexttoinf (y); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (1,RNDD)\n"); exit (1); } mpfr_set_str_binary (s, "0.10001011010011100110010001100100001011000010011001011"); mpfr_set_str_binary (y, "-0.11010011010010101101110111011010011101111101111010110E1"); mpfr_zeta (z, s, MPFR_RNDN); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (2,RNDN)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDZ); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (2,RNDZ)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDU); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (2,RNDU)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDD); mpfr_nexttoinf (y); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (2,RNDD)\n"); exit (1); } mpfr_set_str_binary (s, "0.1100111110100001111110111000110101111001011101000101"); mpfr_set_str_binary (y, "-0.10010111010110000111011111001101100001111011000001010E3"); mpfr_zeta (z, s, MPFR_RNDN); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (3,RNDN)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDD); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (3,RNDD)\n"); exit (1); } mpfr_nexttozero (y); mpfr_zeta (z, s, MPFR_RNDZ); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (3,RNDZ)\n"); exit (1); } mpfr_zeta (z, s, MPFR_RNDU); if (mpfr_cmp (z, y) != 0) { printf ("Error in mpfr_zeta (3,RNDU)\n"); exit (1); } mpfr_set_str (s, "-400000001", 10, MPFR_RNDZ); mpfr_zeta (z, s, MPFR_RNDN); if (!(mpfr_inf_p (z) && MPFR_SIGN(z) < 0)) { printf ("Error in mpfr_zeta (-400000001)\n"); exit (1); } mpfr_set_str (s, "-400000003", 10, MPFR_RNDZ); mpfr_zeta (z, s, MPFR_RNDN); if (!(mpfr_inf_p (z) && MPFR_SIGN(z) > 0)) { printf ("Error in mpfr_zeta (-400000003)\n"); exit (1); } mpfr_set_prec (s, 34); mpfr_set_prec (z, 34); mpfr_set_str_binary (s, "-1.111111100001011110000010001010000e-35"); mpfr_zeta (z, s, MPFR_RNDD); mpfr_set_str_binary (s, "-1.111111111111111111111111111111111e-2"); if (mpfr_cmp (s, z)) { printf ("Error in mpfr_zeta, prec=34, MPFR_RNDD\n"); mpfr_dump (z); exit (1); } /* bug found by nightly tests on June 7, 2007 */ mpfr_set_prec (s, 23); mpfr_set_prec (z, 25); mpfr_set_str_binary (s, "-1.0110110110001000000000e-27"); mpfr_zeta (z, s, MPFR_RNDN); mpfr_set_prec (s, 25); mpfr_set_str_binary (s, "-1.111111111111111111111111e-2"); if (mpfr_cmp (s, z)) { printf ("Error in mpfr_zeta, prec=25, MPFR_RNDN\n"); printf ("expected "); mpfr_dump (s); printf ("got "); mpfr_dump (z); exit (1); } /* bug reported by Kevin Rauch on 26 Oct 2007 */ mpfr_set_prec (s, 128); mpfr_set_prec (z, 128); mpfr_set_str_binary (s, "-0.1000000000000000000000000000000000000000000000000000000000000001E64"); inex = mpfr_zeta (z, s, MPFR_RNDN); MPFR_ASSERTN (mpfr_inf_p (z) && MPFR_SIGN (z) < 0 && inex < 0); inex = mpfr_zeta (z, s, MPFR_RNDU); mpfr_set_inf (s, -1); mpfr_nextabove (s); MPFR_ASSERTN (mpfr_equal_p (z, s) && inex > 0); mpfr_clear (s); mpfr_clear (y); mpfr_clear (z); test_generic (2, 70, 5); test2 (); tests_end_mpfr (); return 0; }

static void particular_cases (void) { mpfr_t t[11], r; static const char *name[11] = { "NaN", "+inf", "-inf", "+0", "-0", "+1", "-1", "+2", "-2", "+0.5", "-0.5" }; int i, j; int error = 0; for (i = 0; i < 11; i++) mpfr_init2 (t[i], 2); mpfr_init2 (r, 6); mpfr_set_nan (t[0]); mpfr_set_inf (t[1], 1); mpfr_set_ui (t[3], 0, GMP_RNDN); mpfr_set_ui (t[5], 1, GMP_RNDN); mpfr_set_ui (t[7], 2, GMP_RNDN); mpfr_div_2ui (t[9], t[5], 1, GMP_RNDN); for (i = 1; i < 11; i += 2) mpfr_neg (t[i+1], t[i], GMP_RNDN); for (i = 0; i < 11; i++) for (j = 0; j < 11; j++) { double d; int p; static int q[11][11] = { /* NaN +inf -inf +0 -0 +1 -1 +2 -2 +0.5 -0.5 */ /* NaN */ { 0, 0, 0, 128, 128, 0, 0, 0, 0, 0, 0 }, /* +inf */ { 0, 1, 2, 128, 128, 1, 2, 1, 2, 1, 2 }, /* -inf */ { 0, 1, 2, 128, 128, -1, -2, 1, 2, 1, 2 }, /* +0 */ { 0, 2, 1, 128, 128, 2, 1, 2, 1, 2, 1 }, /* -0 */ { 0, 2, 1, 128, 128, -2, -1, 2, 1, 2, 1 }, /* +1 */ {128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128 }, /* -1 */ { 0, 128, 128, 128, 128,-128,-128, 128, 128, 0, 0 }, /* +2 */ { 0, 1, 2, 128, 128, 256, 64, 512, 32, 180, 90 }, /* -2 */ { 0, 1, 2, 128, 128,-256, -64, 512, 32, 0, 0 }, /* +0.5 */ { 0, 2, 1, 128, 128, 64, 256, 32, 512, 90, 180 }, /* -0.5 */ { 0, 2, 1, 128, 128, -64,-256, 32, 512, 0, 0 } }; test_pow (r, t[i], t[j], GMP_RNDN); p = mpfr_nan_p (r) ? 0 : mpfr_inf_p (r) ? 1 : mpfr_cmp_ui (r, 0) == 0 ? 2 : (d = mpfr_get_d (r, GMP_RNDN), (int) (ABS(d) * 128.0)); if (p != 0 && MPFR_SIGN(r) < 0) p = -p; if (p != q[i][j]) { printf ("Error in mpfr_pow for particular case (%s)^(%s) (%d,%d):\n" "got %d instead of %d\n", name[i], name[j], i,j,p, q[i][j]); mpfr_dump (r); error = 1; } } for (i = 0; i < 11; i++) mpfr_clear (t[i]); mpfr_clear (r); if (error) exit (1); }

int mpfr_copysign (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mp_rnd_t rnd_mode) { return mpfr_set4 (z, x, rnd_mode, MPFR_SIGN (y)); }

static void check_pow_ui (void) { mpfr_t a, b; int res; mpfr_init2 (a, 53); mpfr_init2 (b, 53); /* check in-place operations */ mpfr_set_str (b, "0.6926773", 10, GMP_RNDN); mpfr_pow_ui (a, b, 10, GMP_RNDN); mpfr_pow_ui (b, b, 10, GMP_RNDN); if (mpfr_cmp (a, b)) { printf ("Error for mpfr_pow_ui (b, b, ...)\n"); exit (1); } /* check large exponents */ mpfr_set_ui (b, 1, GMP_RNDN); mpfr_pow_ui (a, b, 4294967295UL, GMP_RNDN); mpfr_set_inf (a, -1); mpfr_pow_ui (a, a, 4049053855UL, GMP_RNDN); if (!mpfr_inf_p (a) || (mpfr_sgn (a) >= 0)) { printf ("Error for (-Inf)^4049053855\n"); exit (1); } mpfr_set_inf (a, -1); mpfr_pow_ui (a, a, (unsigned long) 30002752, GMP_RNDN); if (!mpfr_inf_p (a) || (mpfr_sgn (a) <= 0)) { printf ("Error for (-Inf)^30002752\n"); exit (1); } /* Check underflow */ mpfr_set_str_binary (a, "1E-1"); res = mpfr_pow_ui (a, a, -mpfr_get_emin (), GMP_RNDN); if (MPFR_GET_EXP (a) != mpfr_get_emin () + 1) { printf ("Error for (1e-1)^MPFR_EMAX_MAX\n"); mpfr_dump (a); exit (1); } mpfr_set_str_binary (a, "1E-10"); res = mpfr_pow_ui (a, a, -mpfr_get_emin (), GMP_RNDZ); if (!MPFR_IS_ZERO (a)) { printf ("Error for (1e-10)^MPFR_EMAX_MAX\n"); mpfr_dump (a); exit (1); } /* Check overflow */ mpfr_set_str_binary (a, "1E10"); res = mpfr_pow_ui (a, a, ULONG_MAX, GMP_RNDN); if (!MPFR_IS_INF (a) || MPFR_SIGN (a) < 0) { printf ("Error for (1e10)^ULONG_MAX\n"); exit (1); } /* Check 0 */ MPFR_SET_ZERO (a); MPFR_SET_POS (a); mpfr_set_si (b, -1, GMP_RNDN); res = mpfr_pow_ui (b, a, 1, GMP_RNDN); if (res != 0 || MPFR_IS_NEG (b)) { printf ("Error for (0+)^1\n"); exit (1); } MPFR_SET_ZERO (a); MPFR_SET_NEG (a); mpfr_set_ui (b, 1, GMP_RNDN); res = mpfr_pow_ui (b, a, 5, GMP_RNDN); if (res != 0 || MPFR_IS_POS (b)) { printf ("Error for (0-)^5\n"); exit (1); } MPFR_SET_ZERO (a); MPFR_SET_NEG (a); mpfr_set_si (b, -1, GMP_RNDN); res = mpfr_pow_ui (b, a, 6, GMP_RNDN); if (res != 0 || MPFR_IS_NEG (b)) { printf ("Error for (0-)^6\n"); exit (1); } mpfr_set_prec (a, 122); mpfr_set_prec (b, 122); mpfr_set_str_binary (a, "0.10000010010000111101001110100101101010011110011100001111000001001101000110011001001001001011001011010110110110101000111011E1"); mpfr_set_str_binary (b, "0.11111111100101001001000001000001100011100000001110111111100011111000111011100111111111110100011000111011000100100011001011E51290375"); mpfr_pow_ui (a, a, 2026876995UL, GMP_RNDU); if (mpfr_cmp (a, b) != 0) { printf ("Error for x^2026876995\n"); exit (1); } mpfr_set_prec (a, 29); mpfr_set_prec (b, 29); mpfr_set_str_binary (a, "1.0000000000000000000000001111"); mpfr_set_str_binary (b, "1.1001101111001100111001010111e165"); mpfr_pow_ui (a, a, 2055225053, GMP_RNDZ); if (mpfr_cmp (a, b) != 0) { printf ("Error for x^2055225053\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } /* worst case found by Vincent Lefevre, 25 Nov 2006 */ mpfr_set_prec (a, 53); mpfr_set_prec (b, 53); mpfr_set_str_binary (a, "1.0000010110000100001000101101101001011101101011010111"); mpfr_set_str_binary (b, "1.0000110111101111011010110100001100010000001010110100E1"); mpfr_pow_ui (a, a, 35, GMP_RNDN); if (mpfr_cmp (a, b) != 0) { printf ("Error in mpfr_pow_ui for worst case (1)\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } /* worst cases found on 2006-11-26 */ mpfr_set_str_binary (a, "1.0110100111010001101001010111001110010100111111000011"); mpfr_set_str_binary (b, "1.1111010011101110001111010110000101110000110110101100E17"); mpfr_pow_ui (a, a, 36, GMP_RNDD); if (mpfr_cmp (a, b) != 0) { printf ("Error in mpfr_pow_ui for worst case (2)\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } mpfr_set_str_binary (a, "1.1001010100001110000110111111100011011101110011000100"); mpfr_set_str_binary (b, "1.1100011101101101100010110001000001110001111110010001E23"); mpfr_pow_ui (a, a, 36, GMP_RNDU); if (mpfr_cmp (a, b) != 0) { printf ("Error in mpfr_pow_ui for worst case (3)\n"); printf ("Expected "); mpfr_out_str (stdout, 2, 0, b, GMP_RNDN); printf ("\nGot "); mpfr_out_str (stdout, 2, 0, a, GMP_RNDN); printf ("\n"); exit (1); } mpfr_clear (a); mpfr_clear (b); }

int mpfr_atanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode) { int inexact; mpfr_t x, t, te; mpfr_prec_t Nx, Ny, Nt; mpfr_exp_t err; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); /* Special cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt))) { /* atanh(NaN) = NaN, and atanh(+/-Inf) = NaN since tanh gives a result between -1 and 1 */ if (MPFR_IS_NAN (xt) || MPFR_IS_INF (xt)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else /* necessarily xt is 0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (xt)); MPFR_SET_ZERO (y); /* atanh(0) = 0 */ MPFR_SET_SAME_SIGN (y,xt); MPFR_RET (0); } } /* atanh (x) = NaN as soon as |x| > 1, and arctanh(+/-1) = +/-Inf */ if (MPFR_UNLIKELY (MPFR_GET_EXP (xt) > 0)) { if (MPFR_GET_EXP (xt) == 1 && mpfr_powerof2_raw (xt)) { MPFR_SET_INF (y); MPFR_SET_SAME_SIGN (y, xt); mpfr_set_divby0 (); MPFR_RET (0); } MPFR_SET_NAN (y); MPFR_RET_NAN; } /* atanh(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 1, rnd_mode, {}); MPFR_SAVE_EXPO_MARK (expo); /* Compute initial precision */ Nx = MPFR_PREC (xt); MPFR_TMP_INIT_ABS (x, xt); Ny = MPFR_PREC (y); Nt = MAX (Nx, Ny); /* the optimal number of bits : see algorithms.ps */ Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4; /* initialise of intermediary variable */ mpfr_init2 (t, Nt); mpfr_init2 (te, Nt); /* First computation of cosh */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute atanh */ mpfr_ui_sub (te, 1, x, MPFR_RNDU); /* (1-xt)*/ mpfr_add_ui (t, x, 1, MPFR_RNDD); /* (xt+1)*/ mpfr_div (t, t, te, MPFR_RNDN); /* (1+xt)/(1-xt)*/ mpfr_log (t, t, MPFR_RNDN); /* ln((1+xt)/(1-xt))*/ mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* (1/2)*ln((1+xt)/(1-xt))*/ /* error estimate: see algorithms.tex */ /* FIXME: this does not correspond to the value in algorithms.tex!!! */ /* err=Nt-__gmpfr_ceil_log2(1+5*pow(2,1-MPFR_EXP(t)));*/ err = Nt - (MAX (4 - MPFR_GET_EXP (t), 0) + 1); if (MPFR_LIKELY (MPFR_IS_ZERO (t) || MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* reactualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); mpfr_set_prec (te, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt)); mpfr_clear(t); mpfr_clear(te); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }

/* Since MPFR-3.0, return the usual inexact value. The erange flag is set if an error occurred in the conversion (y is NaN, +Inf, or -Inf that have no equivalent in mpf) */ int mpfr_get_f (mpf_ptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode) { int inex; mp_size_t sx, sy; mpfr_prec_t precx, precy; mp_limb_t *xp; int sh; if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(y))) { if (MPFR_IS_ZERO(y)) { mpf_set_ui (x, 0); return 0; } else if (MPFR_IS_NAN (y)) { MPFR_SET_ERANGE (); return 0; } else /* y is plus infinity (resp. minus infinity), set x to the maximum value (resp. the minimum value) in precision PREC(x) */ { int i; mp_limb_t *xp; MPFR_SET_ERANGE (); /* To this day, [mp_exp_t] and mp_size_t are #defined as the same type */ EXP (x) = MP_SIZE_T_MAX; sx = PREC (x); SIZ (x) = sx; xp = PTR (x); for (i = 0; i < sx; i++) xp[i] = MP_LIMB_T_MAX; if (MPFR_IS_POS (y)) return -1; else { mpf_neg (x, x); return +1; } } } sx = PREC(x); /* number of limbs of the mantissa of x */ precy = MPFR_PREC(y); precx = (mpfr_prec_t) sx * GMP_NUMB_BITS; sy = MPFR_LIMB_SIZE (y); xp = PTR (x); /* since mpf numbers are represented in base 2^GMP_NUMB_BITS, we loose -EXP(y) % GMP_NUMB_BITS bits in the most significant limb */ sh = MPFR_GET_EXP(y) % GMP_NUMB_BITS; sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh; MPFR_ASSERTD (sh >= 0); if (precy + sh <= precx) /* we can copy directly */ { mp_size_t ds; MPFR_ASSERTN (sx >= sy); ds = sx - sy; if (sh != 0) { mp_limb_t out; out = mpn_rshift (xp + ds, MPFR_MANT(y), sy, sh); MPFR_ASSERTN (ds > 0 || out == 0); if (ds > 0) xp[--ds] = out; } else MPN_COPY (xp + ds, MPFR_MANT (y), sy); if (ds > 0) MPN_ZERO (xp, ds); EXP(x) = (MPFR_GET_EXP(y) + sh) / GMP_NUMB_BITS; inex = 0; } else /* we have to round to precx - sh bits */ { mpfr_t z; mp_size_t sz; /* Recall that precx = (mpfr_prec_t) sx * GMP_NUMB_BITS, thus removing sh bits (sh < GMP_NUMB_BITSS) won't reduce the number of limbs. */ mpfr_init2 (z, precx - sh); sz = MPFR_LIMB_SIZE (z); MPFR_ASSERTN (sx == sz); inex = mpfr_set (z, y, rnd_mode); /* warning, sh may change due to rounding, but then z is a power of two, thus we can safely ignore its last bit which is 0 */ sh = MPFR_GET_EXP(z) % GMP_NUMB_BITS; sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh; MPFR_ASSERTD (sh >= 0); if (sh != 0) { mp_limb_t out; out = mpn_rshift (xp, MPFR_MANT(z), sz, sh); /* If sh hasn't changed, it is the number of the non-significant bits in the lowest limb of z. Therefore out == 0. */ MPFR_ASSERTD (out == 0); (void) out; /* avoid a warning */ } else MPN_COPY (xp, MPFR_MANT(z), sz); EXP(x) = (MPFR_GET_EXP(z) + sh) / GMP_NUMB_BITS; mpfr_clear (z); } /* set size and sign */ SIZ(x) = (MPFR_FROM_SIGN_TO_INT(MPFR_SIGN(y)) < 0) ? -sx : sx; return inex; }

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); }

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); }

static void compute_l2b (int output) { mpfr_ptr p; mpfr_srcptr t; int beta, i; int error = 0; char buffer[30]; if (output) printf ("#ifndef UINT64_C\n# define UINT64_C(c) c\n#endif\n\n"); for (beta = 2; beta <= BASE_MAX; beta++) { for (i = 0; i < 2; i++) { p = &l2b[beta-2][i]; /* Compute the value */ if (i == 0) { /* 23-bit upper approximation to log(b)/log(2) */ mpfr_init2 (p, 23); mpfr_set_ui (p, beta, MPFR_RNDU); mpfr_log2 (p, p, MPFR_RNDU); } else { /* 77-bit upper approximation to log(2)/log(b) */ mpfr_init2 (p, 77); mpfr_set_ui (p, beta, MPFR_RNDD); mpfr_log2 (p, p, MPFR_RNDD); mpfr_ui_div (p, 1, p, MPFR_RNDU); } sprintf (buffer, "mpfr_l2b_%d_%d", beta, i); if (output) print_mpfr (p, buffer); /* Check the value */ t = &__gmpfr_l2b[beta-2][i]; if (t == NULL || MPFR_PREC (t) == 0 || !mpfr_equal_p (p, t)) { if (!output) { error = 1; printf ("Error for constant %s\n", buffer); } } if (!output) mpfr_clear (p); } } if (output) { if (printf ("const __mpfr_struct __gmpfr_l2b[BASE_MAX-1][2] = {\n") < 0) { fprintf (stderr, "Error in printf\n"); exit (1); } for (beta = 2; beta <= BASE_MAX; beta++) { for (i = 0; i < 2; i++) { p = &l2b[beta-2][i]; if (printf (" %c {%3d,%2d,%3ld, (mp_limb_t *) " "mpfr_l2b_%d_%d__tab }%s\n", i == 0 ? '{' : ' ', (int) MPFR_PREC (p), MPFR_SIGN (p), (long) MPFR_GET_EXP (p), beta, i, i == 0 ? "," : beta < BASE_MAX ? " }," : " } };") < 0) { fprintf (stderr, "Error in printf\n"); exit (1); } mpfr_clear (p); } } } /* If there was an error, the test fails. */ if (error) exit (1); }

/* compute sign(b) * (|b| + |c|) Returns 0 iff result is exact, a negative value when the result is less than the exact value, a positive value otherwise. */ int mpfr_add1sp (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { mpfr_uexp_t d; mpfr_prec_t p; unsigned int sh; mp_size_t n; mp_limb_t *ap, *cp; mpfr_exp_t bx; mp_limb_t limb; int inexact; MPFR_TMP_DECL(marker); MPFR_TMP_MARK(marker); MPFR_ASSERTD(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c)); MPFR_ASSERTD(MPFR_IS_PURE_FP(b)); MPFR_ASSERTD(MPFR_IS_PURE_FP(c)); MPFR_ASSERTD(MPFR_GET_EXP(b) >= MPFR_GET_EXP(c)); /* Read prec and num of limbs */ p = MPFR_PREC(b); n = MPFR_PREC2LIMBS (p); MPFR_UNSIGNED_MINUS_MODULO(sh, p); bx = MPFR_GET_EXP(b); d = (mpfr_uexp_t) (bx - MPFR_GET_EXP(c)); DEBUG (printf ("New add1sp with diff=%lu\n", (unsigned long) d)); if (MPFR_UNLIKELY(d == 0)) { /* d==0 */ DEBUG( mpfr_print_mant_binary("C= ", MPFR_MANT(c), p) ); DEBUG( mpfr_print_mant_binary("B= ", MPFR_MANT(b), p) ); bx++; /* exp + 1 */ ap = MPFR_MANT(a); limb = mpn_add_n(ap, MPFR_MANT(b), MPFR_MANT(c), n); DEBUG( mpfr_print_mant_binary("A= ", ap, p) ); MPFR_ASSERTD(limb != 0); /* There must be a carry */ limb = ap[0]; /* Get LSB (In fact, LSW) */ mpn_rshift(ap, ap, n, 1); /* Shift mantissa A */ ap[n-1] |= MPFR_LIMB_HIGHBIT; /* Set MSB */ ap[0] &= ~MPFR_LIMB_MASK(sh); /* Clear LSB bit */ if (MPFR_LIKELY((limb&(MPFR_LIMB_ONE<<sh)) == 0)) /* Check exact case */ { inexact = 0; goto set_exponent; } /* Zero: Truncate Nearest: Even Rule => truncate or add 1 Away: Add 1 */ if (MPFR_LIKELY(rnd_mode==MPFR_RNDN)) { if (MPFR_LIKELY((ap[0]&(MPFR_LIMB_ONE<<sh))==0)) { inexact = -1; goto set_exponent; } else goto add_one_ulp; } MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(b)); if (rnd_mode==MPFR_RNDZ) { inexact = -1; goto set_exponent; } else goto add_one_ulp; } else if (MPFR_UNLIKELY (d >= p)) { if (MPFR_LIKELY (d > p)) { /* d > p : Copy B in A */ /* Away: Add 1 Nearest: Trunc Zero: Trunc */ if (MPFR_LIKELY (rnd_mode==MPFR_RNDN || MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG (b)))) { copy_set_exponent: ap = MPFR_MANT (a); MPN_COPY (ap, MPFR_MANT(b), n); inexact = -1; goto set_exponent; } else { copy_add_one_ulp: ap = MPFR_MANT(a); MPN_COPY (ap, MPFR_MANT(b), n); goto add_one_ulp; } } else { /* d==p : Copy B in A */ /* Away: Add 1 Nearest: Even Rule if C is a power of 2, else Add 1 Zero: Trunc */ if (MPFR_LIKELY(rnd_mode==MPFR_RNDN)) { /* Check if C was a power of 2 */ cp = MPFR_MANT(c); if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && cp[k]==0); if (MPFR_UNLIKELY(k<0)) /* Power of 2: Even rule */ if ((MPFR_MANT (b)[0]&(MPFR_LIMB_ONE<<sh))==0) goto copy_set_exponent; } /* Not a Power of 2 */ goto copy_add_one_ulp; } else if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG (b))) goto copy_set_exponent; else goto copy_add_one_ulp; } } else { mp_limb_t mask; mp_limb_t bcp, bcp1; /* Cp and C'p+1 */ /* General case: 1 <= d < p */ cp = MPFR_TMP_LIMBS_ALLOC (n); /* Shift c in temporary allocated place */ { mpfr_uexp_t dm; mp_size_t m; dm = d % GMP_NUMB_BITS; m = d / GMP_NUMB_BITS; if (MPFR_UNLIKELY(dm == 0)) { /* dm = 0 and m > 0: Just copy */ MPFR_ASSERTD(m!=0); MPN_COPY(cp, MPFR_MANT(c)+m, n-m); MPN_ZERO(cp+n-m, m); } else if (MPFR_LIKELY(m == 0)) { /* dm >=1 and m == 0: just shift */ MPFR_ASSERTD(dm >= 1); mpn_rshift(cp, MPFR_MANT(c), n, dm); } else { /* dm > 0 and m > 0: shift and zero */ mpn_rshift(cp, MPFR_MANT(c)+m, n-m, dm); MPN_ZERO(cp+n-m, m); } } DEBUG( mpfr_print_mant_binary("Before", MPFR_MANT(c), p) ); DEBUG( mpfr_print_mant_binary("B= ", MPFR_MANT(b), p) ); DEBUG( mpfr_print_mant_binary("After ", cp, p) ); /* Compute bcp=Cp and bcp1=C'p+1 */ if (MPFR_LIKELY (sh > 0)) { /* Try to compute them from C' rather than C */ bcp = (cp[0] & (MPFR_LIMB_ONE<<(sh-1))) ; if (MPFR_LIKELY(cp[0]&MPFR_LIMB_MASK(sh-1))) bcp1 = 1; else { /* We can't compute C'p+1 from C'. Compute it from C */ /* Start from bit x=p-d+sh in mantissa C (+sh since we have already looked sh bits in C'!) */ mpfr_prec_t x = p-d+sh-1; if (MPFR_LIKELY(x>p)) /* We are already looked at all the bits of c, so C'p+1 = 0*/ bcp1 = 0; else { mp_limb_t *tp = MPFR_MANT(c); mp_size_t kx = n-1 - (x / GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); DEBUG (printf ("(First) x=%lu Kx=%ld Sx=%lu\n", (unsigned long) x, (long) kx, (unsigned long) sx)); /* Looks at the last bits of limb kx (if sx=0 does nothing)*/ if (tp[kx] & MPFR_LIMB_MASK(sx)) bcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bcp1 = (kx >= 0); } } } } else /* sh == 0 */ { /* Compute Cp and C'p+1 from C with sh=0 */ mp_limb_t *tp = MPFR_MANT(c); /* Start from bit x=p-d in mantissa C */ mpfr_prec_t x = p-d; mp_size_t kx = n-1 - (x / GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); MPFR_ASSERTD(p >= d); bcp = tp[kx] & (MPFR_LIMB_ONE<<sx); /* Looks at the last bits of limb kx (If sx=0, does nothing)*/ if (tp[kx]&MPFR_LIMB_MASK(sx)) bcp1 = 1; else { do { kx--; } while (kx>=0 && tp[kx]==0); bcp1 = (kx>=0); } } DEBUG (printf("sh=%u Cp=%lu C'p+1=%lu\n", sh, (unsigned long) bcp, (unsigned long) bcp1)); /* Clean shifted C' */ mask = ~MPFR_LIMB_MASK(sh); cp[0] &= mask; /* Add the mantissa c from b in a */ ap = MPFR_MANT(a); limb = mpn_add_n (ap, MPFR_MANT(b), cp, n); DEBUG( mpfr_print_mant_binary("Add= ", ap, p) ); /* Check for overflow */ if (MPFR_UNLIKELY (limb)) { limb = ap[0] & (MPFR_LIMB_ONE<<sh); /* Get LSB */ mpn_rshift (ap, ap, n, 1); /* Shift mantissa*/ bx++; /* Fix exponent */ ap[n-1] |= MPFR_LIMB_HIGHBIT; /* Set MSB */ ap[0] &= mask; /* Clear LSB bit */ bcp1 |= bcp; /* Recompute C'p+1 */ bcp = limb; /* Recompute Cp */ DEBUG (printf ("(Overflow) Cp=%lu C'p+1=%lu\n", (unsigned long) bcp, (unsigned long) bcp1)); DEBUG (mpfr_print_mant_binary ("Add= ", ap, p)); } /* Round: Zero: Truncate but could be exact. Away: Add 1 if Cp or C'p+1 !=0 Nearest: Truncate but could be exact if Cp==0 Add 1 if C'p+1 !=0, Even rule else */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { if (MPFR_LIKELY(bcp == 0)) { inexact = MPFR_LIKELY(bcp1) ? -1 : 0; goto set_exponent; } else if (MPFR_UNLIKELY(bcp1==0) && (ap[0]&(MPFR_LIMB_ONE<<sh))==0) { inexact = -1; goto set_exponent; } else goto add_one_ulp; } MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(b)); if (rnd_mode == MPFR_RNDZ) { inexact = MPFR_LIKELY(bcp || bcp1) ? -1 : 0; goto set_exponent; } else { if (MPFR_UNLIKELY(bcp==0 && bcp1==0)) { inexact = 0; goto set_exponent; } else goto add_one_ulp; } } MPFR_ASSERTN(0); add_one_ulp: /* add one unit in last place to a */ DEBUG( printf("AddOneUlp\n") ); if (MPFR_UNLIKELY( mpn_add_1(ap, ap, n, MPFR_LIMB_ONE<<sh) )) { /* Case 100000x0 = 0x1111x1 + 1*/ DEBUG( printf("Pow of 2\n") ); bx++; ap[n-1] = MPFR_LIMB_HIGHBIT; } inexact = 1; set_exponent: if (MPFR_UNLIKELY(bx > __gmpfr_emax)) /* Check for overflow */ { DEBUG( printf("Overflow\n") ); MPFR_TMP_FREE(marker); MPFR_SET_SAME_SIGN(a,b); return mpfr_overflow(a, rnd_mode, MPFR_SIGN(a)); } MPFR_SET_EXP (a, bx); MPFR_SET_SAME_SIGN(a,b); MPFR_TMP_FREE(marker); MPFR_RET (inexact * MPFR_INT_SIGN (a)); }