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 */ }

/* The computation of z = pow(x,y) is done by z = exp(y * log(x)) = x^y For the special cases, see Section F.9.4.4 of the C standard: _ pow(±0, y) = ±inf for y an odd integer < 0. _ pow(±0, y) = +inf for y < 0 and not an odd integer. _ pow(±0, y) = ±0 for y an odd integer > 0. _ pow(±0, y) = +0 for y > 0 and not an odd integer. _ pow(-1, ±inf) = 1. _ pow(+1, y) = 1 for any y, even a NaN. _ pow(x, ±0) = 1 for any x, even a NaN. _ pow(x, y) = NaN for finite x < 0 and finite non-integer y. _ pow(x, -inf) = +inf for |x| < 1. _ pow(x, -inf) = +0 for |x| > 1. _ pow(x, +inf) = +0 for |x| < 1. _ pow(x, +inf) = +inf for |x| > 1. _ pow(-inf, y) = -0 for y an odd integer < 0. _ pow(-inf, y) = +0 for y < 0 and not an odd integer. _ pow(-inf, y) = -inf for y an odd integer > 0. _ pow(-inf, y) = +inf for y > 0 and not an odd integer. _ pow(+inf, y) = +0 for y < 0. _ pow(+inf, y) = +inf for y > 0. */ int mpfr_pow (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode) { int inexact; int cmp_x_1; int y_is_integer; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode), ("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inexact)); if (MPFR_ARE_SINGULAR (x, y)) { /* pow(x, 0) returns 1 for any x, even a NaN. */ if (MPFR_UNLIKELY (MPFR_IS_ZERO (y))) return mpfr_set_ui (z, 1, rnd_mode); else if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (z); MPFR_RET_NAN; } else if (MPFR_IS_NAN (y)) { /* pow(+1, NaN) returns 1. */ if (mpfr_cmp_ui (x, 1) == 0) return mpfr_set_ui (z, 1, rnd_mode); MPFR_SET_NAN (z); MPFR_RET_NAN; } else if (MPFR_IS_INF (y)) { if (MPFR_IS_INF (x)) { if (MPFR_IS_POS (y)) MPFR_SET_INF (z); else MPFR_SET_ZERO (z); MPFR_SET_POS (z); MPFR_RET (0); } else { int cmp; cmp = mpfr_cmpabs (x, __gmpfr_one) * MPFR_INT_SIGN (y); MPFR_SET_POS (z); if (cmp > 0) { /* Return +inf. */ MPFR_SET_INF (z); MPFR_RET (0); } else if (cmp < 0) { /* Return +0. */ MPFR_SET_ZERO (z); MPFR_RET (0); } else { /* Return 1. */ return mpfr_set_ui (z, 1, rnd_mode); } } } else if (MPFR_IS_INF (x)) { int negative; /* Determine the sign now, in case y and z are the same object */ negative = MPFR_IS_NEG (x) && mpfr_odd_p (y); if (MPFR_IS_POS (y)) MPFR_SET_INF (z); else MPFR_SET_ZERO (z); if (negative) MPFR_SET_NEG (z); else MPFR_SET_POS (z); MPFR_RET (0); } else { int negative; MPFR_ASSERTD (MPFR_IS_ZERO (x)); /* Determine the sign now, in case y and z are the same object */ negative = MPFR_IS_NEG(x) && mpfr_odd_p (y); if (MPFR_IS_NEG (y)) { MPFR_ASSERTD (! MPFR_IS_INF (y)); MPFR_SET_INF (z); MPFR_SET_DIVBY0 (); } else MPFR_SET_ZERO (z); if (negative) MPFR_SET_NEG (z); else MPFR_SET_POS (z); MPFR_RET (0); } } /* x^y for x < 0 and y not an integer is not defined */ y_is_integer = mpfr_integer_p (y); if (MPFR_IS_NEG (x) && ! y_is_integer) { MPFR_SET_NAN (z); MPFR_RET_NAN; } /* now the result cannot be NaN: (1) either x > 0 (2) or x < 0 and y is an integer */ cmp_x_1 = mpfr_cmpabs (x, __gmpfr_one); if (cmp_x_1 == 0) return mpfr_set_si (z, MPFR_IS_NEG (x) && mpfr_odd_p (y) ? -1 : 1, rnd_mode); /* now we have: (1) either x > 0 (2) or x < 0 and y is an integer and in addition |x| <> 1. */ /* detect overflow: an overflow is possible if (a) |x| > 1 and y > 0 (b) |x| < 1 and y < 0. FIXME: this assumes 1 is always representable. FIXME2: maybe we can test overflow and underflow simultaneously. The idea is the following: first compute an approximation to y * log2|x|, using rounding to nearest. If |x| is not too near from 1, this approximation should be accurate enough, and in most cases enable one to prove that there is no underflow nor overflow. Otherwise, it should enable one to check only underflow or overflow, instead of both cases as in the present case. */ /* fast check for cases where no overflow nor underflow is possible: if |y| <= 2^15, and -32767 < EXP(x) <= 32767, then |y*log2(x)| <= 2^15*32767 < 1073741823, thus for the default emax=1073741823 and emin=-emax there can be no overflow nor underflow */ if (__gmpfr_emax >= 1073741823 && __gmpfr_emin <= -1073741823 && MPFR_EXP(y) <= 15 && -32767 < MPFR_EXP(x) && MPFR_EXP(x) <= 32767) goto no_overflow_nor_underflow; if (cmp_x_1 * MPFR_SIGN (y) > 0) { mpfr_t t; int negative, overflow; MPFR_SAVE_EXPO_MARK (expo); mpfr_init2 (t, 53); /* we want a lower bound on y*log2|x|: (i) if x > 0, it suffices to round log2(x) toward zero, and to round y*o(log2(x)) toward zero too; (ii) if x < 0, we first compute t = o(-x), with rounding toward 1, and then follow as in case (1). */ if (MPFR_IS_POS (x)) mpfr_log2 (t, x, MPFR_RNDZ); else { mpfr_neg (t, x, (cmp_x_1 > 0) ? MPFR_RNDZ : MPFR_RNDU); mpfr_log2 (t, t, MPFR_RNDZ); } mpfr_mul (t, t, y, MPFR_RNDZ); overflow = mpfr_cmp_si (t, __gmpfr_emax) > 0; mpfr_clear (t); MPFR_SAVE_EXPO_FREE (expo); if (overflow) { MPFR_LOG_MSG (("early overflow detection\n", 0)); negative = MPFR_IS_NEG (x) && mpfr_odd_p (y); return mpfr_overflow (z, rnd_mode, negative ? -1 : 1); } } /* Basic underflow checking. One has: * - if y > 0, |x^y| < 2^(EXP(x) * y); * - if y < 0, |x^y| <= 2^((EXP(x) - 1) * y); * so that one can compute a value ebound such that |x^y| < 2^ebound. * If we have ebound <= emin - 2 (emin - 1 in directed rounding modes), * then there is an underflow and we can decide the return value. */ if (MPFR_IS_NEG (y) ? (MPFR_GET_EXP (x) > 1) : (MPFR_GET_EXP (x) < 0)) { mp_limb_t tmp_limb[MPFR_EXP_LIMB_SIZE]; mpfr_t tmp; mpfr_eexp_t ebound; int inex2; /* We must restore the flags. */ MPFR_SAVE_EXPO_MARK (expo); MPFR_TMP_INIT1 (tmp_limb, tmp, sizeof (mpfr_exp_t) * CHAR_BIT); inex2 = mpfr_set_exp_t (tmp, MPFR_GET_EXP (x), MPFR_RNDN); MPFR_ASSERTN (inex2 == 0); if (MPFR_IS_NEG (y)) { inex2 = mpfr_sub_ui (tmp, tmp, 1, MPFR_RNDN); MPFR_ASSERTN (inex2 == 0); } mpfr_mul (tmp, tmp, y, MPFR_RNDU); if (MPFR_IS_NEG (y)) mpfr_nextabove (tmp); /* tmp doesn't necessarily fit in ebound, but that doesn't matter since we get the minimum value in such a case. */ ebound = mpfr_get_exp_t (tmp, MPFR_RNDU); MPFR_SAVE_EXPO_FREE (expo); if (MPFR_UNLIKELY (ebound <= __gmpfr_emin - (rnd_mode == MPFR_RNDN ? 2 : 1))) { /* warning: mpfr_underflow rounds away from 0 for MPFR_RNDN */ MPFR_LOG_MSG (("early underflow detection\n", 0)); return mpfr_underflow (z, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode, MPFR_IS_NEG (x) && mpfr_odd_p (y) ? -1 : 1); } } no_overflow_nor_underflow: /* If y is an integer, we can use mpfr_pow_z (based on multiplications), but if y is very large (I'm not sure about the best threshold -- VL), we shouldn't use it, as it can be very slow and take a lot of memory (and even crash or make other programs crash, as several hundred of MBs may be necessary). Note that in such a case, either x = +/-2^b (this case is handled below) or x^y cannot be represented exactly in any precision supported by MPFR (the general case uses this property). */ if (y_is_integer && (MPFR_GET_EXP (y) <= 256)) { mpz_t zi; MPFR_LOG_MSG (("special code for y not too large integer\n", 0)); mpz_init (zi); mpfr_get_z (zi, y, MPFR_RNDN); inexact = mpfr_pow_z (z, x, zi, rnd_mode); mpz_clear (zi); return inexact; } /* Special case (+/-2^b)^Y which could be exact. If x is negative, then necessarily y is a large integer. */ if (mpfr_powerof2_raw (x)) { mpfr_exp_t b = MPFR_GET_EXP (x) - 1; mpfr_t tmp; int sgnx = MPFR_SIGN (x); MPFR_ASSERTN (b >= LONG_MIN && b <= LONG_MAX); /* FIXME... */ MPFR_LOG_MSG (("special case (+/-2^b)^Y\n", 0)); /* now x = +/-2^b, so x^y = (+/-1)^y*2^(b*y) is exact whenever b*y is an integer */ MPFR_SAVE_EXPO_MARK (expo); mpfr_init2 (tmp, MPFR_PREC (y) + sizeof (long) * CHAR_BIT); inexact = mpfr_mul_si (tmp, y, b, MPFR_RNDN); /* exact */ MPFR_ASSERTN (inexact == 0); /* Note: as the exponent range has been extended, an overflow is not possible (due to basic overflow and underflow checking above, as the result is ~ 2^tmp), and an underflow is not possible either because b is an integer (thus either 0 or >= 1). */ MPFR_CLEAR_FLAGS (); inexact = mpfr_exp2 (z, tmp, rnd_mode); mpfr_clear (tmp); if (sgnx < 0 && mpfr_odd_p (y)) { mpfr_neg (z, z, rnd_mode); inexact = -inexact; } /* Without the following, the overflows3 test in tpow.c fails. */ MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (z, inexact, rnd_mode); } MPFR_SAVE_EXPO_MARK (expo); /* Case where y * log(x) is very small. Warning: x can be negative, in that case y is a large integer. */ { mpfr_exp_t err, expx, logt; /* We need an upper bound on the exponent of y * log(x). */ if (MPFR_IS_POS(x)) expx = cmp_x_1 > 0 ? MPFR_EXP(x) : 1 - MPFR_EXP(x); else expx = mpfr_cmp_si (x, -1) > 0 ? 1 - MPFR_EXP(x) : MPFR_EXP(x); MPFR_ASSERTD(expx >= 0); /* now |log(x)| < expx */ logt = MPFR_INT_CEIL_LOG2 (expx); /* now expx <= 2^logt */ err = MPFR_GET_EXP (y) + logt; MPFR_CLEAR_FLAGS (); MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (z, __gmpfr_one, - err, 0, (MPFR_IS_POS (y)) ^ (cmp_x_1 < 0), rnd_mode, expo, {}); } /* General case */ inexact = mpfr_pow_general (z, x, y, rnd_mode, y_is_integer, &expo); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (z, inexact, rnd_mode); }

/* Input: s - a floating-point number >= 1/2. rnd_mode - a rounding mode. Assumes s is neither NaN nor Infinite. Output: z - Zeta(s) rounded to the precision of z with direction rnd_mode */ static int mpfr_zeta_pos (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode) { mpfr_t b, c, z_pre, f, s1; double beta, sd, dnep; mpfr_t *tc1; mpfr_prec_t precz, precs, d, dint; int p, n, l, add; int inex; MPFR_GROUP_DECL (group); MPFR_ZIV_DECL (loop); MPFR_ASSERTD (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0); precz = MPFR_PREC (z); precs = MPFR_PREC (s); /* Zeta(x) = 1+1/2^x+1/3^x+1/4^x+1/5^x+O(1/6^x) so with 2^(EXP(x)-1) <= x < 2^EXP(x) So for x > 2^3, k^x > k^8, so 2/k^x < 2/k^8 Zeta(x) = 1 + 1/2^x*(1+(2/3)^x+(2/4)^x+...) = 1 + 1/2^x*(1+sum((2/k)^x,k=3..infinity)) <= 1 + 1/2^x*(1+sum((2/k)^8,k=3..infinity)) And sum((2/k)^8,k=3..infinity) = -257+128*Pi^8/4725 ~= 0.0438035 So Zeta(x) <= 1 + 1/2^x*2 for x >= 8 The error is < 2^(-x+1) <= 2^(-2^(EXP(x)-1)+1) */ if (MPFR_GET_EXP (s) > 3) { mpfr_exp_t err; err = MPFR_GET_EXP (s) - 1; if (err > (mpfr_exp_t) (sizeof (mpfr_exp_t)*CHAR_BIT-2)) err = MPFR_EMAX_MAX; else err = ((mpfr_exp_t)1) << err; err = 1 - (-err+1); /* GET_EXP(one) - (-err+1) = err :) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (z, __gmpfr_one, err, 0, 1, rnd_mode, {}); } d = precz + MPFR_INT_CEIL_LOG2(precz) + 10; /* we want that s1 = s-1 is exact, i.e. we should have PREC(s1) >= EXP(s) */ dint = (mpfr_uexp_t) MPFR_GET_EXP (s); mpfr_init2 (s1, MAX (precs, dint)); inex = mpfr_sub (s1, s, __gmpfr_one, MPFR_RNDN); MPFR_ASSERTD (inex == 0); /* case s=1 should have already been handled */ MPFR_ASSERTD (!MPFR_IS_ZERO (s1)); MPFR_GROUP_INIT_4 (group, MPFR_PREC_MIN, b, c, z_pre, f); MPFR_ZIV_INIT (loop, d); for (;;) { /* Principal loop: we compute, in z_pre, an approximation of Zeta(s), that we send to can_round */ if (MPFR_GET_EXP (s1) <= -(mpfr_exp_t) ((mpfr_prec_t) (d-3)/2)) /* Branch 1: when s-1 is very small, one uses the approximation Zeta(s)=1/(s-1)+gamma, where gamma is Euler's constant */ { dint = MAX (d + 3, precs); MPFR_TRACE (printf ("branch 1\ninternal precision=%lu\n", (unsigned long) dint)); MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f); mpfr_div (z_pre, __gmpfr_one, s1, MPFR_RNDN); mpfr_const_euler (f, MPFR_RNDN); mpfr_add (z_pre, z_pre, f, MPFR_RNDN); } else /* Branch 2 */ { size_t size; MPFR_TRACE (printf ("branch 2\n")); /* Computation of parameters n, p and working precision */ dnep = (double) d * LOG2; sd = mpfr_get_d (s, MPFR_RNDN); /* beta = dnep + 0.61 + sd * log (6.2832 / sd); but a larger value is ok */ #define LOG6dot2832 1.83787940484160805532 beta = dnep + 0.61 + sd * (LOG6dot2832 - LOG2 * __gmpfr_floor_log2 (sd)); if (beta <= 0.0) { p = 0; /* n = 1 + (int) (exp ((dnep - LOG2) / sd)); */ n = 1 + (int) __gmpfr_ceil_exp2 ((d - 1.0) / sd); } else { p = 1 + (int) beta / 2; n = 1 + (int) ((sd + 2.0 * (double) p - 1.0) / 6.2832); } MPFR_TRACE (printf ("\nn=%d\np=%d\n",n,p)); /* add = 4 + floor(1.5 * log(d) / log (2)). We should have add >= 10, which is always fulfilled since d = precz + 11 >= 12, thus ceil(log2(d)) >= 4 */ add = 4 + (3 * MPFR_INT_CEIL_LOG2 (d)) / 2; MPFR_ASSERTD(add >= 10); dint = d + add; if (dint < precs) dint = precs; MPFR_TRACE (printf ("internal precision=%lu\n", (unsigned long) dint)); size = (p + 1) * sizeof(mpfr_t); tc1 = (mpfr_t*) (*__gmp_allocate_func) (size); for (l=1; l<=p; l++) mpfr_init2 (tc1[l], dint); MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f); MPFR_TRACE (printf ("precision of z = %lu\n", (unsigned long) precz)); /* Computation of the coefficients c_k */ mpfr_zeta_c (p, tc1); /* Computation of the 3 parts of the fonction Zeta. */ mpfr_zeta_part_a (z_pre, s, n); mpfr_zeta_part_b (b, s, n, p, tc1); /* s1 = s-1 is already computed above */ mpfr_div (c, __gmpfr_one, s1, MPFR_RNDN); mpfr_ui_pow (f, n, s1, MPFR_RNDN); mpfr_div (c, c, f, MPFR_RNDN); MPFR_TRACE (MPFR_DUMP (c)); mpfr_add (z_pre, z_pre, c, MPFR_RNDN); mpfr_add (z_pre, z_pre, b, MPFR_RNDN); for (l=1; l<=p; l++) mpfr_clear (tc1[l]); (*__gmp_free_func) (tc1, size); /* End branch 2 */ } MPFR_TRACE (MPFR_DUMP (z_pre)); if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, d-3, precz, rnd_mode))) break; MPFR_ZIV_NEXT (loop, d); } MPFR_ZIV_FREE (loop); inex = mpfr_set (z, z_pre, rnd_mode); MPFR_GROUP_CLEAR (group); mpfr_clear (s1); return inex; }

int mpfr_add (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { MPFR_LOG_FUNC (("b[%Pu]=%.*Rg c[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (b), mpfr_log_prec, b, mpfr_get_prec (c), mpfr_log_prec, c, rnd_mode), ("a[%Pu]=%.*Rg", mpfr_get_prec (a), mpfr_log_prec, 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_ASSERTD (MPFR_IS_PURE_FP (c)); if (MPFR_UNLIKELY(MPFR_SIGN(b) != MPFR_SIGN(c))) { /* signs differ, it is 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 main (int argc, char *argv[]) { mpfr_t x, y; mpfr_exp_t emin, emax; tests_start_mpfr (); special_overflow (); emax_m_eps (); exp_range (); mpfr_init (x); mpfr_init (y); mpfr_set_ui (x, 4, MPFR_RNDN); mpfr_exp2 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 16) != 0) { printf ("Error for 2^4, MPFR_RNDN\n"); exit (1); } mpfr_exp2 (y, x, MPFR_RNDD); if (mpfr_cmp_ui (y, 16) != 0) { printf ("Error for 2^4, MPFR_RNDD\n"); exit (1); } mpfr_exp2 (y, x, MPFR_RNDU); if (mpfr_cmp_ui (y, 16) != 0) { printf ("Error for 2^4, MPFR_RNDU\n"); exit (1); } mpfr_set_si (x, -4, MPFR_RNDN); mpfr_exp2 (y, x, MPFR_RNDN); if (mpfr_cmp_ui_2exp (y, 1, -4) != 0) { printf ("Error for 2^(-4), MPFR_RNDN\n"); exit (1); } mpfr_exp2 (y, x, MPFR_RNDD); if (mpfr_cmp_ui_2exp (y, 1, -4) != 0) { printf ("Error for 2^(-4), MPFR_RNDD\n"); exit (1); } mpfr_exp2 (y, x, MPFR_RNDU); if (mpfr_cmp_ui_2exp (y, 1, -4) != 0) { printf ("Error for 2^(-4), MPFR_RNDU\n"); exit (1); } mpfr_set_prec (x, 53); mpfr_set_prec (y, 53); mpfr_set_str (x, /*-1683977482443233.0 / 2199023255552.0*/ "-7.6578429909351734750089235603809357e2", 10, MPFR_RNDN); mpfr_exp2 (y, x, MPFR_RNDN); if (mpfr_cmp_str1 (y, "2.991959870867646566478e-231")) { printf ("Error for x=-1683977482443233/2^41\n"); exit (1); } mpfr_set_prec (x, 10); mpfr_set_prec (y, 10); /* save emin */ emin = mpfr_get_emin (); set_emin (-10); mpfr_set_si (x, -12, MPFR_RNDN); mpfr_exp2 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0) { printf ("Error for x=emin-2, RNDN\n"); printf ("Expected +0\n"); printf ("Got "); mpfr_dump (y); exit (1); } /* restore emin */ set_emin (emin); /* save emax */ emax = mpfr_get_emax (); set_emax (10); mpfr_set_ui (x, 11, MPFR_RNDN); mpfr_exp2 (y, x, MPFR_RNDN); if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0) { printf ("Error for x=emax+1, RNDN\n"); exit (1); } /* restore emax */ set_emax (emax); MPFR_SET_INF(x); MPFR_SET_POS(x); mpfr_exp2 (y, x, MPFR_RNDN); if(!MPFR_IS_INF(y)) { printf ("evaluation of function in INF does not return INF\n"); exit (1); } MPFR_CHANGE_SIGN(x); mpfr_exp2 (y, x, MPFR_RNDN); if(!MPFR_IS_ZERO(y)) { printf ("evaluation of function in -INF does not return 0\n"); exit (1); } MPFR_SET_NAN(x); mpfr_exp2 (y, x, MPFR_RNDN); if(!MPFR_IS_NAN(y)) { printf ("evaluation of function in NaN does not return NaN\n"); exit (1); } if ((mpfr_uexp_t) 8 << 31 != 0 || mpfr_get_emax () <= (mpfr_uexp_t) 100000 * 100000) { /* emax <= 10000000000 */ mpfr_set_prec (x, 40); mpfr_set_prec (y, 40); mpfr_set_str (x, "10000000000.5", 10, MPFR_RNDN); mpfr_clear_flags (); mpfr_exp2 (y, x, MPFR_RNDN); if (!(MPFR_IS_INF (y) && MPFR_IS_POS (y) && mpfr_overflow_p ())) { printf ("exp2(10000000000.5) should overflow.\n"); exit (1); } } mpfr_set_prec (x, 2); mpfr_set_prec (y, 2); mpfr_set_str_binary (x, "-1.0E-26"); mpfr_exp2 (y, x, MPFR_RNDD); mpfr_set_str_binary (x, "1.1E-1"); if (mpfr_cmp (x, y)) { printf ("Error for exp(-2^(-26)) for prec=2\n"); exit (1); } test_generic (MPFR_PREC_MIN, 100, 100); mpfr_clear (x); mpfr_clear (y); overflowed_exp2_0 (); data_check ("data/exp2", mpfr_exp2, "mpfr_exp2"); tests_end_mpfr (); return 0; }

int mpfr_log1p (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { int comp, inexact; mpfr_exp_t ex; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } /* check for inf or -inf (result is not defined) */ else if (MPFR_IS_INF (x)) { if (MPFR_IS_POS (x)) { MPFR_SET_INF (y); MPFR_SET_POS (y); MPFR_RET (0); } else { MPFR_SET_NAN (y); MPFR_RET_NAN; } } else /* x is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); /* log1p(+/- 0) = +/- 0 */ MPFR_SET_SAME_SIGN (y, x); MPFR_RET (0); } } ex = MPFR_GET_EXP (x); if (ex < 0) /* -0.5 < x < 0.5 */ { /* For x > 0, abs(log(1+x)-x) < x^2/2. For x > -0.5, abs(log(1+x)-x) < x^2. */ if (MPFR_IS_POS (x)) MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, - ex - 1, 0, 0, rnd_mode, {}); else MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, - ex, 0, 1, rnd_mode, {}); } comp = mpfr_cmp_si (x, -1); /* log1p(x) is undefined for x < -1 */ if (MPFR_UNLIKELY(comp <= 0)) { if (comp == 0) /* x=0: log1p(-1)=-inf (divide-by-zero exception) */ { MPFR_SET_INF (y); MPFR_SET_NEG (y); mpfr_set_divby0 (); MPFR_RET (0); } MPFR_SET_NAN (y); MPFR_RET_NAN; } MPFR_SAVE_EXPO_MARK (expo); /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t; /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_exp_t err; /* error */ MPFR_ZIV_DECL (loop); /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 6; /* if |x| is smaller than 2^(-e), we will loose about e bits in log(1+x) */ if (MPFR_EXP(x) < 0) Nt += -MPFR_EXP(x); /* initialise of intermediary variable */ mpfr_init2 (t, Nt); /* First computation of log1p */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute log1p */ inexact = mpfr_add_ui (t, x, 1, MPFR_RNDN); /* 1+x */ /* if inexact = 0, then t = x+1, and the result is simply log(t) */ if (inexact == 0) { inexact = mpfr_log (y, t, rnd_mode); goto end; } mpfr_log (t, t, MPFR_RNDN); /* log(1+x) */ /* the error is bounded by (1/2+2^(1-EXP(t))*ulp(t) (cf algorithms.tex) if EXP(t)>=2, then error <= ulp(t) if EXP(t)<=1, then error <= 2^(2-EXP(t))*ulp(t) */ err = Nt - MAX (0, 2 - MPFR_GET_EXP (t)); if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* increase the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); } inexact = mpfr_set (y, t, rnd_mode); end: MPFR_ZIV_FREE (loop); mpfr_clear (t); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }

int mpfr_cmp_si_2exp (mpfr_srcptr b, long int i, mpfr_exp_t f) { int si; si = i < 0 ? -1 : 1; /* sign of i */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (b))) { if (MPFR_IS_INF(b)) return MPFR_INT_SIGN(b); else if (MPFR_IS_ZERO(b)) return i != 0 ? -si : 0; /* NAN */ MPFR_SET_ERANGEFLAG (); return 0; } else if (MPFR_SIGN(b) != si || i == 0) return MPFR_INT_SIGN (b); else /* b and i are of same sign si */ { mpfr_exp_t e; unsigned long ai; int k; mp_size_t bn; mp_limb_t c, *bp; ai = SAFE_ABS(unsigned long, i); /* ai must be representable in a mp_limb_t */ MPFR_ASSERTN(ai == (mp_limb_t) ai); e = MPFR_GET_EXP (b); /* 2^(e-1) <= b < 2^e */ if (e <= f) return -si; if (f < MPFR_EMAX_MAX - GMP_NUMB_BITS && e > f + GMP_NUMB_BITS) return si; /* now f < e <= f + GMP_NUMB_BITS */ c = (mp_limb_t) ai; count_leading_zeros(k, c); if ((int) (e - f) > GMP_NUMB_BITS - k) return si; if ((int) (e - f) < GMP_NUMB_BITS - k) return -si; /* now b and i*2^f have the same exponent */ c <<= k; bn = (MPFR_PREC(b) - 1) / GMP_NUMB_BITS; bp = MPFR_MANT(b); if (bp[bn] > c) return si; if (bp[bn] < c) return -si; /* most significant limbs agree, check remaining limbs from b */ while (bn > 0) if (bp[--bn]) return si; return 0; } }

int mpfr_cbrt (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpz_t m; mpfr_exp_t e, r, sh; mpfr_prec_t n, size_m, tmp; int inexact, negative; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC ( ("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inexact)); /* special values */ 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)) { MPFR_SET_INF (y); MPFR_SET_SAME_SIGN (y, x); MPFR_RET (0); } /* case 0: cbrt(+/- 0) = +/- 0 */ else /* x is necessarily 0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (y); MPFR_SET_SAME_SIGN (y, x); MPFR_RET (0); } } /* General case */ MPFR_SAVE_EXPO_MARK (expo); mpz_init (m); e = mpfr_get_z_2exp (m, x); /* x = m * 2^e */ if ((negative = MPFR_IS_NEG(x))) mpz_neg (m, m); r = e % 3; if (r < 0) r += 3; /* x = (m*2^r) * 2^(e-r) = (m*2^r) * 2^(3*q) */ MPFR_MPZ_SIZEINBASE2 (size_m, m); n = MPFR_PREC (y) + (rnd_mode == MPFR_RNDN); /* we want 3*n-2 <= size_m + 3*sh + r <= 3*n i.e. 3*sh + size_m + r <= 3*n */ sh = (3 * (mpfr_exp_t) n - (mpfr_exp_t) size_m - r) / 3; sh = 3 * sh + r; if (sh >= 0) { mpz_mul_2exp (m, m, sh); e = e - sh; } else if (r > 0) { mpz_mul_2exp (m, m, r); e = e - r; } /* invariant: x = m*2^e, with e divisible by 3 */ /* we reuse the variable m to store the cube root, since it is not needed any more: we just need to know if the root is exact */ inexact = mpz_root (m, m, 3) == 0; MPFR_MPZ_SIZEINBASE2 (tmp, m); sh = tmp - n; if (sh > 0) /* we have to flush to 0 the last sh bits from m */ { inexact = inexact || ((mpfr_exp_t) mpz_scan1 (m, 0) < sh); mpz_fdiv_q_2exp (m, m, sh); e += 3 * sh; } if (inexact) { if (negative) rnd_mode = MPFR_INVERT_RND (rnd_mode); if (rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDA || (rnd_mode == MPFR_RNDN && mpz_tstbit (m, 0))) inexact = 1, mpz_add_ui (m, m, 1); else inexact = -1; } /* either inexact is not zero, and the conversion is exact, i.e. inexact is not changed; or inexact=0, and inexact is set only when rnd_mode=MPFR_RNDN and bit (n+1) from m is 1 */ inexact += mpfr_set_z (y, m, MPFR_RNDN); MPFR_SET_EXP (y, MPFR_GET_EXP (y) + e / 3); if (negative) { MPFR_CHANGE_SIGN (y); inexact = -inexact; } mpz_clear (m); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }

static void check_overflow (void) { mpfr_t x; char *s; mpfr_init (x); /* Huge overflow */ mpfr_strtofr (x, "123456789E2147483646", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (1) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "123456789E9223372036854775807", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (2) with:\n s='%s'\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "123456789E170141183460469231731687303715884105728", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (3) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } /* Limit overflow */ mpfr_strtofr (x, "12E2147483646", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) ) { printf ("Check overflow failed (4) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "12E2147483645", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (5) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "0123456789ABCDEF@2147483640", &s, 16, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (6) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "0123456789ABCDEF@540000000", &s, 16, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (7) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } /* Check underflow */ mpfr_strtofr (x, "123456789E-2147483646", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x) ) { printf ("Check underflow failed (1) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "123456789E-9223372036854775807", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x) ) { printf ("Check underflow failed (2) with:\n s='%s'\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "-123456789E-170141183460469231731687303715884105728", &s, 0, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_NEG (x) ) { printf ("Check underflow failed (3) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_strtofr (x, "0123456789ABCDEF@-540000000", &s, 16, MPFR_RNDN); if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x)) { printf ("Check overflow failed (7) with:\n s=%s\n x=", s); mpfr_dump (x); exit (1); } mpfr_clear (x); }

/* Set iop to the integral part of op and fop to its fractional part */ int mpfr_modf (mpfr_ptr iop, mpfr_ptr fop, mpfr_srcptr op, mpfr_rnd_t rnd_mode) { mpfr_exp_t ope; mpfr_prec_t opq; int inexi, inexf; MPFR_LOG_FUNC (("op[%#R]=%R rnd=%d", op, op, rnd_mode), ("iop[%#R]=%R fop[%#R]=%R", iop, iop, fop, fop)); MPFR_ASSERTN (iop != fop); if ( MPFR_UNLIKELY (MPFR_IS_SINGULAR (op)) ) { if (MPFR_IS_NAN (op)) { MPFR_SET_NAN (iop); MPFR_SET_NAN (fop); MPFR_RET_NAN; } MPFR_SET_SAME_SIGN (iop, op); MPFR_SET_SAME_SIGN (fop, op); if (MPFR_IS_INF (op)) { MPFR_SET_INF (iop); MPFR_SET_ZERO (fop); MPFR_RET (0); } else /* op is zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (op)); MPFR_SET_ZERO (iop); MPFR_SET_ZERO (fop); MPFR_RET (0); } } ope = MPFR_GET_EXP (op); opq = MPFR_PREC (op); if (ope <= 0) /* 0 < |op| < 1 */ { inexf = (fop != op) ? mpfr_set (fop, op, rnd_mode) : 0; MPFR_SET_SAME_SIGN (iop, op); MPFR_SET_ZERO (iop); MPFR_RET (INEX(0, inexf)); } else if (ope >= opq) /* op has no fractional part */ { inexi = (iop != op) ? mpfr_set (iop, op, rnd_mode) : 0; MPFR_SET_SAME_SIGN (fop, op); MPFR_SET_ZERO (fop); MPFR_RET (INEX(inexi, 0)); } else /* op has both integral and fractional parts */ { if (iop != op) { inexi = mpfr_rint_trunc (iop, op, rnd_mode); inexf = mpfr_frac (fop, op, rnd_mode); } else { MPFR_ASSERTN (fop != op); inexf = mpfr_frac (fop, op, rnd_mode); inexi = mpfr_rint_trunc (iop, op, rnd_mode); } MPFR_RET (INEX(inexi, inexf)); } }

size_t mpfr_out_str (FILE *stream, int base, size_t n_digits, mpfr_srcptr op, mpfr_rnd_t rnd_mode) { char *s, *s0; size_t l; mpfr_exp_t e; int err; MPFR_ASSERTN (base >= 2 && base <= 62); /* when stream=NULL, output to stdout */ if (stream == NULL) stream = stdout; if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (op))) { if (MPFR_IS_NAN (op)) OUT_STR_RET ("@NaN@"); else if (MPFR_IS_INF (op)) OUT_STR_RET (MPFR_IS_POS (op) ? "@Inf@" : "-@Inf@"); else { MPFR_ASSERTD (MPFR_IS_ZERO (op)); OUT_STR_RET (MPFR_IS_POS (op) ? "0" : "-0"); } } s = mpfr_get_str (NULL, &e, base, n_digits, op, rnd_mode); s0 = s; /* for op=3.1416 we have s = "31416" and e = 1 */ l = strlen (s) + 1; /* size of allocated block returned by mpfr_get_str - may be incorrect, as only an upper bound? */ /* outputs possible sign and significand */ err = (*s == '-' && fputc (*s++, stream) == EOF) || fputc (*s++, stream) == EOF /* leading digit */ || fputc ((unsigned char) MPFR_DECIMAL_POINT, stream) == EOF || fputs (s, stream) == EOF; /* trailing significand */ (*__gmp_free_func) (s0, l); if (MPFR_UNLIKELY (err)) return 0; e--; /* due to the leading digit */ /* outputs exponent */ if (e) { int r; MPFR_ASSERTN(e >= LONG_MIN); MPFR_ASSERTN(e <= LONG_MAX); r = fprintf (stream, (base <= 10 ? "e%ld" : "@%ld"), (long) e); if (MPFR_UNLIKELY (r < 0)) return 0; l += r; } return l; }

/* We can't use fits_s.h as it uses mpfr_cmp_si */ int mpfr_fits_intmax_p (mpfr_srcptr f, mpfr_rnd_t rnd) { mpfr_flags_t saved_flags; mpfr_exp_t e; int prec; mpfr_t x, y; int neg; int res; if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (f))) /* Zero always fit */ return MPFR_IS_ZERO (f) ? 1 : 0; /* now it fits if either (a) MINIMUM <= f <= MAXIMUM (b) or MINIMUM <= round(f, prec(slong), rnd) <= MAXIMUM */ e = MPFR_EXP (f); if (e < 1) return 1; /* |f| < 1: always fits */ neg = MPFR_IS_NEG (f); /* let EXTREMUM be MAXIMUM if f > 0, and MINIMUM if f < 0 */ /* first compute prec(EXTREMUM), this could be done at configure time, but the result can depend on neg (the loop is moved inside the "if" to give the compiler a better chance to compute prec statically) */ if (neg) { uintmax_t s; /* In C89, the division on negative integers isn't well-defined. */ s = SAFE_ABS (uintmax_t, MPFR_INTMAX_MIN); for (prec = 0; s != 0; s /= 2, prec ++); } else { intmax_t s; s = MPFR_INTMAX_MAX; for (prec = 0; s != 0; s /= 2, prec ++); } /* EXTREMUM needs prec bits, i.e. 2^(prec-1) <= |EXTREMUM| < 2^prec */ /* if e <= prec - 1, then f < 2^(prec-1) <= |EXTREMUM| */ if (e <= prec - 1) return 1; /* if e >= prec + 1, then f >= 2^prec > |EXTREMUM| */ if (e >= prec + 1) return 0; MPFR_ASSERTD (e == prec); /* hard case: first round to prec bits, then check */ saved_flags = __gmpfr_flags; mpfr_init2 (x, prec); /* for RNDF, it is necessary and sufficient to check it fits when rounding away from zero */ mpfr_set (x, f, (rnd == MPFR_RNDF) ? MPFR_RNDA : rnd); if (neg) { mpfr_init2 (y, prec); mpfr_set_sj (y, MPFR_INTMAX_MIN, MPFR_RNDN); res = mpfr_cmp (x, y) >= 0; mpfr_clear (y); } else { /* Warning! Due to the rounding, x can be an infinity. Here we use the fact that singular numbers have a special exponent field, thus well-defined and different from e, in which case this means that the number does not fit. That's why we use MPFR_EXP, not MPFR_GET_EXP. */ res = MPFR_EXP (x) == e; } mpfr_clear (x); __gmpfr_flags = saved_flags; return res; }

int mpfr_cmpabs (mpfr_srcptr b, mpfr_srcptr c) { mpfr_exp_t be, ce; mp_size_t bn, cn; mp_limb_t *bp, *cp; if (MPFR_ARE_SINGULAR (b, c)) { if (MPFR_IS_NAN (b) || MPFR_IS_NAN (c)) { MPFR_SET_ERANGEFLAG (); return 0; } else if (MPFR_IS_INF (b)) return ! MPFR_IS_INF (c); else if (MPFR_IS_INF (c)) return -1; else if (MPFR_IS_ZERO (c)) return ! MPFR_IS_ZERO (b); else /* b == 0 */ return -1; } MPFR_ASSERTD (MPFR_IS_PURE_FP (b)); MPFR_ASSERTD (MPFR_IS_PURE_FP (c)); /* Now that we know that b and c are pure FP numbers (i.e. they have a meaningful exponent), we use MPFR_EXP instead of MPFR_GET_EXP to allow exponents outside the current exponent range. For instance, this is useful for mpfr_pow, which compares values to __gmpfr_one. This is for internal use only! For compatibility with other MPFR versions, the user must still provide values that are representable in the current exponent range. */ be = MPFR_EXP (b); ce = MPFR_EXP (c); if (be > ce) return 1; if (be < ce) return -1; /* exponents are equal */ bn = MPFR_LIMB_SIZE(b)-1; cn = MPFR_LIMB_SIZE(c)-1; bp = MPFR_MANT(b); cp = MPFR_MANT(c); for ( ; bn >= 0 && cn >= 0; bn--, cn--) { if (bp[bn] > cp[cn]) return 1; if (bp[bn] < cp[cn]) return -1; } for ( ; bn >= 0; bn--) if (bp[bn]) return 1; for ( ; cn >= 0; cn--) if (cp[cn]) return -1; return 0; }

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

int main (int argc, char *argv[]) { mpfr_t x, y; mpfr_exp_t emin, emax; int inex, ov; tests_start_mpfr (); special_overflow (); emax_m_eps (); exp_range (); mpfr_init (x); mpfr_init (y); mpfr_set_ui (x, 4, MPFR_RNDN); mpfr_exp10 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 10000) != 0) { printf ("Error for 10^4, MPFR_RNDN\n"); exit (1); } mpfr_exp10 (y, x, MPFR_RNDD); if (mpfr_cmp_ui (y, 10000) != 0) { printf ("Error for 10^4, MPFR_RNDD\n"); exit (1); } mpfr_exp10 (y, x, MPFR_RNDU); if (mpfr_cmp_ui (y, 10000) != 0) { printf ("Error for 10^4, MPFR_RNDU\n"); exit (1); } mpfr_set_prec (x, 10); mpfr_set_prec (y, 10); /* save emin */ emin = mpfr_get_emin (); set_emin (-11); mpfr_set_si (x, -4, MPFR_RNDN); mpfr_exp10 (y, x, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0) { printf ("Error for emin = -11, x = -4, RNDN\n"); printf ("Expected +0\n"); printf ("Got "); mpfr_print_binary (y); puts (""); exit (1); } /* restore emin */ set_emin (emin); /* save emax */ emax = mpfr_get_emax (); set_emax (13); mpfr_set_ui (x, 4, MPFR_RNDN); mpfr_exp10 (y, x, MPFR_RNDN); if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0) { printf ("Error for emax = 13, x = 4, RNDN\n"); printf ("Expected +inf\n"); printf ("Got "); mpfr_print_binary (y); puts (""); exit (1); } /* restore emax */ set_emax (emax); MPFR_SET_INF (x); MPFR_SET_POS (x); mpfr_exp10 (y, x, MPFR_RNDN); if (!MPFR_IS_INF (y)) { printf ("evaluation of function in INF does not return INF\n"); exit (1); } MPFR_CHANGE_SIGN (x); mpfr_exp10 (y, x, MPFR_RNDN); if (!MPFR_IS_ZERO (y)) { printf ("evaluation of function in -INF does not return 0\n"); exit (1); } MPFR_SET_NAN (x); mpfr_exp10 (y, x, MPFR_RNDN); if (!MPFR_IS_NAN (y)) { printf ("evaluation of function in NaN does not return NaN\n"); exit (1); } if ((mpfr_uexp_t) 8 << 31 != 0 || mpfr_get_emax () <= (mpfr_uexp_t) 100000 * 100000) { /* emax <= 10000000000 */ mpfr_set_prec (x, 40); mpfr_set_prec (y, 40); mpfr_set_str (x, "3010299957", 10, MPFR_RNDN); mpfr_clear_flags (); inex = mpfr_exp10 (y, x, MPFR_RNDN); ov = mpfr_overflow_p (); if (!(MPFR_IS_INF (y) && MPFR_IS_POS (y) && ov)) { printf ("Overflow error for x = 3010299957, MPFR_RNDN.\n"); mpfr_dump (y); printf ("inex = %d, %soverflow\n", inex, ov ? "" : "no "); exit (1); } } test_generic (2, 100, 100); mpfr_clear (x); mpfr_clear (y); overfl_exp10_0 (); data_check ("data/exp10", mpfr_exp10, "mpfr_exp10"); tests_end_mpfr (); return 0; }

int mpfr_cmp3 (mpfr_srcptr b, mpfr_srcptr c, int s) { mpfr_exp_t be, ce; mp_size_t bn, cn; mp_limb_t *bp, *cp; s = MPFR_MULT_SIGN( s , MPFR_SIGN(c) ); if (MPFR_ARE_SINGULAR(b, c)) { if (MPFR_IS_NAN (b) || MPFR_IS_NAN (c)) { MPFR_SET_ERANGE (); return 0; } else if (MPFR_IS_INF(b)) { if (MPFR_IS_INF(c) && s == MPFR_SIGN(b) ) return 0; else return MPFR_SIGN(b); } else if (MPFR_IS_INF(c)) return -s; else if (MPFR_IS_ZERO(b)) return MPFR_IS_ZERO(c) ? 0 : -s; else /* necessarily c=0 */ return MPFR_SIGN(b); } /* b and c are real numbers */ if (s != MPFR_SIGN(b)) return MPFR_SIGN(b); /* now signs are equal */ be = MPFR_GET_EXP (b); ce = MPFR_GET_EXP (c); if (be > ce) return s; if (be < ce) return -s; /* both signs and exponents are equal */ bn = (MPFR_PREC(b)-1)/GMP_NUMB_BITS; cn = (MPFR_PREC(c)-1)/GMP_NUMB_BITS; bp = MPFR_MANT(b); cp = MPFR_MANT(c); for ( ; bn >= 0 && cn >= 0; bn--, cn--) { if (bp[bn] > cp[cn]) return s; if (bp[bn] < cp[cn]) return -s; } for ( ; bn >= 0; bn--) if (bp[bn]) return s; for ( ; cn >= 0; cn--) if (cp[cn]) return -s; return 0; }

/* computes tan(x) = sign(x)*sqrt(1/cos(x)^2-1) */ int mpfr_tan (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd_mode) { mp_prec_t precy, m; int inexact; mpfr_t s, c; MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_GROUP_DECL (group); MPFR_LOG_FUNC (("x[%#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); } } /* tan(x) = x + x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, x, -2 * MPFR_GET_EXP (x), 1, 1, rnd_mode, {}); MPFR_SAVE_EXPO_MARK (expo); /* Compute initial precision */ precy = MPFR_PREC (y); m = precy + MPFR_INT_CEIL_LOG2 (precy) + 13; MPFR_ASSERTD (m >= 2); /* needed for the error analysis in algorithms.tex */ MPFR_GROUP_INIT_2 (group, m, s, c); MPFR_ZIV_INIT (loop, m); for (;;) { /* The only way to get an overflow is to get ~ Pi/2 But the result will be ~ 2^Prec(y). */ mpfr_sin_cos (s, c, x, GMP_RNDN); /* err <= 1/2 ulp on s and c */ mpfr_div (c, s, c, GMP_RNDN); /* err <= 4 ulps */ MPFR_ASSERTD (!MPFR_IS_SINGULAR (c)); if (MPFR_LIKELY (MPFR_CAN_ROUND (c, m - 2, precy, rnd_mode))) break; MPFR_ZIV_NEXT (loop, m); MPFR_GROUP_REPREC_2 (group, m, s, c); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, c, rnd_mode); MPFR_GROUP_CLEAR (group); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }

static void special (void) { mpfr_t x, y; int i; mpfr_init (x); mpfr_init (y); /* root(NaN) = NaN */ mpfr_set_nan (x); mpfr_root (y, x, 17, MPFR_RNDN); if (!mpfr_nan_p (y)) { printf ("Error: root(NaN,17) <> NaN\n"); exit (1); } /* root(+Inf) = +Inf */ mpfr_set_inf (x, 1); mpfr_root (y, x, 42, MPFR_RNDN); if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0) { printf ("Error: root(+Inf,42) <> +Inf\n"); exit (1); } /* root(-Inf, 17) = -Inf */ mpfr_set_inf (x, -1); mpfr_root (y, x, 17, MPFR_RNDN); if (!mpfr_inf_p (y) || mpfr_sgn (y) > 0) { printf ("Error: root(-Inf,17) <> -Inf\n"); exit (1); } /* root(-Inf, 42) = NaN */ mpfr_set_inf (x, -1); mpfr_root (y, x, 42, MPFR_RNDN); if (!mpfr_nan_p (y)) { printf ("Error: root(-Inf,42) <> -Inf\n"); exit (1); } /* root(+/-0) = +/-0 */ mpfr_set_ui (x, 0, MPFR_RNDN); mpfr_root (y, x, 17, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0) { printf ("Error: root(+0,17) <> +0\n"); exit (1); } mpfr_neg (x, x, MPFR_RNDN); mpfr_root (y, x, 42, MPFR_RNDN); if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0) { printf ("Error: root(-0,42) <> -0\n"); exit (1); } mpfr_set_prec (x, 53); mpfr_set_str (x, "8.39005285514734966412e-01", 10, MPFR_RNDN); mpfr_root (x, x, 3, MPFR_RNDN); if (mpfr_cmp_str1 (x, "9.43166207799662426048e-01")) { printf ("Error in root3 (1)\n"); printf ("expected 9.43166207799662426048e-01\n"); printf ("got "); mpfr_dump (x); exit (1); } mpfr_set_prec (x, 32); mpfr_set_prec (y, 32); mpfr_set_str_binary (x, "0.10000100001100101001001001011001"); mpfr_root (x, x, 3, MPFR_RNDN); mpfr_set_str_binary (y, "0.11001101011000100111000111111001"); if (mpfr_cmp (x, y)) { printf ("Error in root3 (2)\n"); exit (1); } mpfr_set_prec (x, 32); mpfr_set_prec (y, 32); mpfr_set_str_binary (x, "-0.1100001110110000010101011001011"); mpfr_root (x, x, 3, MPFR_RNDD); mpfr_set_str_binary (y, "-0.11101010000100100101000101011001"); if (mpfr_cmp (x, y)) { printf ("Error in root3 (3)\n"); exit (1); } mpfr_set_prec (x, 82); mpfr_set_prec (y, 27); mpfr_set_str_binary (x, "0.1010001111011101011011000111001011001101100011110110010011011011011010011001100101e-7"); mpfr_root (y, x, 3, MPFR_RNDD); mpfr_set_str_binary (x, "0.101011110001110001000100011E-2"); if (mpfr_cmp (x, y)) { printf ("Error in root3 (4)\n"); exit (1); } mpfr_set_prec (x, 204); mpfr_set_prec (y, 38); mpfr_set_str_binary (x, "0.101000000001101000000001100111111011111001110110100001111000100110100111001101100111110001110001011011010110010011100101111001111100001010010100111011101100000011011000101100010000000011000101001010001001E-5"); mpfr_root (y, x, 3, MPFR_RNDD); mpfr_set_str_binary (x, "0.10001001111010011011101000010110110010E-1"); if (mpfr_cmp (x, y)) { printf ("Error in root3 (5)\n"); exit (1); } /* Worst case found on 2006-11-25 */ mpfr_set_prec (x, 53); mpfr_set_prec (y, 53); mpfr_set_str_binary (x, "1.0100001101101101001100110001001000000101001101100011E28"); mpfr_root (y, x, 35, MPFR_RNDN); mpfr_set_str_binary (x, "1.1100000010110101100011101011000010100001101100100011E0"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_root (y, x, 35, MPFR_RNDN) for\n" "x = 1.0100001101101101001100110001001000000101001101100011E28\n" "Expected "); mpfr_dump (x); printf ("Got "); mpfr_dump (y); exit (1); } /* Worst cases found on 2006-11-26 */ mpfr_set_str_binary (x, "1.1111010011101110001111010110000101110000110110101100E17"); mpfr_root (y, x, 36, MPFR_RNDD); mpfr_set_str_binary (x, "1.0110100111010001101001010111001110010100111111000010E0"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_root (y, x, 36, MPFR_RNDD) for\n" "x = 1.1111010011101110001111010110000101110000110110101100E17\n" "Expected "); mpfr_dump (x); printf ("Got "); mpfr_dump (y); exit (1); } mpfr_set_str_binary (x, "1.1100011101101101100010110001000001110001111110010000E23"); mpfr_root (y, x, 36, MPFR_RNDU); mpfr_set_str_binary (x, "1.1001010100001110000110111111100011011101110011000100E0"); if (mpfr_cmp (x, y)) { printf ("Error in mpfr_root (y, x, 36, MPFR_RNDU) for\n" "x = 1.1100011101101101100010110001000001110001111110010000E23\n" "Expected "); mpfr_dump (x); printf ("Got "); mpfr_dump (y); exit (1); } /* Check for k = 1 */ mpfr_set_ui (x, 17, MPFR_RNDN); i = mpfr_root (y, x, 1, MPFR_RNDN); if (mpfr_cmp_ui (x, 17) || i != 0) { printf ("Error in root (17^(1/1))\n"); exit (1); } #if 0 /* Check for k == 0: For 0 <= x < 1 => +0. For x = 1 => 1. For x > 1, => +Inf. For x < 0 => NaN. */ i = mpfr_root (y, x, 0, MPFR_RNDN); if (!MPFR_IS_INF (y) || !MPFR_IS_POS (y) || i != 0) { printf ("Error in root 17^(1/0)\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); i = mpfr_root (y, x, 0, MPFR_RNDN); if (mpfr_cmp_ui (y, 1) || i != 0) { printf ("Error in root 1^(1/0)\n"); exit (1); } mpfr_set_ui (x, 0, MPFR_RNDN); i = mpfr_root (y, x, 0, MPFR_RNDN); if (!MPFR_IS_ZERO (y) || !MPFR_IS_POS (y) || i != 0) { printf ("Error in root 0+^(1/0)\n"); exit (1); } MPFR_CHANGE_SIGN (x); i = mpfr_root (y, x, 0, MPFR_RNDN); if (!MPFR_IS_ZERO (y) || !MPFR_IS_POS (y) || i != 0) { printf ("Error in root 0-^(1/0)\n"); exit (1); } mpfr_set_ui_2exp (x, 17, -5, MPFR_RNDD); i = mpfr_root (y, x, 0, MPFR_RNDN); if (!MPFR_IS_ZERO (y) || !MPFR_IS_POS (y) || i != 0) { printf ("Error in root (17/2^5)^(1/0)\n"); exit (1); } #endif mpfr_set_ui (x, 0, MPFR_RNDN); i = mpfr_root (y, x, 0, MPFR_RNDN); if (!MPFR_IS_NAN (y) || i != 0) { printf ("Error in root 0+^(1/0)\n"); exit (1); } /* Check for k==2 */ mpfr_set_si (x, -17, MPFR_RNDD); i = mpfr_root (y, x, 2, MPFR_RNDN); if (!MPFR_IS_NAN (y) || i != 0) { printf ("Error in root (-17)^(1/2)\n"); exit (1); } mpfr_clear (x); mpfr_clear (y); }

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_sinh (mpfr_ptr y, mpfr_srcptr xt, mp_rnd_t rnd_mode) { /****** Declarations ******/ mpfr_t x; mp_prec_t Nxt = MPFR_PREC(xt); int flag_neg=0, inexact =0; if (MPFR_IS_NAN(xt)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } MPFR_CLEAR_NAN(y); if (MPFR_IS_INF(xt)) { MPFR_SET_INF(y); MPFR_SET_SAME_SIGN(y, xt); MPFR_RET(0); } MPFR_CLEAR_INF(y); if (MPFR_IS_ZERO(xt)) { MPFR_SET_ZERO(y); /* sinh(0) = 0 */ MPFR_SET_SAME_SIGN(y, xt); MPFR_RET(0); } mpfr_init2 (x, Nxt); mpfr_set (x, xt, GMP_RNDN); if(MPFR_SIGN(x)<0) { MPFR_CHANGE_SIGN(x); flag_neg=1; } /* General case */ { /* Declaration of the intermediary variable */ mpfr_t t, te, ti; int d; /* Declaration of the size variable */ mp_prec_t Nx = Nxt; /* Precision of input variable */ mp_prec_t Ny = MPFR_PREC(y); /* Precision of input variable */ mp_prec_t Nt; /* Precision of the intermediary variable */ long int err; /* Precision of error */ /* compute the precision of intermediary variable */ Nt = MAX(Nx, Ny); /* the optimal number of bits : see algorithms.ps */ Nt = Nt + _mpfr_ceil_log2 (5) + _mpfr_ceil_log2 (Nt); /* initialise of intermediary variable */ mpfr_init (t); mpfr_init (te); mpfr_init (ti); /* First computation of sinh */ do { /* reactualisation of the precision */ mpfr_set_prec (t, Nt); mpfr_set_prec (te, Nt); mpfr_set_prec (ti, Nt); /* compute sinh */ mpfr_exp (te, x, GMP_RNDD); /* exp(x) */ mpfr_ui_div (ti, 1, te, GMP_RNDU); /* 1/exp(x) */ mpfr_sub (t, te, ti, GMP_RNDN); /* exp(x) - 1/exp(x) */ mpfr_div_2ui (t, t, 1, GMP_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 = -1; else { /* calculation of the error */ d = MPFR_EXP(te) - MPFR_EXP(t) + 2; /* estimation of the error */ /* err = Nt-(_mpfr_ceil_log2(1+pow(2,d)));*/ err = Nt - (MAX(d,0) + 1); } /* actualisation of the precision */ Nt += 10; } while ((err < 0) || !mpfr_can_round(t, err, GMP_RNDN, rnd_mode, Ny)); if (flag_neg == 1) MPFR_CHANGE_SIGN(t); inexact = mpfr_set (y, t, rnd_mode); mpfr_clear (t); mpfr_clear (ti); mpfr_clear (te); } mpfr_clear (x); return inexact; }

int mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mp_rnd_t rnd_mode) { mpfr_t x; int inexact; MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", xt, xt, rnd_mode), ("y[%#R]=%R inexact=%d", y, 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; mp_exp_t d; mp_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, GMP_RNDD)); if (MPFR_OVERFLOW (flags)) /* exp(x) does overflow */ { /* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */ mpfr_div_2ui (ti, x, 1, GMP_RNDD); /* exact */ /* t <- cosh(x/2): error(t) <= 1 ulp(t) */ MPFR_BLOCK (flags, mpfr_cosh (t, ti, GMP_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, GMP_RNDD); /* multiplication below, error(t) <= 5 ulp(t) */ MPFR_BLOCK (flags, mpfr_mul (t, t, ti, GMP_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, GMP_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, GMP_RNDU); /* 1/exp(x) */ mpfr_sub (t, t, ti, GMP_RNDN); /* exp(x) - 1/exp(x) */ mpfr_div_2ui (t, t, 1, GMP_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 mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xp; int compared, inexact; mpfr_prec_t prec; mpfr_exp_t xp_exp; 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), ("asin[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (asin), mpfr_log_prec, asin, inexact)); /* Special cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x) || MPFR_IS_INF (x)) { MPFR_SET_NAN (asin); MPFR_RET_NAN; } else /* x = 0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); MPFR_SET_ZERO (asin); MPFR_SET_SAME_SIGN (asin, x); MPFR_RET (0); /* exact result */ } } /* asin(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */ MPFR_FAST_COMPUTE_IF_SMALL_INPUT (asin, x, -2 * MPFR_GET_EXP (x), 2, 1, rnd_mode, {}); /* Set x_p=|x| (x is a normal number) */ mpfr_init2 (xp, MPFR_PREC (x)); inexact = mpfr_abs (xp, x, MPFR_RNDN); MPFR_ASSERTD (inexact == 0); compared = mpfr_cmp_ui (xp, 1); MPFR_SAVE_EXPO_MARK (expo); if (MPFR_UNLIKELY (compared >= 0)) { mpfr_clear (xp); if (compared > 0) /* asin(x) = NaN for |x| > 1 */ { MPFR_SAVE_EXPO_FREE (expo); MPFR_SET_NAN (asin); MPFR_RET_NAN; } else /* x = 1 or x = -1 */ { if (MPFR_IS_POS (x)) /* asin(+1) = Pi/2 */ inexact = mpfr_const_pi (asin, rnd_mode); else /* asin(-1) = -Pi/2 */ { inexact = -mpfr_const_pi (asin, MPFR_INVERT_RND(rnd_mode)); MPFR_CHANGE_SIGN (asin); } mpfr_div_2ui (asin, asin, 1, rnd_mode); } } else { /* Compute exponent of 1 - ABS(x) */ mpfr_ui_sub (xp, 1, xp, MPFR_RNDD); MPFR_ASSERTD (MPFR_GET_EXP (xp) <= 0); MPFR_ASSERTD (MPFR_GET_EXP (x) <= 0); xp_exp = 2 - MPFR_GET_EXP (xp); /* Set up initial prec */ prec = MPFR_PREC (asin) + 10 + xp_exp; /* use asin(x) = atan(x/sqrt(1-x^2)) */ MPFR_ZIV_INIT (loop, prec); for (;;) { mpfr_set_prec (xp, prec); mpfr_sqr (xp, x, MPFR_RNDN); mpfr_ui_sub (xp, 1, xp, MPFR_RNDN); mpfr_sqrt (xp, xp, MPFR_RNDN); mpfr_div (xp, x, xp, MPFR_RNDN); mpfr_atan (xp, xp, MPFR_RNDN); if (MPFR_LIKELY (MPFR_CAN_ROUND (xp, prec - xp_exp, MPFR_PREC (asin), rnd_mode))) break; MPFR_ZIV_NEXT (loop, prec); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (asin, xp, rnd_mode); mpfr_clear (xp); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (asin, inexact, rnd_mode); }

int main (int argc, char *argv[]) { mpfr_t x, y; mpfr_exp_t emin, emax; tests_start_mpfr (); test_set_underflow (); test_set_overflow (); check_default_rnd(); mpfr_init (x); mpfr_init (y); emin = mpfr_get_emin (); emax = mpfr_get_emax (); if (emin >= emax) { printf ("Error: emin >= emax\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1024, MPFR_RNDN); mpfr_set_double_range (); mpfr_check_range (x, 0, MPFR_RNDN); if (!mpfr_inf_p (x) || (mpfr_sgn(x) <= 0)) { printf ("Error: 2^1024 rounded to nearest should give +Inf\n"); exit (1); } set_emax (1025); mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1024, MPFR_RNDN); mpfr_set_double_range (); mpfr_check_range (x, 0, MPFR_RNDD); if (!mpfr_number_p (x)) { printf ("Error: 2^1024 rounded down should give a normal number\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1023, MPFR_RNDN); mpfr_add (x, x, x, MPFR_RNDN); if (!mpfr_inf_p (x) || (mpfr_sgn(x) <= 0)) { printf ("Error: x+x rounded to nearest for x=2^1023 should give +Inf\n"); printf ("emax = %ld\n", (long) mpfr_get_emax ()); printf ("got "); mpfr_print_binary (x); puts (""); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_mul_2exp (x, x, 1023, MPFR_RNDN); mpfr_add (x, x, x, MPFR_RNDD); if (!mpfr_number_p (x)) { printf ("Error: x+x rounded down for x=2^1023 should give" " a normal number\n"); exit (1); } mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_div_2exp (x, x, 1022, MPFR_RNDN); mpfr_set_str_binary (y, "1.1e-1022"); /* y = 3/2*x */ mpfr_sub (y, y, x, MPFR_RNDZ); if (mpfr_cmp_ui (y, 0)) { printf ("Error: y-x rounded to zero should give 0" " for y=3/2*2^(-1022), x=2^(-1022)\n"); printf ("y="); mpfr_print_binary (y); puts (""); exit (1); } set_emin (-1026); mpfr_set_ui (x, 1, MPFR_RNDN); mpfr_div_2exp (x, x, 1025, MPFR_RNDN); mpfr_set_double_range (); mpfr_check_range (x, 0, MPFR_RNDN); if (!MPFR_IS_ZERO (x) ) { printf ("Error: x rounded to nearest for x=2^-1024 should give Zero\n"); printf ("emin = %ld\n", (long) mpfr_get_emin ()); printf ("got "); mpfr_dump (x); exit (1); } mpfr_clear (x); mpfr_clear (y); set_emin (emin); set_emax (emax); check_emin_emax(); check_flags(); check_set_get_prec (); check_powerof2 (); check_set (); tests_end_mpfr (); return 0; }

int mpfr_erf (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xf; mp_limb_t xf_limb[(53 - 1) / GMP_NUMB_BITS + 1]; int inex, large; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (y), mpfr_log_prec, y, inex)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else if (MPFR_IS_INF (x)) /* erf(+inf) = +1, erf(-inf) = -1 */ return mpfr_set_si (y, MPFR_INT_SIGN (x), MPFR_RNDN); else /* erf(+0) = +0, erf(-0) = -0 */ { MPFR_ASSERTD (MPFR_IS_ZERO (x)); return mpfr_set (y, x, MPFR_RNDN); /* should keep the sign of x */ } } /* now x is neither NaN, Inf nor 0 */ /* first try expansion at x=0 when x is small, or asymptotic expansion where x is large */ MPFR_SAVE_EXPO_MARK (expo); /* around x=0, we have erf(x) = 2x/sqrt(Pi) (1 - x^2/3 + ...), with 1 - x^2/3 <= sqrt(Pi)*erf(x)/2/x <= 1 for x >= 0. This means that if x^2/3 < 2^(-PREC(y)-1) we can decide of the correct rounding, unless we have a worst-case for 2x/sqrt(Pi). */ if (MPFR_EXP(x) < - (mpfr_exp_t) (MPFR_PREC(y) / 2)) { /* we use 2x/sqrt(Pi) (1 - x^2/3) <= erf(x) <= 2x/sqrt(Pi) for x > 0 and 2x/sqrt(Pi) <= erf(x) <= 2x/sqrt(Pi) (1 - x^2/3) for x < 0. In both cases |2x/sqrt(Pi) (1 - x^2/3)| <= |erf(x)| <= |2x/sqrt(Pi)|. We will compute l and h such that l <= |2x/sqrt(Pi) (1 - x^2/3)| and |2x/sqrt(Pi)| <= h. If l and h round to the same value to precision PREC(y) and rounding rnd_mode, then we are done. */ mpfr_t l, h; /* lower and upper bounds for erf(x) */ int ok, inex2; mpfr_init2 (l, MPFR_PREC(y) + 17); mpfr_init2 (h, MPFR_PREC(y) + 17); /* first compute l */ mpfr_mul (l, x, x, MPFR_RNDU); mpfr_div_ui (l, l, 3, MPFR_RNDU); /* upper bound on x^2/3 */ mpfr_ui_sub (l, 1, l, MPFR_RNDZ); /* lower bound on 1 - x^2/3 */ mpfr_const_pi (h, MPFR_RNDU); /* upper bound of Pi */ mpfr_sqrt (h, h, MPFR_RNDU); /* upper bound on sqrt(Pi) */ mpfr_div (l, l, h, MPFR_RNDZ); /* lower bound on 1/sqrt(Pi) (1 - x^2/3) */ mpfr_mul_2ui (l, l, 1, MPFR_RNDZ); /* 2/sqrt(Pi) (1 - x^2/3) */ mpfr_mul (l, l, x, MPFR_RNDZ); /* |l| is a lower bound on |2x/sqrt(Pi) (1 - x^2/3)| */ /* now compute h */ mpfr_const_pi (h, MPFR_RNDD); /* lower bound on Pi */ mpfr_sqrt (h, h, MPFR_RNDD); /* lower bound on sqrt(Pi) */ mpfr_div_2ui (h, h, 1, MPFR_RNDD); /* lower bound on sqrt(Pi)/2 */ /* since sqrt(Pi)/2 < 1, the following should not underflow */ mpfr_div (h, x, h, MPFR_IS_POS(x) ? MPFR_RNDU : MPFR_RNDD); /* round l and h to precision PREC(y) */ inex = mpfr_prec_round (l, MPFR_PREC(y), rnd_mode); inex2 = mpfr_prec_round (h, MPFR_PREC(y), rnd_mode); /* Caution: we also need inex=inex2 (inex might be 0). */ ok = SAME_SIGN (inex, inex2) && mpfr_cmp (l, h) == 0; if (ok) mpfr_set (y, h, rnd_mode); mpfr_clear (l); mpfr_clear (h); if (ok) goto end; /* this test can still fail for small precision, for example for x=-0.100E-2 with a target precision of 3 bits, since the error term x^2/3 is not that small. */ } MPFR_TMP_INIT1(xf_limb, xf, 53); mpfr_div (xf, x, __gmpfr_const_log2_RNDU, MPFR_RNDZ); /* round to zero ensures we get a lower bound of |x/log(2)| */ mpfr_mul (xf, xf, x, MPFR_RNDZ); large = mpfr_cmp_ui (xf, MPFR_PREC (y) + 1) > 0; /* when x goes to infinity, we have erf(x) = 1 - 1/sqrt(Pi)/exp(x^2)/x + ... and |erf(x) - 1| <= exp(-x^2) is true for any x >= 0, thus if exp(-x^2) < 2^(-PREC(y)-1) the result is 1 or 1-epsilon. This rewrites as x^2/log(2) > p+1. */ if (MPFR_UNLIKELY (large)) /* |erf x| = 1 or 1- */ { mpfr_rnd_t rnd2 = MPFR_IS_POS (x) ? rnd_mode : MPFR_INVERT_RND(rnd_mode); if (rnd2 == MPFR_RNDN || rnd2 == MPFR_RNDU || rnd2 == MPFR_RNDA) { inex = MPFR_INT_SIGN (x); mpfr_set_si (y, inex, rnd2); } else /* round to zero */ { inex = -MPFR_INT_SIGN (x); mpfr_setmax (y, 0); /* warning: setmax keeps the old sign of y */ MPFR_SET_SAME_SIGN (y, x); } } else /* use Taylor */ { double xf2; /* FIXME: get rid of doubles/mpfr_get_d here */ xf2 = mpfr_get_d (x, MPFR_RNDN); xf2 = xf2 * xf2; /* xf2 ~ x^2 */ inex = mpfr_erf_0 (y, x, xf2, rnd_mode); } end: MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inex, rnd_mode); }

/* Assumes that the exponent range has already been extended and if y is an integer, then the result is not exact in unbounded exponent range. If x < 0, assumes y is an integer. */ int mpfr_pow_general (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode, int y_is_integer, mpfr_save_expo_t *expo) { mpfr_t t, u, k, absx; int neg_result = 0; int k_non_zero = 0; int check_exact_case = 0; int inexact; /* Declaration of the size variable */ mpfr_prec_t Nz = MPFR_PREC(z); /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_exp_t err; /* error */ MPFR_ZIV_DECL (ziv_loop); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (x), mpfr_log_prec, x, mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode), ("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inexact)); /* We put the absolute value of x in absx, pointing to the significand of x to avoid allocating memory for the significand of absx. */ MPFR_ALIAS(absx, x, /*sign=*/ 1, /*EXP=*/ MPFR_EXP(x)); /* We will compute the absolute value of the result. So, let's invert the rounding mode if the result is negative (in which case y not an integer was already filtered out). */ if (MPFR_IS_NEG (x)) { MPFR_ASSERTD (y_is_integer); if (mpfr_odd_p (y)) { neg_result = 1; rnd_mode = MPFR_INVERT_RND (rnd_mode); } } /* Compute the precision of intermediary variable. */ /* The increment 9 + MPFR_INT_CEIL_LOG2 (Nz) gives few Ziv failures in binary64 and binary128 formats: mfv5 -p53 -e1 mpfr_pow: 5903 / 6469.59 / 6686 mfv5 -p113 -e1 mpfr_pow: 10913 / 11989.46 / 12321 */ Nt = Nz + 9 + MPFR_INT_CEIL_LOG2 (Nz); /* initialize of intermediary variable */ mpfr_init2 (t, Nt); MPFR_ZIV_INIT (ziv_loop, Nt); for (;;) { MPFR_BLOCK_DECL (flags1); /* compute exp(y*ln|x|), using MPFR_RNDU to get an upper bound, so that we can detect underflows. */ mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDD : MPFR_RNDU); /* ln|x| */ mpfr_mul (t, y, t, MPFR_RNDU); /* y*ln|x| */ if (k_non_zero) { MPFR_LOG_MSG (("subtract k * ln(2)\n", 0)); mpfr_const_log2 (u, MPFR_RNDD); mpfr_mul (u, u, k, MPFR_RNDD); /* Error on u = k * log(2): < k * 2^(-Nt) < 1. */ mpfr_sub (t, t, u, MPFR_RNDU); MPFR_LOG_MSG (("t = y * ln|x| - k * ln(2)\n", 0)); MPFR_LOG_VAR (t); } /* estimate of the error -- see pow function in algorithms.tex. The error on t is at most 1/2 + 3*2^(EXP(t)+1) ulps, which is <= 2^(EXP(t)+3) for EXP(t) >= -1, and <= 2 ulps for EXP(t) <= -2. Additional error if k_no_zero: treal = t * errk, with 1 - |k| * 2^(-Nt) <= exp(-|k| * 2^(-Nt)) <= errk <= 1, i.e., additional absolute error <= 2^(EXP(k)+EXP(t)-Nt). Total error <= 2^err1 + 2^err2 <= 2^(max(err1,err2)+1). */ err = MPFR_NOTZERO (t) && MPFR_GET_EXP (t) >= -1 ? MPFR_GET_EXP (t) + 3 : 1; if (k_non_zero) { if (MPFR_GET_EXP (k) > err) err = MPFR_GET_EXP (k); err++; } MPFR_BLOCK (flags1, mpfr_exp (t, t, MPFR_RNDN)); /* exp(y*ln|x|)*/ /* We need to test */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (t) || MPFR_UNDERFLOW (flags1))) { mpfr_prec_t Ntmin; MPFR_BLOCK_DECL (flags2); MPFR_ASSERTN (!k_non_zero); MPFR_ASSERTN (!MPFR_IS_NAN (t)); /* Real underflow? */ if (MPFR_IS_ZERO (t)) { /* Underflow. We computed rndn(exp(t)), where t >= y*ln|x|. Therefore rndn(|x|^y) = 0, and we have a real underflow on |x|^y. */ inexact = mpfr_underflow (z, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode, MPFR_SIGN_POS); if (expo != NULL) MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT | MPFR_FLAGS_UNDERFLOW); break; } /* Real overflow? */ if (MPFR_IS_INF (t)) { /* Note: we can probably use a low precision for this test. */ mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDU : MPFR_RNDD); mpfr_mul (t, y, t, MPFR_RNDD); /* y * ln|x| */ MPFR_BLOCK (flags2, mpfr_exp (t, t, MPFR_RNDD)); /* t = lower bound on exp(y * ln|x|) */ if (MPFR_OVERFLOW (flags2)) { /* We have computed a lower bound on |x|^y, and it overflowed. Therefore we have a real overflow on |x|^y. */ inexact = mpfr_overflow (z, rnd_mode, MPFR_SIGN_POS); if (expo != NULL) MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW); break; } } k_non_zero = 1; Ntmin = sizeof(mpfr_exp_t) * CHAR_BIT; if (Ntmin > Nt) { Nt = Ntmin; mpfr_set_prec (t, Nt); } mpfr_init2 (u, Nt); mpfr_init2 (k, Ntmin); mpfr_log2 (k, absx, MPFR_RNDN); mpfr_mul (k, y, k, MPFR_RNDN); mpfr_round (k, k); MPFR_LOG_VAR (k); /* |y| < 2^Ntmin, therefore |k| < 2^Nt. */ continue; } if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - err, Nz, rnd_mode))) { inexact = mpfr_set (z, t, rnd_mode); break; } /* check exact power, except when y is an integer (since the exact cases for y integer have already been filtered out) */ if (check_exact_case == 0 && ! y_is_integer) { if (mpfr_pow_is_exact (z, absx, y, rnd_mode, &inexact)) break; check_exact_case = 1; } /* reactualisation of the precision */ MPFR_ZIV_NEXT (ziv_loop, Nt); mpfr_set_prec (t, Nt); if (k_non_zero) mpfr_set_prec (u, Nt); } MPFR_ZIV_FREE (ziv_loop); if (k_non_zero) { int inex2; long lk; /* The rounded result in an unbounded exponent range is z * 2^k. As * MPFR chooses underflow after rounding, the mpfr_mul_2si below will * correctly detect underflows and overflows. However, in rounding to * nearest, if z * 2^k = 2^(emin - 2), then the double rounding may * affect the result. We need to cope with that before overwriting z. * This can occur only if k < 0 (this test is necessary to avoid a * potential integer overflow). * If inexact >= 0, then the real result is <= 2^(emin - 2), so that * o(2^(emin - 2)) = +0 is correct. If inexact < 0, then the real * result is > 2^(emin - 2) and we need to round to 2^(emin - 1). */ MPFR_ASSERTN (MPFR_EXP_MAX <= LONG_MAX); lk = mpfr_get_si (k, MPFR_RNDN); /* Due to early overflow detection, |k| should not be much larger than * MPFR_EMAX_MAX, and as MPFR_EMAX_MAX <= MPFR_EXP_MAX/2 <= LONG_MAX/2, * an overflow should not be possible in mpfr_get_si (and lk is exact). * And one even has the following assertion. TODO: complete proof. */ MPFR_ASSERTD (lk > LONG_MIN && lk < LONG_MAX); /* Note: even in case of overflow (lk inexact), the code is correct. * Indeed, for the 3 occurrences of lk: * - The test lk < 0 is correct as sign(lk) = sign(k). * - In the test MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk, * if lk is inexact, then lk = LONG_MIN <= MPFR_EXP_MIN * (the minimum value of the mpfr_exp_t type), and * __gmpfr_emin - 1 - lk >= MPFR_EMIN_MIN - 1 - 2 * MPFR_EMIN_MIN * >= - MPFR_EMIN_MIN - 1 = MPFR_EMAX_MAX - 1. However, from the * choice of k, z has been chosen to be around 1, so that the * result of the test is false, as if lk were exact. * - In the mpfr_mul_2si (z, z, lk, rnd_mode), if lk is inexact, * then |lk| >= LONG_MAX >= MPFR_EXP_MAX, and as z is around 1, * mpfr_mul_2si underflows or overflows in the same way as if * lk were exact. * TODO: give a bound on |t|, then on |EXP(z)|. */ if (rnd_mode == MPFR_RNDN && inexact < 0 && lk < 0 && MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk && mpfr_powerof2_raw (z)) { /* Rounding to nearest, real result > z * 2^k = 2^(emin - 2), * underflow case: * (a) if the precision of z is > 1, we will obtain the correct * result and exceptions by replacing z by nextabove(z). * (b) if the precision of z is 1, we first copy z to zcopy of * precision 2 bits and perform nextabove(zcopy). */ if (MPFR_PREC(z) >= 2) mpfr_nextabove (z); else { mpfr_t zcopy; mpfr_init2 (zcopy, MPFR_PREC(z) + 1); mpfr_set (zcopy, z, MPFR_RNDZ); mpfr_nextabove (zcopy); inex2 = mpfr_mul_2si (z, zcopy, lk, rnd_mode); mpfr_clear (zcopy); goto under_over; } } MPFR_CLEAR_FLAGS (); inex2 = mpfr_mul_2si (z, z, lk, rnd_mode); under_over: if (inex2) /* underflow or overflow */ { inexact = inex2; if (expo != NULL) MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, __gmpfr_flags); } mpfr_clears (u, k, (mpfr_ptr) 0); } mpfr_clear (t); /* update the sign of the result if x was negative */ if (neg_result) { MPFR_SET_NEG(z); inexact = -inexact; } return inexact; }

static void check_underflow (void) { mpfr_t sum1, sum2, t[NUNFL]; mpfr_ptr p[NUNFL]; mpfr_prec_t precmax = 444; mpfr_exp_t emin, emax; unsigned int ex_flags, flags; int c, i; emin = mpfr_get_emin (); emax = mpfr_get_emax (); set_emin (MPFR_EMIN_MIN); set_emax (MPFR_EMAX_MAX); ex_flags = MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT; mpfr_init2 (sum1, MPFR_PREC_MIN); mpfr_init2 (sum2, precmax); for (i = 0; i < NUNFL; i++) { mpfr_init2 (t[i], precmax); p[i] = t[i]; } for (c = 0; c < 8; c++) { mpfr_prec_t fprec; int n, neg, r; fprec = MPFR_PREC_MIN + (randlimb () % (precmax - MPFR_PREC_MIN + 1)); n = 3 + (randlimb () % (NUNFL - 2)); MPFR_ASSERTN (n <= NUNFL); mpfr_set_prec (sum2, (randlimb () & 1) ? MPFR_PREC_MIN : precmax); mpfr_set_prec (t[0], fprec + 64); mpfr_set_zero (t[0], 1); for (i = 1; i < n; i++) { int inex; mpfr_set_prec (t[i], MPFR_PREC_MIN + (randlimb () % (fprec - MPFR_PREC_MIN + 1))); do mpfr_urandomb (t[i], RANDS); while (MPFR_IS_ZERO (t[i])); mpfr_set_exp (t[i], MPFR_EMIN_MIN); inex = mpfr_sub (t[0], t[0], t[i], MPFR_RNDN); MPFR_ASSERTN (inex == 0); } neg = randlimb () & 1; if (neg) mpfr_nextbelow (t[0]); else mpfr_nextabove (t[0]); RND_LOOP(r) { int inex1, inex2; mpfr_set_zero (sum1, 1); if (neg) mpfr_nextbelow (sum1); else mpfr_nextabove (sum1); inex1 = mpfr_div_2ui (sum1, sum1, 2, (mpfr_rnd_t) r); mpfr_clear_flags (); inex2 = mpfr_sum (sum2, p, n, (mpfr_rnd_t) r); flags = __gmpfr_flags; MPFR_ASSERTN (mpfr_check (sum1)); MPFR_ASSERTN (mpfr_check (sum2)); if (flags != ex_flags) { printf ("Bad flags in check_underflow on %s, c = %d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), c); printf ("Expected flags:"); flags_out (ex_flags); printf ("Got flags: "); flags_out (flags); printf ("sum = "); mpfr_dump (sum2); exit (1); } if (!(mpfr_equal_p (sum1, sum2) && SAME_SIGN (inex1, inex2))) { printf ("Error in check_underflow on %s, c = %d\n", mpfr_print_rnd_mode ((mpfr_rnd_t) r), c); printf ("Expected "); mpfr_dump (sum1); printf ("with inex = %d\n", inex1); printf ("Got "); mpfr_dump (sum2); printf ("with inex = %d\n", inex2); exit (1); } } } for (i = 0; i < NUNFL; i++) mpfr_clear (t[i]); mpfr_clears (sum1, sum2, (mpfr_ptr) 0); set_emin (emin); set_emax (emax); }

static int mpfr_rem1 (mpfr_ptr rem, long *quo, mp_rnd_t rnd_q, mpfr_srcptr x, mpfr_srcptr y, mp_rnd_t rnd) { mp_exp_t ex, ey; int compare, inex, q_is_odd, sign, signx = MPFR_SIGN (x); mpz_t mx, my, r; MPFR_ASSERTD (rnd_q == GMP_RNDN || rnd_q == GMP_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_exp (mx, x); /* x = mx*2^ex */ ey = mpfr_get_z_exp (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_div_2exp (my, my, k); } if (ex <= ey) { /* q = x/y = mx/(my*2^(ey-ex)) */ mpz_mul_2exp (my, my, ey - ex); /* divide mx by my*2^(ey-ex) */ if (rnd_q == GMP_RNDZ) /* 0 <= |r| <= |my|, r has the same sign as mx */ mpz_tdiv_qr (mx, r, mx, my); else /* 0 <= |r| <= |my|, r has the same sign as my */ mpz_fdiv_qr (mx, r, mx, my); if (rnd_q == GMP_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) /* 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 /* 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_div_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 /* now 0 <= r < 2Y */ { mpz_div_2exp (my, my, 1); /* back to Y */ if (rnd_q == GMP_RNDN) { /* 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, GMP_RNDN); else { if (rnd_q == GMP_RNDN) { /* FIXME: the comparison 2*r < my could be done more efficiently at the mpn level */ mpz_mul_2exp (r, r, 1); compare = mpz_cmpabs (r, my); mpz_div_2exp (r, r, 1); compare = ((compare > 0) || ((rnd_q == GMP_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 == GMP_RNDN)) *quo += 1; } } inex = mpfr_set_z (rem, r, rnd); /* if ex > ey, rem should be multiplied by 2^ey, else by 2^ex */ MPFR_EXP (rem) += (ex > ey) ? ey : ex; } if (quo) *quo *= sign; /* take into account sign of x */ if (signx < 0) { mpfr_neg (rem, rem, GMP_RNDN); inex = -inex; } mpz_clear (mx); mpz_clear (my); mpz_clear (r); return inex; }

static void check_special (void) { mpfr_t tab[3], r; mpfr_ptr tabp[3]; int i; mpfr_inits2 (53, tab[0], tab[1], tab[2], r, (mpfr_ptr) 0); tabp[0] = tab[0]; tabp[1] = tab[1]; tabp[2] = tab[2]; i = mpfr_sum (r, tabp, 0, MPFR_RNDN); if (!MPFR_IS_ZERO (r) || !MPFR_IS_POS (r) || i != 0) { printf ("Special case n==0 failed!\n"); exit (1); } mpfr_set_ui (tab[0], 42, MPFR_RNDN); i = mpfr_sum (r, tabp, 1, MPFR_RNDN); if (mpfr_cmp_ui (r, 42) || i != 0) { printf ("Special case n==1 failed!\n"); exit (1); } mpfr_set_ui (tab[1], 17, MPFR_RNDN); MPFR_SET_NAN (tab[2]); i = mpfr_sum (r, tabp, 3, MPFR_RNDN); if (!MPFR_IS_NAN (r) || i != 0) { printf ("Special case NAN failed!\n"); exit (1); } MPFR_SET_INF (tab[2]); MPFR_SET_POS (tab[2]); i = mpfr_sum (r, tabp, 3, MPFR_RNDN); if (!MPFR_IS_INF (r) || !MPFR_IS_POS (r) || i != 0) { printf ("Special case +INF failed!\n"); exit (1); } MPFR_SET_INF (tab[2]); MPFR_SET_NEG (tab[2]); i = mpfr_sum (r, tabp, 3, MPFR_RNDN); if (!MPFR_IS_INF (r) || !MPFR_IS_NEG (r) || i != 0) { printf ("Special case -INF failed!\n"); exit (1); } MPFR_SET_ZERO (tab[1]); i = mpfr_sum (r, tabp, 2, MPFR_RNDN); if (mpfr_cmp_ui (r, 42) || i != 0) { printf ("Special case 42+0 failed!\n"); exit (1); } MPFR_SET_NAN (tab[0]); i = mpfr_sum (r, tabp, 3, MPFR_RNDN); if (!MPFR_IS_NAN (r) || i != 0) { printf ("Special case NAN+0+-INF failed!\n"); exit (1); } mpfr_set_inf (tab[0], 1); mpfr_set_ui (tab[1], 59, MPFR_RNDN); mpfr_set_inf (tab[2], -1); i = mpfr_sum (r, tabp, 3, MPFR_RNDN); if (!MPFR_IS_NAN (r) || i != 0) { printf ("Special case +INF + 59 +-INF failed!\n"); exit (1); } mpfr_clears (tab[0], tab[1], tab[2], r, (mpfr_ptr) 0); }

int mpfr_zeta (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode) { mpfr_t z_pre, s1, y, p; double sd, eps, m1, c; long add; mpfr_prec_t precz, prec1, precs, precs1; int inex; MPFR_GROUP_DECL (group); MPFR_ZIV_DECL (loop); MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC ( ("s[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (s), mpfr_log_prec, s, rnd_mode), ("z[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (z), mpfr_log_prec, z, inex)); /* Zero, Nan or Inf ? */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (s))) { if (MPFR_IS_NAN (s)) { MPFR_SET_NAN (z); MPFR_RET_NAN; } else if (MPFR_IS_INF (s)) { if (MPFR_IS_POS (s)) return mpfr_set_ui (z, 1, MPFR_RNDN); /* Zeta(+Inf) = 1 */ MPFR_SET_NAN (z); /* Zeta(-Inf) = NaN */ MPFR_RET_NAN; } else /* s iz zero */ { MPFR_ASSERTD (MPFR_IS_ZERO (s)); return mpfr_set_si_2exp (z, -1, -1, rnd_mode); } } /* s is neither Nan, nor Inf, nor Zero */ /* check tiny s: we have zeta(s) = -1/2 - 1/2 log(2 Pi) s + ... around s=0, and for |s| <= 0.074, we have |zeta(s) + 1/2| <= |s|. Thus if |s| <= 1/4*ulp(1/2), we can deduce the correct rounding (the 1/4 covers the case where |zeta(s)| < 1/2 and rounding to nearest). A sufficient condition is that EXP(s) + 1 < -PREC(z). */ if (MPFR_GET_EXP (s) + 1 < - (mpfr_exp_t) MPFR_PREC(z)) { int signs = MPFR_SIGN(s); MPFR_SAVE_EXPO_MARK (expo); mpfr_set_si_2exp (z, -1, -1, rnd_mode); /* -1/2 */ if (rnd_mode == MPFR_RNDA) rnd_mode = MPFR_RNDD; /* the result is around -1/2, thus negative */ if ((rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDZ) && signs < 0) { mpfr_nextabove (z); /* z = -1/2 + epsilon */ inex = 1; } else if (rnd_mode == MPFR_RNDD && signs > 0) { mpfr_nextbelow (z); /* z = -1/2 - epsilon */ inex = -1; } else { if (rnd_mode == MPFR_RNDU) /* s > 0: z = -1/2 */ inex = 1; else if (rnd_mode == MPFR_RNDD) inex = -1; /* s < 0: z = -1/2 */ else /* (MPFR_RNDZ and s > 0) or MPFR_RNDN: z = -1/2 */ inex = (signs > 0) ? 1 : -1; } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (z, inex, rnd_mode); } /* Check for case s= -2n */ if (MPFR_IS_NEG (s)) { mpfr_t tmp; tmp[0] = *s; MPFR_EXP (tmp) = MPFR_GET_EXP (s) - 1; if (mpfr_integer_p (tmp)) { MPFR_SET_ZERO (z); MPFR_SET_POS (z); MPFR_RET (0); } } /* Check for case s= 1 before changing the exponent range */ if (mpfr_cmp (s, __gmpfr_one) ==0) { MPFR_SET_INF (z); MPFR_SET_POS (z); mpfr_set_divby0 (); MPFR_RET (0); } MPFR_SAVE_EXPO_MARK (expo); /* Compute Zeta */ if (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0) /* Case s >= 1/2 */ inex = mpfr_zeta_pos (z, s, rnd_mode); else /* use reflection formula zeta(s) = 2^s*Pi^(s-1)*sin(Pi*s/2)*gamma(1-s)*zeta(1-s) */ { int overflow = 0; precz = MPFR_PREC (z); precs = MPFR_PREC (s); /* Precision precs1 needed to represent 1 - s, and s + 2, without any truncation */ precs1 = precs + 2 + MAX (0, - MPFR_GET_EXP (s)); sd = mpfr_get_d (s, MPFR_RNDN) - 1.0; if (sd < 0.0) sd = -sd; /* now sd = abs(s-1.0) */ /* Precision prec1 is the precision on elementary computations; it ensures a final precision prec1 - add for zeta(s) */ /* eps = pow (2.0, - (double) precz - 14.0); */ eps = __gmpfr_ceil_exp2 (- (double) precz - 14.0); m1 = 1.0 + MAX(1.0 / eps, 2.0 * sd) * (1.0 + eps); c = (1.0 + eps) * (1.0 + eps * MAX(8.0, m1)); /* add = 1 + floor(log(c*c*c*(13 + m1))/log(2)); */ add = __gmpfr_ceil_log2 (c * c * c * (13.0 + m1)); prec1 = precz + add; prec1 = MAX (prec1, precs1) + 10; MPFR_GROUP_INIT_4 (group, prec1, z_pre, s1, y, p); MPFR_ZIV_INIT (loop, prec1); for (;;) { mpfr_sub (s1, __gmpfr_one, s, MPFR_RNDN);/* s1 = 1-s */ mpfr_zeta_pos (z_pre, s1, MPFR_RNDN); /* zeta(1-s) */ mpfr_gamma (y, s1, MPFR_RNDN); /* gamma(1-s) */ if (MPFR_IS_INF (y)) /* Zeta(s) < 0 for -4k-2 < s < -4k, Zeta(s) > 0 for -4k < s < -4k+2 */ { mpfr_div_2ui (s1, s, 2, MPFR_RNDN); /* s/4, exact */ mpfr_frac (s1, s1, MPFR_RNDN); /* exact, -1 < s1 < 0 */ overflow = (mpfr_cmp_si_2exp (s1, -1, -1) > 0) ? -1 : 1; break; } mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); /* gamma(1-s)*zeta(1-s) */ mpfr_const_pi (p, MPFR_RNDD); mpfr_mul (y, s, p, MPFR_RNDN); mpfr_div_2ui (y, y, 1, MPFR_RNDN); /* s*Pi/2 */ mpfr_sin (y, y, MPFR_RNDN); /* sin(Pi*s/2) */ mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); mpfr_mul_2ui (y, p, 1, MPFR_RNDN); /* 2*Pi */ mpfr_neg (s1, s1, MPFR_RNDN); /* s-1 */ mpfr_pow (y, y, s1, MPFR_RNDN); /* (2*Pi)^(s-1) */ mpfr_mul (z_pre, z_pre, y, MPFR_RNDN); mpfr_mul_2ui (z_pre, z_pre, 1, MPFR_RNDN); if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, prec1 - add, precz, rnd_mode))) break; MPFR_ZIV_NEXT (loop, prec1); MPFR_GROUP_REPREC_4 (group, prec1, z_pre, s1, y, p); } MPFR_ZIV_FREE (loop); if (overflow != 0) { inex = mpfr_overflow (z, rnd_mode, overflow); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW); } else inex = mpfr_set (z, z_pre, rnd_mode); MPFR_GROUP_CLEAR (group); } MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (z, inex, rnd_mode); }

static void tst (void) { int sv = sizeof (val) / sizeof (*val); int i, j; int rnd; mpfr_t x, y, z, tmp; mpfr_inits2 (53, x, y, z, tmp, (mpfr_ptr) 0); for (i = 0; i < sv; i++) for (j = 0; j < sv; j++) RND_LOOP (rnd) { int exact, inex; unsigned int flags; if (my_setstr (x, val[i]) || my_setstr (y, val[j])) { printf ("internal error for (%d,%d,%d)\n", i, j, rnd); exit (1); } mpfr_clear_flags (); inex = mpfr_pow (z, x, y, (mpfr_rnd_t) rnd); flags = __gmpfr_flags; if (! MPFR_IS_NAN (z) && mpfr_nanflag_p ()) err ("got NaN flag without NaN value", i, j, rnd, z, inex); if (MPFR_IS_NAN (z) && ! mpfr_nanflag_p ()) err ("got NaN value without NaN flag", i, j, rnd, z, inex); if (inex != 0 && ! mpfr_inexflag_p ()) err ("got non-zero ternary value without inexact flag", i, j, rnd, z, inex); if (inex == 0 && mpfr_inexflag_p ()) err ("got null ternary value with inexact flag", i, j, rnd, z, inex); if (i >= 3 && j >= 3) { if (mpfr_underflow_p ()) err ("got underflow", i, j, rnd, z, inex); if (mpfr_overflow_p ()) err ("got overflow", i, j, rnd, z, inex); exact = MPFR_IS_SINGULAR (z) || (mpfr_mul_2ui (tmp, z, 16, MPFR_RNDN), mpfr_integer_p (tmp)); if (exact && inex != 0) err ("got exact value with ternary flag different from 0", i, j, rnd, z, inex); if (! exact && inex == 0) err ("got inexact value with ternary flag equal to 0", i, j, rnd, z, inex); } if (MPFR_IS_ZERO (x) && ! MPFR_IS_NAN (y) && MPFR_NOTZERO (y)) { if (MPFR_IS_NEG (y) && ! MPFR_IS_INF (z)) err ("expected an infinity", i, j, rnd, z, inex); if (MPFR_IS_POS (y) && ! MPFR_IS_ZERO (z)) err ("expected a zero", i, j, rnd, z, inex); if ((MPFR_IS_NEG (x) && is_odd (y)) ^ MPFR_IS_NEG (z)) err ("wrong sign", i, j, rnd, z, inex); } if (! MPFR_IS_NAN (x) && mpfr_cmp_si (x, -1) == 0) { /* x = -1 */ if (! (MPFR_IS_INF (y) || mpfr_integer_p (y)) && ! MPFR_IS_NAN (z)) err ("expected NaN", i, j, rnd, z, inex); if ((MPFR_IS_INF (y) || (mpfr_integer_p (y) && ! is_odd (y))) && ! mpfr_equal_p (z, __gmpfr_one)) err ("expected 1", i, j, rnd, z, inex); if (is_odd (y) && (MPFR_IS_NAN (z) || mpfr_cmp_si (z, -1) != 0)) err ("expected -1", i, j, rnd, z, inex); } if ((mpfr_equal_p (x, __gmpfr_one) || MPFR_IS_ZERO (y)) && ! mpfr_equal_p (z, __gmpfr_one)) err ("expected 1", i, j, rnd, z, inex); if (MPFR_IS_PURE_FP (x) && MPFR_IS_NEG (x) && MPFR_IS_FP (y) && ! mpfr_integer_p (y) && ! MPFR_IS_NAN (z)) err ("expected NaN", i, j, rnd, z, inex); if (MPFR_IS_INF (y) && MPFR_NOTZERO (x)) { int cmpabs1 = mpfr_cmpabs (x, __gmpfr_one); if ((MPFR_IS_NEG (y) ? (cmpabs1 < 0) : (cmpabs1 > 0)) && ! (MPFR_IS_POS (z) && MPFR_IS_INF (z))) err ("expected +Inf", i, j, rnd, z, inex); if ((MPFR_IS_NEG (y) ? (cmpabs1 > 0) : (cmpabs1 < 0)) && ! (MPFR_IS_POS (z) && MPFR_IS_ZERO (z))) err ("expected +0", i, j, rnd, z, inex); } if (MPFR_IS_INF (x) && ! MPFR_IS_NAN (y) && MPFR_NOTZERO (y)) { if (MPFR_IS_POS (y) && ! MPFR_IS_INF (z)) err ("expected an infinity", i, j, rnd, z, inex); if (MPFR_IS_NEG (y) && ! MPFR_IS_ZERO (z)) err ("expected a zero", i, j, rnd, z, inex); if ((MPFR_IS_NEG (x) && is_odd (y)) ^ MPFR_IS_NEG (z)) err ("wrong sign", i, j, rnd, z, inex); } test_others (val[i], val[j], (mpfr_rnd_t) rnd, x, y, z, inex, flags, "tst"); } mpfr_clears (x, y, z, tmp, (mpfr_ptr) 0); }