static void set_special (mpfr_ptr x, unsigned int select) { MPFR_ASSERTN (select < SPECIAL_MAX); switch (select) { case 0: MPFR_SET_NAN (x); break; case 1: MPFR_SET_INF (x); MPFR_SET_POS (x); break; case 2: MPFR_SET_INF (x); MPFR_SET_NEG (x); break; case 3: MPFR_SET_ZERO (x); MPFR_SET_POS (x); break; case 4: MPFR_SET_ZERO (x); MPFR_SET_NEG (x); break; case 5: mpfr_set_str_binary (x, "1"); break; case 6: mpfr_set_str_binary (x, "-1"); break; case 7: mpfr_set_str_binary (x, "1e-1"); break; case 8: mpfr_set_str_binary (x, "1e+1"); break; case 9: mpfr_const_pi (x, MPFR_RNDN); break; case 10: mpfr_const_pi (x, MPFR_RNDN); MPFR_SET_EXP (x, MPFR_GET_EXP (x)-1); break; default: mpfr_urandomb (x, RANDS); if (randlimb () & 1) mpfr_neg (x, x, MPFR_RNDN); break; } }
void mpfr_set_str_binary (mpfr_ptr x, const char *str) { int has_sign; int res; if (*str == 'N') { MPFR_SET_NAN(x); __gmpfr_flags |= MPFR_FLAGS_NAN; return; } has_sign = *str == '-' || *str == '+'; if (str[has_sign] == 'I') { MPFR_SET_INF(x); if (*str == '-') MPFR_SET_NEG(x); else MPFR_SET_POS(x); return; } res = mpfr_strtofr (x, str, 0, 2, MPFR_RNDZ); MPFR_ASSERTN (res == 0); }
int mpfr_sqrt_ui (mpfr_ptr r, unsigned long u, mpfr_rnd_t rnd_mode) { if (u) { mpfr_t uu; mp_limb_t up[1]; unsigned long cnt; int inex; MPFR_SAVE_EXPO_DECL (expo); MPFR_TMP_INIT1 (up, uu, GMP_NUMB_BITS); MPFR_ASSERTN (u == (mp_limb_t) u); count_leading_zeros (cnt, (mp_limb_t) u); *up = (mp_limb_t) u << cnt; MPFR_SAVE_EXPO_MARK (expo); MPFR_SET_EXP (uu, GMP_NUMB_BITS - cnt); inex = mpfr_sqrt(r, uu, rnd_mode); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range(r, inex, rnd_mode); } else /* sqrt(0) = 0 */ { MPFR_SET_ZERO(r); MPFR_SET_POS(r); MPFR_RET(0); } }
int mpfr_urandomb (mpfr_ptr rop, gmp_randstate_t rstate) { mp_ptr rp; mp_prec_t nbits; mp_size_t nlimbs; mp_size_t k; /* number of high zero limbs */ mp_exp_t exp; int cnt; MPFR_CLEAR_FLAGS (rop); rp = MPFR_MANT (rop); nbits = MPFR_PREC (rop); nlimbs = MPFR_LIMB_SIZE (rop); MPFR_SET_POS (rop); /* Uniform non-normalized significand */ _gmp_rand (rp, rstate, nlimbs * BITS_PER_MP_LIMB); /* If nbits isn't a multiple of BITS_PER_MP_LIMB, mask the low bits */ cnt = nlimbs * BITS_PER_MP_LIMB - nbits; if (MPFR_LIKELY (cnt != 0)) rp[0] &= ~MPFR_LIMB_MASK (cnt); /* Count the null significant limbs and remaining limbs */ exp = 0; k = 0; while (nlimbs != 0 && rp[nlimbs - 1] == 0) { k ++; nlimbs --; exp -= BITS_PER_MP_LIMB; } if (MPFR_LIKELY (nlimbs != 0)) /* otherwise value is zero */ { count_leading_zeros (cnt, rp[nlimbs - 1]); /* Normalization */ if (mpfr_set_exp (rop, exp - cnt)) { /* If the exponent is not in the current exponent range, we choose to return a NaN as this is probably a user error. Indeed this can happen only if the exponent range has been reduced to a very small interval and/or the precision is huge (very unlikely). */ MPFR_SET_NAN (rop); __gmpfr_flags |= MPFR_FLAGS_NAN; /* Can't use MPFR_RET_NAN */ return 1; } if (cnt != 0) mpn_lshift (rp + k, rp, nlimbs, cnt); if (k != 0) MPN_ZERO (rp, k); } else MPFR_SET_ZERO (rop); return 0; }
static void test_overflow1 (void) { mpfr_t x, y, z, r; int inex; mpfr_inits2 (8, x, y, z, r, (void *) 0); MPFR_SET_POS (x); mpfr_setmax (x, mpfr_get_emax ()); /* x = 2^emax - ulp */ mpfr_set_ui (y, 2, GMP_RNDN); /* y = 2 */ mpfr_neg (z, x, GMP_RNDN); /* z = -x = -(2^emax - ulp) */ mpfr_clear_flags (); /* The intermediate multiplication x * y overflows, but x * y + z = x is representable. */ inex = mpfr_fma (r, x, y, z, GMP_RNDN); if (inex || ! mpfr_equal_p (r, x)) { printf ("Error in test_overflow1\nexpected "); mpfr_out_str (stdout, 2, 0, x, GMP_RNDN); printf (" with inex = 0\n got "); mpfr_out_str (stdout, 2, 0, r, GMP_RNDN); printf (" with inex = %d\n", inex); exit (1); } if (mpfr_overflow_p ()) { printf ("Error in test_overflow1: overflow flag set\n"); exit (1); } mpfr_clears (x, y, z, r, (void *) 0); }
/* set f to the integer z multiplied by 2^e */ int mpfr_set_z_2exp (mpfr_ptr f, mpz_srcptr z, mpfr_exp_t e, mpfr_rnd_t rnd_mode) { mp_size_t fn, zn, dif, en; int k, sign_z, inex; mp_limb_t *fp, *zp; mpfr_exp_t exp; sign_z = mpz_sgn (z); if (MPFR_UNLIKELY (sign_z == 0)) /* ignore the exponent for 0 */ { MPFR_SET_ZERO(f); MPFR_SET_POS(f); MPFR_RET(0); } MPFR_ASSERTD (sign_z == MPFR_SIGN_POS || sign_z == MPFR_SIGN_NEG); zn = ABS(SIZ(z)); /* limb size of z */ /* compute en = floor(e/GMP_NUMB_BITS) */ en = (e >= 0) ? e / GMP_NUMB_BITS : (e + 1) / GMP_NUMB_BITS - 1; MPFR_ASSERTD (zn >= 1); if (MPFR_UNLIKELY (zn + en > MPFR_EMAX_MAX / GMP_NUMB_BITS + 1)) return mpfr_overflow (f, rnd_mode, sign_z); /* because zn + en >= MPFR_EMAX_MAX / GMP_NUMB_BITS + 2 implies (zn + en) * GMP_NUMB_BITS >= MPFR_EMAX_MAX + GMP_NUMB_BITS + 1 and exp = zn * GMP_NUMB_BITS + e - k >= (zn + en) * GMP_NUMB_BITS - k > MPFR_EMAX_MAX */ fp = MPFR_MANT (f); fn = MPFR_LIMB_SIZE (f); dif = zn - fn; zp = PTR(z); count_leading_zeros (k, zp[zn-1]); /* now zn + en <= MPFR_EMAX_MAX / GMP_NUMB_BITS + 1 thus (zn + en) * GMP_NUMB_BITS <= MPFR_EMAX_MAX + GMP_NUMB_BITS and exp = zn * GMP_NUMB_BITS + e - k <= (zn + en) * GMP_NUMB_BITS - k + GMP_NUMB_BITS - 1 <= MPFR_EMAX_MAX + 2 * GMP_NUMB_BITS - 1 */ exp = (mpfr_prec_t) zn * GMP_NUMB_BITS + e - k; /* The exponent will be exp or exp + 1 (due to rounding) */ if (MPFR_UNLIKELY (exp > __gmpfr_emax)) return mpfr_overflow (f, rnd_mode, sign_z); if (MPFR_UNLIKELY (exp + 1 < __gmpfr_emin)) return mpfr_underflow (f, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode, sign_z); if (MPFR_LIKELY (dif >= 0)) { mp_limb_t rb, sb, ulp; int sh; /* number has to be truncated */ if (MPFR_LIKELY (k != 0)) { mpn_lshift (fp, &zp[dif], fn, k); if (MPFR_LIKELY (dif > 0)) fp[0] |= zp[dif - 1] >> (GMP_NUMB_BITS - k); }
int mpfr_urandomb (mpfr_ptr rop, gmp_randstate_t rstate) { mpfr_limb_ptr rp; mpfr_prec_t nbits; mp_size_t nlimbs; mp_size_t k; /* number of high zero limbs */ mpfr_exp_t exp; int cnt; rp = MPFR_MANT (rop); nbits = MPFR_PREC (rop); nlimbs = MPFR_LIMB_SIZE (rop); MPFR_SET_POS (rop); cnt = nlimbs * GMP_NUMB_BITS - nbits; /* Uniform non-normalized significand */ /* generate exactly nbits so that the random generator stays in the same state, independent of the machine word size GMP_NUMB_BITS */ mpfr_rand_raw (rp, rstate, nbits); if (MPFR_LIKELY (cnt != 0)) /* this will put the low bits to zero */ mpn_lshift (rp, rp, nlimbs, cnt); /* Count the null significant limbs and remaining limbs */ exp = 0; k = 0; while (nlimbs != 0 && rp[nlimbs - 1] == 0) { k ++; nlimbs --; exp -= GMP_NUMB_BITS; } if (MPFR_LIKELY (nlimbs != 0)) /* otherwise value is zero */ { count_leading_zeros (cnt, rp[nlimbs - 1]); /* Normalization */ if (mpfr_set_exp (rop, exp - cnt)) { /* If the exponent is not in the current exponent range, we choose to return a NaN as this is probably a user error. Indeed this can happen only if the exponent range has been reduced to a very small interval and/or the precision is huge (very unlikely). */ MPFR_SET_NAN (rop); __gmpfr_flags |= MPFR_FLAGS_NAN; /* Can't use MPFR_RET_NAN */ return 1; } if (cnt != 0) mpn_lshift (rp + k, rp, nlimbs, cnt); if (k != 0) MPN_ZERO (rp, k); } else MPFR_SET_ZERO (rop); return 0; }
static void check_nan (void) { mpfr_t d, q; mpfr_init2 (d, 100L); mpfr_init2 (q, 100L); /* 1/+inf == 0 */ MPFR_CLEAR_FLAGS (d); MPFR_SET_INF (d); MPFR_SET_POS (d); MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (q)); MPFR_ASSERTN (mpfr_sgn (q) == 0); /* 1/-inf == -0 */ MPFR_CLEAR_FLAGS (d); MPFR_SET_INF (d); MPFR_SET_NEG (d); MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (q)); MPFR_ASSERTN (mpfr_sgn (q) == 0); /* 1/nan == nan */ MPFR_SET_NAN (d); MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_nan_p (q)); /* 0/0 == nan */ mpfr_set_ui (d, 0L, GMP_RNDN); MPFR_ASSERTN (mpfr_ui_div (q, 0L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_nan_p (q)); /* 1/+0 = +inf */ mpfr_set_ui (d, 0L, GMP_RNDN); MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0); /* 1/-0 = -inf */ mpfr_set_ui (d, 0L, GMP_RNDN); mpfr_neg (d, d, GMP_RNDN); MPFR_ASSERTN (mpfr_ui_div (q, 1L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) < 0); /* 0/1 = +0 */ mpfr_set_ui (d, 1L, GMP_RNDN); MPFR_ASSERTN (mpfr_ui_div (q, 0L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_cmp_ui (q, 0) == 0 && MPFR_IS_POS (q)); /* 0/-1 = -0 */ mpfr_set_si (d, -1, GMP_RNDN); MPFR_ASSERTN (mpfr_ui_div (q, 0L, d, GMP_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_cmp_ui (q, 0) == 0 && MPFR_IS_NEG (q)); mpfr_clear (d); mpfr_clear (q); }
void mpfr_set_inf (mpfr_ptr x, int sign) { MPFR_SET_INF(x); if (sign >= 0) MPFR_SET_POS(x); else MPFR_SET_NEG(x); }
int mpfr_set_si (mpfr_ptr x, long i, mp_rnd_t rnd_mode) { int inex; mp_size_t xn; unsigned int cnt, nbits; mp_limb_t ai, *xp; MPFR_CLEAR_FLAGS(x); if (i == 0) { MPFR_SET_ZERO(x); MPFR_SET_POS(x); MPFR_RET(0); } xn = (MPFR_PREC(x)-1)/BITS_PER_MP_LIMB; ai = SAFE_ABS(long, i); count_leading_zeros(cnt, ai); xp = MPFR_MANT(x); xp[xn] = ai << cnt; /* don't forget to put zero in lower limbs */ MPN_ZERO(xp, xn); /* set sign */ if ((i < 0) ^ (MPFR_SIGN(x) < 0)) MPFR_CHANGE_SIGN(x); MPFR_EXP(x) = nbits = BITS_PER_MP_LIMB - cnt; inex = mpfr_check_range(x, rnd_mode); if (inex) return inex; /* underflow or overflow */ /* round if MPFR_PREC(x) smaller than length of i */ if (MPFR_PREC(x) < nbits) { int carry; carry = mpfr_round_raw(xp+xn, xp+xn, nbits, (i < 0), MPFR_PREC(x), rnd_mode, &inex); if (carry) { mp_exp_t exp = MPFR_EXP(x); if (exp == __mpfr_emax) return mpfr_set_overflow(x, rnd_mode, (i < 0 ? -1 : 1)); MPFR_EXP(x)++; xp[xn] = GMP_LIMB_HIGHBIT; } } MPFR_RET(inex); }
static int my_setstr (mpfr_ptr t, const char *s) { if (strcmp (s, "min") == 0) { mpfr_setmin (t, mpfr_get_emin ()); MPFR_SET_POS (t); return 0; } if (strcmp (s, "min+") == 0) { mpfr_setmin (t, mpfr_get_emin ()); MPFR_SET_POS (t); mpfr_nextabove (t); return 0; } if (strcmp (s, "max") == 0) { mpfr_setmax (t, mpfr_get_emax ()); MPFR_SET_POS (t); return 0; } return mpfr_set_str (t, s, 10, MPFR_RNDN); }
/* set f to the integer z */ int mpfr_set_z (mpfr_ptr f, mpz_srcptr z, mp_rnd_t rnd_mode) { mp_size_t fn, zn, dif; int k, sign_z, inex; mp_limb_t *fp, *zp; mp_exp_t exp; MPFR_CLEAR_FLAGS (f); /* z cannot be NaN nor Inf */ sign_z = mpz_cmp_ui (z, 0); if (sign_z == 0) { MPFR_SET_ZERO(f); MPFR_SET_POS(f); MPFR_RET(0); } fp = MPFR_MANT(f); fn = 1 + (MPFR_PREC(f) - 1) / BITS_PER_MP_LIMB; zn = ABS(SIZ(z)); dif = zn - fn; zp = PTR(z); count_leading_zeros(k, zp[zn-1]); exp = (mp_prec_t) zn * BITS_PER_MP_LIMB - k; /* The exponent will be exp or exp + 1 (due to rounding) */ if (exp > __mpfr_emax) return mpfr_set_overflow(f, rnd_mode, sign_z); if (exp + 1 < __mpfr_emin) return mpfr_set_underflow(f, rnd_mode, sign_z); if (MPFR_SIGN(f) * sign_z < 0) MPFR_CHANGE_SIGN(f); if (dif >= 0) { mp_limb_t cc; int sh; /* number has to be truncated */ if (k != 0) { mpn_lshift(fp, zp + dif, fn, k); if (dif != 0) fp[0] += zp[dif - 1] >> (BITS_PER_MP_LIMB - k); }
static void check_singular (void) { mpfr_t x, got; mpfr_init2 (x, 100L); mpfr_init2 (got, 100L); /* sqrt(NaN) == NaN */ MPFR_SET_NAN (x); MPFR_ASSERTN (test_sqrt (got, x, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_nan_p (got)); /* sqrt(-1) == NaN */ mpfr_set_si (x, -1L, MPFR_RNDZ); MPFR_ASSERTN (test_sqrt (got, x, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_nan_p (got)); /* sqrt(+inf) == +inf */ MPFR_SET_INF (x); MPFR_SET_POS (x); MPFR_ASSERTN (test_sqrt (got, x, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (got)); /* sqrt(-inf) == NaN */ MPFR_SET_INF (x); MPFR_SET_NEG (x); MPFR_ASSERTN (test_sqrt (got, x, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_nan_p (got)); /* sqrt(+0) == +0 */ mpfr_set_si (x, 0L, MPFR_RNDZ); MPFR_ASSERTN (test_sqrt (got, x, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (got)); MPFR_ASSERTN (mpfr_cmp_ui (got, 0L) == 0); MPFR_ASSERTN (MPFR_IS_POS (got)); /* sqrt(-0) == -0 */ mpfr_set_si (x, 0L, MPFR_RNDZ); MPFR_SET_NEG (x); MPFR_ASSERTN (test_sqrt (got, x, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (got)); MPFR_ASSERTN (mpfr_cmp_ui (got, 0L) == 0); MPFR_ASSERTN (MPFR_IS_NEG (got)); mpfr_clear (x); mpfr_clear (got); }
int mpfr_set_si_2exp (mpfr_ptr x, long i, mp_exp_t e, mp_rnd_t rnd_mode) { if (i == 0) { MPFR_SET_ZERO (x); MPFR_SET_POS (x); MPFR_RET (0); } else { mp_size_t xn; unsigned int cnt, nbits; mp_limb_t ai, *xp; int inex = 0; /* FIXME: support int limbs (e.g. 16-bit limbs on 16-bit proc) */ ai = SAFE_ABS (unsigned long, i); MPFR_ASSERTN (SAFE_ABS (unsigned long, i) == ai); /* Position of the highest limb */ xn = (MPFR_PREC (x) - 1) / BITS_PER_MP_LIMB; count_leading_zeros (cnt, ai); MPFR_ASSERTD (cnt < BITS_PER_MP_LIMB); /* OK since i != 0 */ xp = MPFR_MANT(x); xp[xn] = ai << cnt; /* Zero the xn lower limbs. */ MPN_ZERO(xp, xn); MPFR_SET_SIGN (x, i < 0 ? MPFR_SIGN_NEG : MPFR_SIGN_POS); nbits = BITS_PER_MP_LIMB - cnt; e += nbits; /* exponent _before_ the rounding */ /* round if MPFR_PREC(x) smaller than length of i */ if (MPFR_UNLIKELY (MPFR_PREC (x) < nbits) && MPFR_UNLIKELY (mpfr_round_raw (xp + xn, xp + xn, nbits, i < 0, MPFR_PREC (x), rnd_mode, &inex))) { e++; xp[xn] = MPFR_LIMB_HIGHBIT; } MPFR_CLEAR_FLAGS (x); MPFR_EXP (x) = e; return mpfr_check_range (x, inex, rnd_mode); } }
/* set f to the rational q */ int mpfr_set_q (mpfr_ptr f, mpq_srcptr q, mp_rnd_t rnd) { mpz_srcptr num, den; mpfr_t n, d; int inexact; mp_prec_t prec; MPFR_CLEAR_FLAGS (f); num = mpq_numref (q); if (mpz_cmp_ui (num, 0) == 0) { MPFR_SET_ZERO (f); MPFR_SET_POS (f); MPFR_RET (0); } den = mpq_denref (q); mpfr_save_emin_emax (); prec = mpz_sizeinbase (num, 2); if (prec < MPFR_PREC_MIN) prec = MPFR_PREC_MIN; mpfr_init2 (n, prec); if (mpfr_set_z (n, num, GMP_RNDZ)) /* result is exact unless overflow */ { mpfr_clear (n); mpfr_restore_emin_emax (); MPFR_SET_NAN (f); MPFR_RET_NAN; } prec = mpz_sizeinbase(den, 2); if (prec < MPFR_PREC_MIN) prec = MPFR_PREC_MIN; mpfr_init2 (d, prec); if (mpfr_set_z (d, den, GMP_RNDZ)) /* result is exact unless overflow */ { mpfr_clear (d); mpfr_clear (n); mpfr_restore_emin_emax (); MPFR_SET_NAN (f); MPFR_RET_NAN; } inexact = mpfr_div (f, n, d, rnd); mpfr_clear (n); mpfr_clear (d); MPFR_RESTORE_RET (inexact, f, rnd); }
static void check_sgn(void) { mpfr_t x; int i, s1, s2; mpfr_init(x); for(i = 0 ; i < 100 ; i++) { mpfr_urandomb (x, RANDS); if (i&1) { MPFR_SET_POS(x); s2 = 1; } else { MPFR_SET_NEG(x); s2 = -1; } s1 = mpfr_sgn(x); if (s1 < -1 || s1 > 1) { printf("Error for sgn: out of range.\n"); goto lexit; } else if (MPFR_IS_NAN(x) || MPFR_IS_ZERO(x)) { if (s1 != 0) { printf("Error for sgn: Nan or Zero should return 0.\n"); goto lexit; } } else if (s1 != s2) { printf("Error for sgn. Return %d instead of %d.\n", s1, s2); goto lexit; } } mpfr_clear(x); return; lexit: mpfr_clear(x); exit(1); }
int mpfr_set_ui_2exp (mpfr_ptr x, unsigned long i, mpfr_exp_t e, mpfr_rnd_t rnd_mode) { MPFR_SET_POS (x); if (i == 0) { MPFR_SET_ZERO (x); MPFR_RET (0); } else { mp_size_t xn; unsigned int cnt, nbits; mp_limb_t *xp; int inex = 0; /* FIXME: support int limbs (e.g. 16-bit limbs on 16-bit proc) */ MPFR_ASSERTD (i == (mp_limb_t) i); /* Position of the highest limb */ xn = (MPFR_PREC (x) - 1) / GMP_NUMB_BITS; count_leading_zeros (cnt, (mp_limb_t) i); MPFR_ASSERTD (cnt < GMP_NUMB_BITS); /* OK since i != 0 */ xp = MPFR_MANT(x); xp[xn] = ((mp_limb_t) i) << cnt; /* Zero the xn lower limbs. */ MPN_ZERO(xp, xn); nbits = GMP_NUMB_BITS - cnt; e += nbits; /* exponent _before_ the rounding */ /* round if MPFR_PREC(x) smaller than length of i */ if (MPFR_UNLIKELY (MPFR_PREC (x) < nbits) && MPFR_UNLIKELY (mpfr_round_raw (xp + xn, xp + xn, nbits, 0, MPFR_PREC (x), rnd_mode, &inex))) { e++; xp[xn] = MPFR_LIMB_HIGHBIT; } MPFR_EXP (x) = e; return mpfr_check_range (x, inex, rnd_mode); } }
int mpfr_dim (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode) { if (MPFR_IS_NAN(x) || MPFR_IS_NAN(y)) { MPFR_SET_NAN(z); MPFR_RET_NAN; } if (mpfr_cmp (x,y) > 0) return mpfr_sub (z, x, y, rnd_mode); else { MPFR_SET_ZERO(z); MPFR_SET_POS(z); MPFR_RET(0); } }
/* Parameters: s - the input floating-point number n, p - parameters from the algorithm tc - an array of p floating-point numbers tc[1]..tc[p] Output: b is the result, i.e. sum(tc[i]*product((s+2j)*(s+2j-1)/n^2,j=1..i-1), i=1..p)*s*n^(-s-1) */ static void mpfr_zeta_part_b (mpfr_t b, mpfr_srcptr s, int n, int p, mpfr_t *tc) { mpfr_t s1, d, u; unsigned long n2; int l, t; MPFR_GROUP_DECL (group); if (p == 0) { MPFR_SET_ZERO (b); MPFR_SET_POS (b); return; } n2 = n * n; MPFR_GROUP_INIT_3 (group, MPFR_PREC (b), s1, d, u); /* t equals 2p-2, 2p-3, ... ; s1 equals s+t */ t = 2 * p - 2; mpfr_set (d, tc[p], GMP_RNDN); for (l = 1; l < p; l++) { mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l) */ mpfr_mul (d, d, s1, GMP_RNDN); t = t - 1; mpfr_add_ui (s1, s, t, GMP_RNDN); /* s + (2p-2l-1) */ mpfr_mul (d, d, s1, GMP_RNDN); t = t - 1; mpfr_div_ui (d, d, n2, GMP_RNDN); mpfr_add (d, d, tc[p-l], GMP_RNDN); /* since s is positive and the tc[i] have alternate signs, the following is unlikely */ if (MPFR_UNLIKELY (mpfr_cmpabs (d, tc[p-l]) > 0)) mpfr_set (d, tc[p-l], GMP_RNDN); } mpfr_mul (d, d, s, GMP_RNDN); mpfr_add (s1, s, __gmpfr_one, GMP_RNDN); mpfr_neg (s1, s1, GMP_RNDN); mpfr_ui_pow (u, n, s1, GMP_RNDN); mpfr_mul (b, d, u, GMP_RNDN); MPFR_GROUP_CLEAR (group); }
static void check_special (void) { mpfr_t x; int ret = 0; mpfr_init (x); MPFR_SET_ZERO (x); if ((mpfr_sgn) (x) != 0 || mpfr_sgn (x) != 0) { printf("Sgn error for 0.\n"); ret = 1; } MPFR_SET_INF (x); MPFR_SET_POS (x); if ((mpfr_sgn) (x) != 1 || mpfr_sgn (x) != 1) { printf("Sgn error for +Inf.\n"); ret = 1; } MPFR_SET_INF (x); MPFR_SET_NEG (x); if ((mpfr_sgn) (x) != -1 || mpfr_sgn (x) != -1) { printf("Sgn error for -Inf.\n"); ret = 1; } MPFR_SET_NAN (x); mpfr_clear_flags (); if ((mpfr_sgn) (x) != 0 || !mpfr_erangeflag_p ()) { printf("Sgn error for NaN.\n"); ret = 1; } mpfr_clear_flags (); if (mpfr_sgn (x) != 0 || !mpfr_erangeflag_p ()) { printf("Sgn error for NaN.\n"); ret = 1; } mpfr_clear (x); if (ret) exit (ret); }
int mpfr_exp (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_exp_t expx; mpfr_prec_t precy; int inexact; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd_mode), ("y[%#R]=%R inexact=%d", y, y, inexact)); if (MPFR_UNLIKELY( MPFR_IS_SINGULAR(x) )) { if (MPFR_IS_NAN(x)) { MPFR_SET_NAN(y); MPFR_RET_NAN; } else if (MPFR_IS_INF(x)) { if (MPFR_IS_POS(x)) MPFR_SET_INF(y); else MPFR_SET_ZERO(y); MPFR_SET_POS(y); MPFR_RET(0); } else { MPFR_ASSERTD(MPFR_IS_ZERO(x)); return mpfr_set_ui (y, 1, rnd_mode); } } /* First, let's detect most overflow and underflow cases. */ { mpfr_t e, bound; /* We must extended the exponent range and save the flags now. */ MPFR_SAVE_EXPO_MARK (expo); mpfr_init2 (e, sizeof (mpfr_exp_t) * CHAR_BIT); mpfr_init2 (bound, 32); inexact = mpfr_set_exp_t (e, expo.saved_emax, MPFR_RNDN); MPFR_ASSERTD (inexact == 0); mpfr_const_log2 (bound, expo.saved_emax < 0 ? MPFR_RNDD : MPFR_RNDU); mpfr_mul (bound, bound, e, MPFR_RNDU); if (MPFR_UNLIKELY (mpfr_cmp (x, bound) >= 0)) { /* x > log(2^emax), thus exp(x) > 2^emax */ mpfr_clears (e, bound, (mpfr_ptr) 0); MPFR_SAVE_EXPO_FREE (expo); return mpfr_overflow (y, rnd_mode, 1); } inexact = mpfr_set_exp_t (e, expo.saved_emin, MPFR_RNDN); MPFR_ASSERTD (inexact == 0); inexact = mpfr_sub_ui (e, e, 2, MPFR_RNDN); MPFR_ASSERTD (inexact == 0); mpfr_const_log2 (bound, expo.saved_emin < 0 ? MPFR_RNDU : MPFR_RNDD); mpfr_mul (bound, bound, e, MPFR_RNDD); if (MPFR_UNLIKELY (mpfr_cmp (x, bound) <= 0)) { /* x < log(2^(emin - 2)), thus exp(x) < 2^(emin - 2) */ mpfr_clears (e, bound, (mpfr_ptr) 0); MPFR_SAVE_EXPO_FREE (expo); return mpfr_underflow (y, rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode, 1); } /* Other overflow/underflow cases must be detected by the generic routines. */ mpfr_clears (e, bound, (mpfr_ptr) 0); MPFR_SAVE_EXPO_FREE (expo); } expx = MPFR_GET_EXP (x); precy = MPFR_PREC (y); /* if x < 2^(-precy), then exp(x) i.e. gives 1 +/- 1 ulp(1) */ if (MPFR_UNLIKELY (expx < 0 && (mpfr_uexp_t) (-expx) > precy)) { mpfr_exp_t emin = __gmpfr_emin; mpfr_exp_t emax = __gmpfr_emax; int signx = MPFR_SIGN (x); MPFR_SET_POS (y); if (MPFR_IS_NEG_SIGN (signx) && (rnd_mode == MPFR_RNDD || rnd_mode == MPFR_RNDZ)) { __gmpfr_emin = 0; __gmpfr_emax = 0; mpfr_setmax (y, 0); /* y = 1 - epsilon */ inexact = -1; } else { __gmpfr_emin = 1; __gmpfr_emax = 1; mpfr_setmin (y, 1); /* y = 1 */ if (MPFR_IS_POS_SIGN (signx) && (rnd_mode == MPFR_RNDU || rnd_mode == MPFR_RNDA)) { mp_size_t yn; int sh; yn = 1 + (MPFR_PREC(y) - 1) / GMP_NUMB_BITS; sh = (mpfr_prec_t) yn * GMP_NUMB_BITS - MPFR_PREC(y); MPFR_MANT(y)[0] += MPFR_LIMB_ONE << sh; inexact = 1; } else inexact = -MPFR_FROM_SIGN_TO_INT(signx); } __gmpfr_emin = emin; __gmpfr_emax = emax; } else /* General case */ { if (MPFR_UNLIKELY (precy >= MPFR_EXP_THRESHOLD)) /* mpfr_exp_3 saves the exponent range and flags itself, otherwise the flag changes in mpfr_exp_3 are lost */ inexact = mpfr_exp_3 (y, x, rnd_mode); /* O(M(n) log(n)^2) */ else { MPFR_SAVE_EXPO_MARK (expo); inexact = mpfr_exp_2 (y, x, rnd_mode); /* O(n^(1/3) M(n)) */ MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags); MPFR_SAVE_EXPO_FREE (expo); } } return mpfr_check_range (y, inexact, rnd_mode); }
int main (void) { mpfr_t x, y, z; int i, j, k; tests_start_mpfr (); mpfr_init (x); mpfr_init (y); mpfr_init (z); for (i = 0; i <= 1; i++) for (j = 0; j <= 1; j++) for (k = 0; k <= 5; k++) { mpfr_set_nan (x); i ? MPFR_SET_NEG (x) : MPFR_SET_POS (x); mpfr_set_nan (y); j ? MPFR_SET_NEG (y) : MPFR_SET_POS (y); copysign_variant (z, x, y, MPFR_RNDN, k); if (MPFR_SIGN (z) != MPFR_SIGN (y) || !mpfr_nanflag_p ()) { printf ("Error in mpfr_copysign (%cNaN, %cNaN)\n", i ? '-' : '+', j ? '-' : '+'); exit (1); } mpfr_set_si (x, i ? -1250 : 1250, MPFR_RNDN); mpfr_set_nan (y); j ? MPFR_SET_NEG (y) : MPFR_SET_POS (y); copysign_variant (z, x, y, MPFR_RNDN, k); if (i != j) mpfr_neg (x, x, MPFR_RNDN); if (! mpfr_equal_p (z, x) || mpfr_nanflag_p ()) { printf ("Error in mpfr_copysign (%c1250, %cNaN)\n", i ? '-' : '+', j ? '-' : '+'); exit (1); } mpfr_set_si (x, i ? -1250 : 1250, MPFR_RNDN); mpfr_set_si (y, j ? -1717 : 1717, MPFR_RNDN); copysign_variant (z, x, y, MPFR_RNDN, k); if (i != j) mpfr_neg (x, x, MPFR_RNDN); if (! mpfr_equal_p (z, x) || mpfr_nanflag_p ()) { printf ("Error in mpfr_copysign (%c1250, %c1717)\n", i ? '-' : '+', j ? '-' : '+'); exit (1); } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); tests_end_mpfr (); return 0; }
/* agm(x,y) is between x and y, so we don't need to save exponent range */ int mpfr_agm (mpfr_ptr r, mpfr_srcptr op2, mpfr_srcptr op1, mp_rnd_t rnd_mode) { int compare, inexact; mp_size_t s; mp_prec_t p, q; mp_limb_t *up, *vp, *tmpp; mpfr_t u, v, tmp; unsigned long n; /* number of iterations */ unsigned long err = 0; MPFR_ZIV_DECL (loop); MPFR_TMP_DECL(marker); MPFR_LOG_FUNC (("op2[%#R]=%R op1[%#R]=%R rnd=%d", op2,op2,op1,op1,rnd_mode), ("r[%#R]=%R inexact=%d", r, r, inexact)); /* Deal with special values */ if (MPFR_ARE_SINGULAR (op1, op2)) { /* If a or b is NaN, the result is NaN */ if (MPFR_IS_NAN(op1) || MPFR_IS_NAN(op2)) { MPFR_SET_NAN(r); MPFR_RET_NAN; } /* now one of a or b is Inf or 0 */ /* If a and b is +Inf, the result is +Inf. Otherwise if a or b is -Inf or 0, the result is NaN */ else if (MPFR_IS_INF(op1) || MPFR_IS_INF(op2)) { if (MPFR_IS_STRICTPOS(op1) && MPFR_IS_STRICTPOS(op2)) { MPFR_SET_INF(r); MPFR_SET_SAME_SIGN(r, op1); MPFR_RET(0); /* exact */ } else { MPFR_SET_NAN(r); MPFR_RET_NAN; } } else /* a and b are neither NaN nor Inf, and one is zero */ { /* If a or b is 0, the result is +0 since a sqrt is positive */ MPFR_ASSERTD (MPFR_IS_ZERO (op1) || MPFR_IS_ZERO (op2)); MPFR_SET_POS (r); MPFR_SET_ZERO (r); MPFR_RET (0); /* exact */ } } MPFR_CLEAR_FLAGS (r); /* If a or b is negative (excluding -Infinity), the result is NaN */ if (MPFR_UNLIKELY(MPFR_IS_NEG(op1) || MPFR_IS_NEG(op2))) { MPFR_SET_NAN(r); MPFR_RET_NAN; } /* Precision of the following calculus */ q = MPFR_PREC(r); p = q + MPFR_INT_CEIL_LOG2(q) + 15; MPFR_ASSERTD (p >= 7); /* see algorithms.tex */ s = (p - 1) / BITS_PER_MP_LIMB + 1; /* b (op2) and a (op1) are the 2 operands but we want b >= a */ compare = mpfr_cmp (op1, op2); if (MPFR_UNLIKELY( compare == 0 )) { mpfr_set (r, op1, rnd_mode); MPFR_RET (0); /* exact */ } else if (compare > 0) { mpfr_srcptr t = op1; op1 = op2; op2 = t; } /* Now b(=op2) >= a (=op1) */ MPFR_TMP_MARK(marker); /* Main loop */ MPFR_ZIV_INIT (loop, p); for (;;) { mp_prec_t eq; /* Init temporary vars */ MPFR_TMP_INIT (up, u, p, s); MPFR_TMP_INIT (vp, v, p, s); MPFR_TMP_INIT (tmpp, tmp, p, s); /* Calculus of un and vn */ mpfr_mul (u, op1, op2, GMP_RNDN); /* Faster since PREC(op) < PREC(u) */ mpfr_sqrt (u, u, GMP_RNDN); mpfr_add (v, op1, op2, GMP_RNDN); /* add with !=prec is still good*/ mpfr_div_2ui (v, v, 1, GMP_RNDN); n = 1; while (mpfr_cmp2 (u, v, &eq) != 0 && eq <= p - 2) { mpfr_add (tmp, u, v, GMP_RNDN); mpfr_div_2ui (tmp, tmp, 1, GMP_RNDN); /* See proof in algorithms.tex */ if (4*eq > p) { mpfr_t w; /* tmp = U(k) */ mpfr_init2 (w, (p + 1) / 2); mpfr_sub (w, v, u, GMP_RNDN); /* e = V(k-1)-U(k-1) */ mpfr_sqr (w, w, GMP_RNDN); /* e = e^2 */ mpfr_div_2ui (w, w, 4, GMP_RNDN); /* e*= (1/2)^2*1/4 */ mpfr_div (w, w, tmp, GMP_RNDN); /* 1/4*e^2/U(k) */ mpfr_sub (v, tmp, w, GMP_RNDN); err = MPFR_GET_EXP (tmp) - MPFR_GET_EXP (v); /* 0 or 1 */ mpfr_clear (w); break; } mpfr_mul (u, u, v, GMP_RNDN); mpfr_sqrt (u, u, GMP_RNDN); mpfr_swap (v, tmp); n ++; } /* the error on v is bounded by (18n+51) ulps, or twice if there was an exponent loss in the final subtraction */ err += MPFR_INT_CEIL_LOG2(18 * n + 51); /* 18n+51 should not overflow since n is about log(p) */ /* we should have n+2 <= 2^(p/4) [see algorithms.tex] */ if (MPFR_LIKELY (MPFR_INT_CEIL_LOG2(n + 2) <= p / 4 && MPFR_CAN_ROUND (v, p - err, q, rnd_mode))) break; /* Stop the loop */ /* Next iteration */ MPFR_ZIV_NEXT (loop, p); s = (p - 1) / BITS_PER_MP_LIMB + 1; } MPFR_ZIV_FREE (loop); /* Setting of the result */ inexact = mpfr_set (r, v, rnd_mode); /* Let's clean */ MPFR_TMP_FREE(marker); return inexact; /* agm(u,v) can be exact for u, v rational only for u=v. Proof (due to Nicolas Brisebarre): it suffices to consider u=1 and v<1. Then 1/AGM(1,v) = 2F1(1/2,1/2,1;1-v^2), and a theorem due to G.V. Chudnovsky states that for x a non-zero algebraic number with |x|<1, then 2F1(1/2,1/2,1;x) and 2F1(-1/2,1/2,1;x) are algebraically independent over Q. */ }
static void check_special (void) { mpfr_t a, d, q; mpfr_exp_t emax, emin; int i; mpfr_init2 (a, 100L); mpfr_init2 (d, 100L); mpfr_init2 (q, 100L); /* 1/nan == nan */ mpfr_set_ui (a, 1L, MPFR_RNDN); MPFR_SET_NAN (d); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_NAN); /* nan/1 == nan */ MPFR_SET_NAN (a); mpfr_set_ui (d, 1L, MPFR_RNDN); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_NAN); /* +inf/1 == +inf */ MPFR_SET_INF (a); MPFR_SET_POS (a); mpfr_set_ui (d, 1L, MPFR_RNDN); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q)); MPFR_ASSERTN (mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* +inf/-1 == -inf */ MPFR_SET_INF (a); MPFR_SET_POS (a); mpfr_set_si (d, -1, MPFR_RNDN); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q)); MPFR_ASSERTN (mpfr_sgn (q) < 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* -inf/1 == -inf */ MPFR_SET_INF (a); MPFR_SET_NEG (a); mpfr_set_ui (d, 1L, MPFR_RNDN); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q)); MPFR_ASSERTN (mpfr_sgn (q) < 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* -inf/-1 == +inf */ MPFR_SET_INF (a); MPFR_SET_NEG (a); mpfr_set_si (d, -1, MPFR_RNDN); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q)); MPFR_ASSERTN (mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* 1/+inf == +0 */ mpfr_set_ui (a, 1L, MPFR_RNDN); MPFR_SET_INF (d); MPFR_SET_POS (d); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (q)); MPFR_ASSERTN (mpfr_sgn (q) == 0); MPFR_ASSERTN (MPFR_IS_POS (q)); MPFR_ASSERTN (__gmpfr_flags == 0); /* 1/-inf == -0 */ mpfr_set_ui (a, 1L, MPFR_RNDN); MPFR_SET_INF (d); MPFR_SET_NEG (d); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (q)); MPFR_ASSERTN (mpfr_sgn (q) == 0); MPFR_ASSERTN (MPFR_IS_NEG (q)); MPFR_ASSERTN (__gmpfr_flags == 0); /* -1/+inf == -0 */ mpfr_set_si (a, -1, MPFR_RNDN); MPFR_SET_INF (d); MPFR_SET_POS (d); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (q)); MPFR_ASSERTN (mpfr_sgn (q) == 0); MPFR_ASSERTN (MPFR_IS_NEG (q)); MPFR_ASSERTN (__gmpfr_flags == 0); /* -1/-inf == +0 */ mpfr_set_si (a, -1, MPFR_RNDN); MPFR_SET_INF (d); MPFR_SET_NEG (d); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_number_p (q)); MPFR_ASSERTN (mpfr_sgn (q) == 0); MPFR_ASSERTN (MPFR_IS_POS (q)); MPFR_ASSERTN (__gmpfr_flags == 0); /* 0/0 == nan */ mpfr_set_ui (a, 0L, MPFR_RNDN); mpfr_set_ui (d, 0L, MPFR_RNDN); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_NAN); /* +inf/+inf == nan */ MPFR_SET_INF (a); MPFR_SET_POS (a); MPFR_SET_INF (d); MPFR_SET_POS (d); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_NAN); /* 1/+0 = +inf */ mpfr_set_ui (a, 1, MPFR_RNDZ); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0); /* 1/-0 = -inf */ mpfr_set_ui (a, 1, MPFR_RNDZ); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_neg (d, d, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) < 0); MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0); /* -1/+0 = -inf */ mpfr_set_si (a, -1, MPFR_RNDZ); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) < 0); MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0); /* -1/-0 = +inf */ mpfr_set_si (a, -1, MPFR_RNDZ); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_neg (d, d, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == MPFR_FLAGS_DIVBY0); /* +inf/+0 = +inf */ MPFR_SET_INF (a); MPFR_SET_POS (a); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* +inf/-0 = -inf */ MPFR_SET_INF (a); MPFR_SET_POS (a); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_neg (d, d, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) < 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* -inf/+0 = -inf */ MPFR_SET_INF (a); MPFR_SET_NEG (a); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) < 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* -inf/-0 = +inf */ MPFR_SET_INF (a); MPFR_SET_NEG (a); mpfr_set_ui (d, 0, MPFR_RNDZ); mpfr_neg (d, d, MPFR_RNDZ); mpfr_clear_flags (); MPFR_ASSERTN (test_div (q, a, d, MPFR_RNDZ) == 0); /* exact */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == 0); /* check overflow */ emax = mpfr_get_emax (); set_emax (1); mpfr_set_ui (a, 1, MPFR_RNDZ); mpfr_set_ui (d, 1, MPFR_RNDZ); mpfr_div_2exp (d, d, 1, MPFR_RNDZ); mpfr_clear_flags (); test_div (q, a, d, MPFR_RNDU); /* 1 / 0.5 = 2 -> overflow */ MPFR_ASSERTN (mpfr_inf_p (q) && mpfr_sgn (q) > 0); MPFR_ASSERTN (__gmpfr_flags == (MPFR_FLAGS_OVERFLOW | MPFR_FLAGS_INEXACT)); set_emax (emax); /* check underflow */ emin = mpfr_get_emin (); set_emin (-1); mpfr_set_ui (a, 1, MPFR_RNDZ); mpfr_div_2exp (a, a, 2, MPFR_RNDZ); mpfr_set_prec (d, mpfr_get_prec (q) + 8); for (i = -1; i <= 1; i++) { int sign; /* Test 2^(-2) / (+/- (2 + eps)), with eps < 0, eps = 0, eps > 0. -> underflow. With div.c r5513, this test fails for eps > 0 in MPFR_RNDN. */ mpfr_set_ui (d, 2, MPFR_RNDZ); if (i < 0) mpfr_nextbelow (d); if (i > 0) mpfr_nextabove (d); for (sign = 0; sign <= 1; sign++) { mpfr_clear_flags (); test_div (q, a, d, MPFR_RNDZ); /* result = 0 */ MPFR_ASSERTN (__gmpfr_flags == (MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT)); MPFR_ASSERTN (sign ? MPFR_IS_NEG (q) : MPFR_IS_POS (q)); MPFR_ASSERTN (MPFR_IS_ZERO (q)); mpfr_clear_flags (); test_div (q, a, d, MPFR_RNDN); /* result = 0 iff eps >= 0 */ MPFR_ASSERTN (__gmpfr_flags == (MPFR_FLAGS_UNDERFLOW | MPFR_FLAGS_INEXACT)); MPFR_ASSERTN (sign ? MPFR_IS_NEG (q) : MPFR_IS_POS (q)); if (i < 0) mpfr_nexttozero (q); MPFR_ASSERTN (MPFR_IS_ZERO (q)); mpfr_neg (d, d, MPFR_RNDN); } } set_emin (emin); mpfr_clear (a); mpfr_clear (d); mpfr_clear (q); }
static void test_underflow1 (void) { mpfr_t x, y, z, r; int inex, signy, signz, rnd, err = 0; mpfr_inits2 (8, x, y, z, r, (void *) 0); MPFR_SET_POS (x); mpfr_setmin (x, mpfr_get_emin ()); /* x = 0.1@emin */ for (signy = -1; signy <= 1; signy += 2) { mpfr_set_si_2exp (y, signy, -1, GMP_RNDN); /* |y| = 1/2 */ for (signz = -3; signz <= 3; signz += 2) { RND_LOOP (rnd) { mpfr_set_si (z, signz, GMP_RNDN); if (ABS (signz) != 1) mpfr_setmax (z, mpfr_get_emax ()); /* |z| = 1 or 2^emax - ulp */ mpfr_clear_flags (); inex = mpfr_fma (r, x, y, z, rnd); #define ERRTU1 "Error in test_underflow1 (signy = %d, signz = %d, %s)\n " if (mpfr_nanflag_p ()) { printf (ERRTU1 "NaN flag is set\n", signy, signz, mpfr_print_rnd_mode (rnd)); err = 1; } if (signy < 0 && (rnd == GMP_RNDD || (rnd == GMP_RNDZ && signz > 0))) mpfr_nextbelow (z); if (signy > 0 && (rnd == GMP_RNDU || (rnd == GMP_RNDZ && signz < 0))) mpfr_nextabove (z); if ((mpfr_overflow_p () != 0) ^ (mpfr_inf_p (z) != 0)) { printf (ERRTU1 "wrong overflow flag\n", signy, signz, mpfr_print_rnd_mode (rnd)); err = 1; } if (mpfr_underflow_p ()) { printf (ERRTU1 "underflow flag is set\n", signy, signz, mpfr_print_rnd_mode (rnd)); err = 1; } if (! mpfr_equal_p (r, z)) { printf (ERRTU1 "got ", signy, signz, mpfr_print_rnd_mode (rnd)); mpfr_print_binary (r); printf (" instead of "); mpfr_print_binary (z); printf ("\n"); err = 1; } if (inex >= 0 && (rnd == GMP_RNDD || (rnd == GMP_RNDZ && signz > 0) || (rnd == GMP_RNDN && signy > 0))) { printf (ERRTU1 "ternary value = %d instead of < 0\n", signy, signz, mpfr_print_rnd_mode (rnd), inex); err = 1; } if (inex <= 0 && (rnd == GMP_RNDU || (rnd == GMP_RNDZ && signz < 0) || (rnd == GMP_RNDN && signy < 0))) { printf (ERRTU1 "ternary value = %d instead of > 0\n", signy, signz, mpfr_print_rnd_mode (rnd), inex); err = 1; } } } } if (err) exit (1); mpfr_clears (x, y, z, r, (void *) 0); }
static void test_overflow2 (void) { mpfr_t x, y, z, r; int i, inex, rnd, err = 0; mpfr_inits2 (8, x, y, z, r, (void *) 0); MPFR_SET_POS (x); mpfr_setmin (x, mpfr_get_emax ()); /* x = 0.1@emax */ mpfr_set_si (y, -2, GMP_RNDN); /* y = -2 */ /* The intermediate multiplication x * y will overflow. */ for (i = -9; i <= 9; i++) RND_LOOP (rnd) { int inf, overflow; inf = rnd == GMP_RNDN || rnd == GMP_RNDD; overflow = inf || i <= 0; inex = mpfr_set_si_2exp (z, i, mpfr_get_emin (), GMP_RNDN); MPFR_ASSERTN (inex == 0); mpfr_clear_flags (); /* One has: x * y = -1@emax exactly (but not representable). */ inex = mpfr_fma (r, x, y, z, rnd); if (overflow ^ (mpfr_overflow_p () != 0)) { printf ("Error in test_overflow2 (i = %d, %s): wrong overflow" " flag (should be %d)\n", i, mpfr_print_rnd_mode (rnd), overflow); err = 1; } if (mpfr_nanflag_p ()) { printf ("Error in test_overflow2 (i = %d, %s): NaN flag should" " not be set\n", i, mpfr_print_rnd_mode (rnd)); err = 1; } if (mpfr_nan_p (r)) { printf ("Error in test_overflow2 (i = %d, %s): got NaN\n", i, mpfr_print_rnd_mode (rnd)); err = 1; } else if (MPFR_SIGN (r) >= 0) { printf ("Error in test_overflow2 (i = %d, %s): wrong sign " "(+ instead of -)\n", i, mpfr_print_rnd_mode (rnd)); err = 1; } else if (inf && ! mpfr_inf_p (r)) { printf ("Error in test_overflow2 (i = %d, %s): expected -Inf," " got\n", i, mpfr_print_rnd_mode (rnd)); mpfr_dump (r); err = 1; } else if (!inf && (mpfr_inf_p (r) || (mpfr_nextbelow (r), ! mpfr_inf_p (r)))) { printf ("Error in test_overflow2 (i = %d, %s): expected -MAX," " got\n", i, mpfr_print_rnd_mode (rnd)); mpfr_dump (r); err = 1; } if (inf ? inex >= 0 : inex <= 0) { printf ("Error in test_overflow2 (i = %d, %s): wrong inexact" " flag (got %d)\n", i, mpfr_print_rnd_mode (rnd), inex); err = 1; } } if (err) exit (1); mpfr_clears (x, y, z, r, (void *) 0); }
static void check_cmp (int argc, char *argv[]) { mpfr_t x, y; int n, k; mpfr_inits2 (53, x, y, (mpfr_ptr) 0); mpfr_set_ui(x, 1, MPFR_RNDN); (mpfr_abs) (x, x, MPFR_RNDN); if (mpfr_cmp_ui (x, 1)) { printf ("Error in mpfr_abs(1.0)\n"); exit (1); } mpfr_set_si(x, -1, MPFR_RNDN); mpfr_abs(x, x, MPFR_RNDN); if (mpfr_cmp_ui (x, 1)) { printf ("Error in mpfr_abs(1.0)\n"); exit (1); } mpfr_set_si(x, -1, MPFR_RNDN); mpfr_abs(x, x, MPFR_RNDN); if (mpfr_cmp_ui (x, 1)) { printf ("Error in mpfr_abs(-1.0)\n"); exit (1); } mpfr_set_inf (x, 1); mpfr_abs (x, x, MPFR_RNDN); if (!mpfr_inf_p(x) || (mpfr_sgn(x) <= 0)) { printf ("Error in mpfr_abs(Inf).\n"); exit (1); } mpfr_set_inf (x, -1); mpfr_abs (x, x, MPFR_RNDN); if (!mpfr_inf_p(x) || (mpfr_sgn(x) <= 0)) { printf ("Error in mpfr_abs(-Inf).\n"); exit (1); } MPFR_SET_NAN(x); mpfr_abs (x, x, MPFR_RNDN); if (!MPFR_IS_NAN(x)) { printf ("Error in mpfr_abs(NAN).\n"); exit (1); } n = (argc==1) ? 25000 : atoi(argv[1]); for (k = 1; k <= n; k++) { mpfr_rnd_t rnd; int sign = SIGN_RAND (); mpfr_urandomb (x, RANDS); MPFR_SET_SIGN (x, sign); rnd = RND_RAND (); mpfr_abs (y, x, rnd); MPFR_SET_POS (x); if (mpfr_cmp (x, y)) { printf ("Mismatch for sign=%d and x=", sign); mpfr_print_binary (x); printf ("\nResults="); mpfr_print_binary (y); putchar ('\n'); exit (1); } } mpfr_clears (x, y, (mpfr_ptr) 0); }
/* We use the reflection formula Gamma(1+t) Gamma(1-t) = - Pi t / sin(Pi (1 + t)) in order to treat the case x <= 1, i.e. with x = 1-t, then Gamma(x) = -Pi*(1-x)/sin(Pi*(2-x))/GAMMA(2-x) */ int mpfr_gamma (mpfr_ptr gamma, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { mpfr_t xp, GammaTrial, tmp, tmp2; mpz_t fact; mpfr_prec_t realprec; int compared, is_integer; int inex = 0; /* 0 means: result gamma not set yet */ MPFR_GROUP_DECL (group); 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), ("gamma[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (gamma), mpfr_log_prec, gamma, inex)); /* Trivial cases */ if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (gamma); MPFR_RET_NAN; } else if (MPFR_IS_INF (x)) { if (MPFR_IS_NEG (x)) { MPFR_SET_NAN (gamma); MPFR_RET_NAN; } else { MPFR_SET_INF (gamma); MPFR_SET_POS (gamma); MPFR_RET (0); /* exact */ } } else /* x is zero */ { MPFR_ASSERTD(MPFR_IS_ZERO(x)); MPFR_SET_INF(gamma); MPFR_SET_SAME_SIGN(gamma, x); MPFR_SET_DIVBY0 (); MPFR_RET (0); /* exact */ } } /* Check for tiny arguments, where gamma(x) ~ 1/x - euler + .... We know from "Bound on Runs of Zeros and Ones for Algebraic Functions", Proceedings of Arith15, T. Lang and J.-M. Muller, 2001, that the maximal number of consecutive zeroes or ones after the round bit is n-1 for an input of n bits. But we need a more precise lower bound. Assume x has n bits, and 1/x is near a floating-point number y of n+1 bits. We can write x = X*2^e, y = Y/2^f with X, Y integers of n and n+1 bits. Thus X*Y^2^(e-f) is near from 1, i.e., X*Y is near from 2^(f-e). Two cases can happen: (i) either X*Y is exactly 2^(f-e), but this can happen only if X and Y are themselves powers of two, i.e., x is a power of two; (ii) or X*Y is at distance at least one from 2^(f-e), thus |xy-1| >= 2^(e-f), or |y-1/x| >= 2^(e-f)/x = 2^(-f)/X >= 2^(-f-n). Since ufp(y) = 2^(n-f) [ufp = unit in first place], this means that the distance |y-1/x| >= 2^(-2n) ufp(y). Now assuming |gamma(x)-1/x| <= 1, which is true for x <= 1, if 2^(-2n) ufp(y) >= 2, the error is at most 2^(-2n-1) ufp(y), and round(1/x) with precision >= 2n+2 gives the correct result. If x < 2^E, then y > 2^(-E), thus ufp(y) > 2^(-E-1). A sufficient condition is thus EXP(x) + 2 <= -2 MAX(PREC(x),PREC(Y)). */ if (MPFR_GET_EXP (x) + 2 <= -2 * (mpfr_exp_t) MAX(MPFR_PREC(x), MPFR_PREC(gamma))) { int sign = MPFR_SIGN (x); /* retrieve sign before possible override */ int special; MPFR_BLOCK_DECL (flags); MPFR_SAVE_EXPO_MARK (expo); /* for overflow cases, see below; this needs to be done before x possibly gets overridden. */ special = MPFR_GET_EXP (x) == 1 - MPFR_EMAX_MAX && MPFR_IS_POS_SIGN (sign) && MPFR_IS_LIKE_RNDD (rnd_mode, sign) && mpfr_powerof2_raw (x); MPFR_BLOCK (flags, inex = mpfr_ui_div (gamma, 1, x, rnd_mode)); if (inex == 0) /* x is a power of two */ { /* return RND(1/x - euler) = RND(+/- 2^k - eps) with eps > 0 */ if (rnd_mode == MPFR_RNDN || MPFR_IS_LIKE_RNDU (rnd_mode, sign)) inex = 1; else { mpfr_nextbelow (gamma); inex = -1; } } else if (MPFR_UNLIKELY (MPFR_OVERFLOW (flags))) { /* Overflow in the division 1/x. This is a real overflow, except in RNDZ or RNDD when 1/x = 2^emax, i.e. x = 2^(-emax): due to the "- euler", the rounded value in unbounded exponent range is 0.111...11 * 2^emax (not an overflow). */ if (!special) MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, flags); } MPFR_SAVE_EXPO_FREE (expo); /* Note: an overflow is possible with an infinite result; in this case, the overflow flag will automatically be restored by mpfr_check_range. */ return mpfr_check_range (gamma, inex, rnd_mode); } is_integer = mpfr_integer_p (x); /* gamma(x) for x a negative integer gives NaN */ if (is_integer && MPFR_IS_NEG(x)) { MPFR_SET_NAN (gamma); MPFR_RET_NAN; } compared = mpfr_cmp_ui (x, 1); if (compared == 0) return mpfr_set_ui (gamma, 1, rnd_mode); /* if x is an integer that fits into an unsigned long, use mpfr_fac_ui if argument is not too large. If precision is p, fac_ui costs O(u*p), whereas gamma costs O(p*M(p)), so for u <= M(p), fac_ui should be faster. We approximate here M(p) by p*log(p)^2, which is not a bad guess. Warning: since the generic code does not handle exact cases, we want all cases where gamma(x) is exact to be treated here. */ if (is_integer && mpfr_fits_ulong_p (x, MPFR_RNDN)) { unsigned long int u; mpfr_prec_t p = MPFR_PREC(gamma); u = mpfr_get_ui (x, MPFR_RNDN); if (u < 44787929UL && bits_fac (u - 1) <= p + (rnd_mode == MPFR_RNDN)) /* bits_fac: lower bound on the number of bits of m, where gamma(x) = (u-1)! = m*2^e with m odd. */ return mpfr_fac_ui (gamma, u - 1, rnd_mode); /* if bits_fac(...) > p (resp. p+1 for rounding to nearest), then gamma(x) cannot be exact in precision p (resp. p+1). FIXME: remove the test u < 44787929UL after changing bits_fac to return a mpz_t or mpfr_t. */ } MPFR_SAVE_EXPO_MARK (expo); /* check for overflow: according to (6.1.37) in Abramowitz & Stegun, gamma(x) >= exp(-x) * x^(x-1/2) * sqrt(2*Pi) >= 2 * (x/e)^x / x for x >= 1 */ if (compared > 0) { mpfr_t yp; mpfr_exp_t expxp; MPFR_BLOCK_DECL (flags); /* quick test for the default exponent range */ if (mpfr_get_emax () >= 1073741823UL && MPFR_GET_EXP(x) <= 25) { MPFR_SAVE_EXPO_FREE (expo); return mpfr_gamma_aux (gamma, x, rnd_mode); } /* 1/e rounded down to 53 bits */ #define EXPM1_STR "0.010111100010110101011000110110001011001110111100111" mpfr_init2 (xp, 53); mpfr_init2 (yp, 53); mpfr_set_str_binary (xp, EXPM1_STR); mpfr_mul (xp, x, xp, MPFR_RNDZ); mpfr_sub_ui (yp, x, 2, MPFR_RNDZ); mpfr_pow (xp, xp, yp, MPFR_RNDZ); /* (x/e)^(x-2) */ mpfr_set_str_binary (yp, EXPM1_STR); mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^(x-1) */ mpfr_mul (xp, xp, yp, MPFR_RNDZ); /* x^(x-2) / e^x */ mpfr_mul (xp, xp, x, MPFR_RNDZ); /* lower bound on x^(x-1) / e^x */ MPFR_BLOCK (flags, mpfr_mul_2ui (xp, xp, 1, MPFR_RNDZ)); expxp = MPFR_GET_EXP (xp); mpfr_clear (xp); mpfr_clear (yp); MPFR_SAVE_EXPO_FREE (expo); return MPFR_OVERFLOW (flags) || expxp > __gmpfr_emax ? mpfr_overflow (gamma, rnd_mode, 1) : mpfr_gamma_aux (gamma, x, rnd_mode); } /* now compared < 0 */ /* check for underflow: for x < 1, gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x). Since gamma(2-x) >= 2 * ((2-x)/e)^(2-x) / (2-x), we have |gamma(x)| <= Pi*(1-x)*(2-x)/2/((2-x)/e)^(2-x) / |sin(Pi*(2-x))| <= 12 * ((2-x)/e)^x / |sin(Pi*(2-x))|. To avoid an underflow in ((2-x)/e)^x, we compute the logarithm. */ if (MPFR_IS_NEG(x)) { int underflow = 0, sgn, ck; mpfr_prec_t w; mpfr_init2 (xp, 53); mpfr_init2 (tmp, 53); mpfr_init2 (tmp2, 53); /* we want an upper bound for x * [log(2-x)-1]. since x < 0, we need a lower bound on log(2-x) */ mpfr_ui_sub (xp, 2, x, MPFR_RNDD); mpfr_log (xp, xp, MPFR_RNDD); mpfr_sub_ui (xp, xp, 1, MPFR_RNDD); mpfr_mul (xp, xp, x, MPFR_RNDU); /* we need an upper bound on 1/|sin(Pi*(2-x))|, thus a lower bound on |sin(Pi*(2-x))|. If 2-x is exact, then the error of Pi*(2-x) is (1+u)^2 with u = 2^(-p) thus the error on sin(Pi*(2-x)) is less than 1/2ulp + 3Pi(2-x)u, assuming u <= 1, thus <= u + 3Pi(2-x)u */ w = mpfr_gamma_2_minus_x_exact (x); /* 2-x is exact for prec >= w */ w += 17; /* to get tmp2 small enough */ mpfr_set_prec (tmp, w); mpfr_set_prec (tmp2, w); MPFR_DBGRES (ck = mpfr_ui_sub (tmp, 2, x, MPFR_RNDN)); MPFR_ASSERTD (ck == 0); /* tmp = 2-x exactly */ mpfr_const_pi (tmp2, MPFR_RNDN); mpfr_mul (tmp2, tmp2, tmp, MPFR_RNDN); /* Pi*(2-x) */ mpfr_sin (tmp, tmp2, MPFR_RNDN); /* sin(Pi*(2-x)) */ sgn = mpfr_sgn (tmp); mpfr_abs (tmp, tmp, MPFR_RNDN); mpfr_mul_ui (tmp2, tmp2, 3, MPFR_RNDU); /* 3Pi(2-x) */ mpfr_add_ui (tmp2, tmp2, 1, MPFR_RNDU); /* 3Pi(2-x)+1 */ mpfr_div_2ui (tmp2, tmp2, mpfr_get_prec (tmp), MPFR_RNDU); /* if tmp2<|tmp|, we get a lower bound */ if (mpfr_cmp (tmp2, tmp) < 0) { mpfr_sub (tmp, tmp, tmp2, MPFR_RNDZ); /* low bnd on |sin(Pi*(2-x))| */ mpfr_ui_div (tmp, 12, tmp, MPFR_RNDU); /* upper bound */ mpfr_log2 (tmp, tmp, MPFR_RNDU); mpfr_add (xp, tmp, xp, MPFR_RNDU); /* The assert below checks that expo.saved_emin - 2 always fits in a long. FIXME if we want to allow mpfr_exp_t to be a long long, for instance. */ MPFR_ASSERTN (MPFR_EMIN_MIN - 2 >= LONG_MIN); underflow = mpfr_cmp_si (xp, expo.saved_emin - 2) <= 0; } mpfr_clear (xp); mpfr_clear (tmp); mpfr_clear (tmp2); if (underflow) /* the sign is the opposite of that of sin(Pi*(2-x)) */ { MPFR_SAVE_EXPO_FREE (expo); return mpfr_underflow (gamma, (rnd_mode == MPFR_RNDN) ? MPFR_RNDZ : rnd_mode, -sgn); } } realprec = MPFR_PREC (gamma); /* we want both 1-x and 2-x to be exact */ { mpfr_prec_t w; w = mpfr_gamma_1_minus_x_exact (x); if (realprec < w) realprec = w; w = mpfr_gamma_2_minus_x_exact (x); if (realprec < w) realprec = w; } realprec = realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20; MPFR_ASSERTD(realprec >= 5); MPFR_GROUP_INIT_4 (group, realprec + MPFR_INT_CEIL_LOG2 (realprec) + 20, xp, tmp, tmp2, GammaTrial); mpz_init (fact); MPFR_ZIV_INIT (loop, realprec); for (;;) { mpfr_exp_t err_g; int ck; MPFR_GROUP_REPREC_4 (group, realprec, xp, tmp, tmp2, GammaTrial); /* reflection formula: gamma(x) = Pi*(x-1)/sin(Pi*(2-x))/gamma(2-x) */ ck = mpfr_ui_sub (xp, 2, x, MPFR_RNDN); /* 2-x, exact */ MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */ mpfr_gamma (tmp, xp, MPFR_RNDN); /* gamma(2-x), error (1+u) */ mpfr_const_pi (tmp2, MPFR_RNDN); /* Pi, error (1+u) */ mpfr_mul (GammaTrial, tmp2, xp, MPFR_RNDN); /* Pi*(2-x), error (1+u)^2 */ err_g = MPFR_GET_EXP(GammaTrial); mpfr_sin (GammaTrial, GammaTrial, MPFR_RNDN); /* sin(Pi*(2-x)) */ /* If tmp is +Inf, we compute exp(lngamma(x)). */ if (mpfr_inf_p (tmp)) { inex = mpfr_explgamma (gamma, x, &expo, tmp, tmp2, rnd_mode); if (inex) goto end; else goto ziv_next; } err_g = err_g + 1 - MPFR_GET_EXP(GammaTrial); /* let g0 the true value of Pi*(2-x), g the computed value. We have g = g0 + h with |h| <= |(1+u^2)-1|*g. Thus sin(g) = sin(g0) + h' with |h'| <= |(1+u^2)-1|*g. The relative error is thus bounded by |(1+u^2)-1|*g/sin(g) <= |(1+u^2)-1|*2^err_g. <= 2.25*u*2^err_g for |u|<=1/4. With the rounding error, this gives (0.5 + 2.25*2^err_g)*u. */ ck = mpfr_sub_ui (xp, x, 1, MPFR_RNDN); /* x-1, exact */ MPFR_ASSERTD(ck == 0); (void) ck; /* use ck to avoid a warning */ mpfr_mul (xp, tmp2, xp, MPFR_RNDN); /* Pi*(x-1), error (1+u)^2 */ mpfr_mul (GammaTrial, GammaTrial, tmp, MPFR_RNDN); /* [1 + (0.5 + 2.25*2^err_g)*u]*(1+u)^2 = 1 + (2.5 + 2.25*2^err_g)*u + (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2. For err_g <= realprec-2, we have (0.5 + 2.25*2^err_g)*u <= 0.5*u + 2.25/4 <= 0.6875 and u^2 <= u/4, thus (0.5 + 2.25*2^err_g)*u*(2u+u^2) + u^2 <= 0.6875*(2u+u/4) + u/4 <= 1.8*u, thus the rel. error is bounded by (4.5 + 2.25*2^err_g)*u. */ mpfr_div (GammaTrial, xp, GammaTrial, MPFR_RNDN); /* the error is of the form (1+u)^3/[1 + (4.5 + 2.25*2^err_g)*u]. For realprec >= 5 and err_g <= realprec-2, [(4.5 + 2.25*2^err_g)*u]^2 <= 0.71, and for |y|<=0.71, 1/(1-y) can be written 1+a*y with a<=4. (1+u)^3 * (1+4*(4.5 + 2.25*2^err_g)*u) = 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (55+27*2^err_g)*u^3 + (18+9*2^err_g)*u^4 <= 1 + (21 + 9*2^err_g)*u + (57+27*2^err_g)*u^2 + (56+28*2^err_g)*u^3 <= 1 + (21 + 9*2^err_g)*u + (59+28*2^err_g)*u^2 <= 1 + (23 + 10*2^err_g)*u. The final error is thus bounded by (23 + 10*2^err_g) ulps, which is <= 2^6 for err_g<=2, and <= 2^(err_g+4) for err_g >= 2. */ err_g = (err_g <= 2) ? 6 : err_g + 4; if (MPFR_LIKELY (MPFR_CAN_ROUND (GammaTrial, realprec - err_g, MPFR_PREC(gamma), rnd_mode))) break; ziv_next: MPFR_ZIV_NEXT (loop, realprec); } end: MPFR_ZIV_FREE (loop); if (inex == 0) inex = mpfr_set (gamma, GammaTrial, rnd_mode); MPFR_GROUP_CLEAR (group); mpz_clear (fact); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (gamma, inex, rnd_mode); }
int mpfr_sub1sp (mpfr_ptr a, mpfr_srcptr b, mpfr_srcptr c, mpfr_rnd_t rnd_mode) { mpfr_exp_t bx,cx; mpfr_uexp_t d; mpfr_prec_t p, sh, cnt; mp_size_t n; mp_limb_t *ap, *bp, *cp; mp_limb_t limb; int inexact; mp_limb_t bcp,bcp1; /* Cp and C'p+1 */ mp_limb_t bbcp = (mp_limb_t) -1, bbcp1 = (mp_limb_t) -1; /* Cp+1 and C'p+2, gcc claims that they might be used uninitialized. We fill them with invalid values, which should produce a failure if so. See README.dev file. */ MPFR_TMP_DECL(marker); MPFR_TMP_MARK(marker); MPFR_ASSERTD(MPFR_PREC(a) == MPFR_PREC(b) && MPFR_PREC(b) == MPFR_PREC(c)); MPFR_ASSERTD(MPFR_IS_PURE_FP(b)); MPFR_ASSERTD(MPFR_IS_PURE_FP(c)); /* Read prec and num of limbs */ p = MPFR_PREC (b); n = MPFR_PREC2LIMBS (p); /* Fast cmp of |b| and |c|*/ bx = MPFR_GET_EXP (b); cx = MPFR_GET_EXP (c); if (MPFR_UNLIKELY(bx == cx)) { mp_size_t k = n - 1; /* Check mantissa since exponent are equals */ bp = MPFR_MANT(b); cp = MPFR_MANT(c); while (k>=0 && MPFR_UNLIKELY(bp[k] == cp[k])) k--; if (MPFR_UNLIKELY(k < 0)) /* b == c ! */ { /* Return exact number 0 */ if (rnd_mode == MPFR_RNDD) MPFR_SET_NEG(a); else MPFR_SET_POS(a); MPFR_SET_ZERO(a); MPFR_RET(0); } else if (bp[k] > cp[k]) goto BGreater; else { MPFR_ASSERTD(bp[k]<cp[k]); goto CGreater; } } else if (MPFR_UNLIKELY(bx < cx)) { /* Swap b and c and set sign */ mpfr_srcptr t; mpfr_exp_t tx; CGreater: MPFR_SET_OPPOSITE_SIGN(a,b); t = b; b = c; c = t; tx = bx; bx = cx; cx = tx; } else { /* b > c */ BGreater: MPFR_SET_SAME_SIGN(a,b); } /* Now b > c */ MPFR_ASSERTD(bx >= cx); d = (mpfr_uexp_t) bx - cx; DEBUG (printf ("New with diff=%lu\n", (unsigned long) d)); if (MPFR_UNLIKELY(d <= 1)) { if (MPFR_LIKELY(d < 1)) { /* <-- b --> <-- c --> : exact sub */ ap = MPFR_MANT(a); mpn_sub_n (ap, MPFR_MANT(b), MPFR_MANT(c), n); /* Normalize */ ExactNormalize: limb = ap[n-1]; if (MPFR_LIKELY(limb)) { /* First limb is not zero. */ count_leading_zeros(cnt, limb); /* cnt could be == 0 <= SubD1Lose */ if (MPFR_LIKELY(cnt)) { mpn_lshift(ap, ap, n, cnt); /* Normalize number */ bx -= cnt; /* Update final expo */ } /* Last limb should be ok */ MPFR_ASSERTD(!(ap[0] & MPFR_LIMB_MASK((unsigned int) (-p) % GMP_NUMB_BITS))); } else { /* First limb is zero */ mp_size_t k = n-1, len; /* Find the first limb not equal to zero. FIXME:It is assume it exists (since |b| > |c| and same prec)*/ do { MPFR_ASSERTD( k > 0 ); limb = ap[--k]; } while (limb == 0); MPFR_ASSERTD(limb != 0); count_leading_zeros(cnt, limb); k++; len = n - k; /* Number of last limb */ MPFR_ASSERTD(k >= 0); if (MPFR_LIKELY(cnt)) mpn_lshift(ap+len, ap, k, cnt); /* Normalize the High Limb*/ else { /* Must use DECR since src and dest may overlap & dest>=src*/ MPN_COPY_DECR(ap+len, ap, k); } MPN_ZERO(ap, len); /* Zeroing the last limbs */ bx -= cnt + len*GMP_NUMB_BITS; /* Update Expo */ /* Last limb should be ok */ MPFR_ASSERTD(!(ap[len]&MPFR_LIMB_MASK((unsigned int) (-p) % GMP_NUMB_BITS))); } /* Check expo underflow */ if (MPFR_UNLIKELY(bx < __gmpfr_emin)) { MPFR_TMP_FREE(marker); /* inexact=0 */ DEBUG( printf("(D==0 Underflow)\n") ); if (rnd_mode == MPFR_RNDN && (bx < __gmpfr_emin - 1 || (/*inexact >= 0 &&*/ mpfr_powerof2_raw (a)))) rnd_mode = MPFR_RNDZ; return mpfr_underflow (a, rnd_mode, MPFR_SIGN(a)); } MPFR_SET_EXP (a, bx); /* No rounding is necessary since the result is exact */ MPFR_ASSERTD(ap[n-1] > ~ap[n-1]); MPFR_TMP_FREE(marker); return 0; } else /* if (d == 1) */ { /* | <-- b --> | <-- c --> */ mp_limb_t c0, mask; mp_size_t k; MPFR_UNSIGNED_MINUS_MODULO(sh, p); /* If we lose at least one bit, compute 2*b-c (Exact) * else compute b-c/2 */ bp = MPFR_MANT(b); cp = MPFR_MANT(c); k = n-1; limb = bp[k] - cp[k]/2; if (limb > MPFR_LIMB_HIGHBIT) { /* We can't lose precision: compute b-c/2 */ /* Shift c in the allocated temporary block */ SubD1NoLose: c0 = cp[0] & (MPFR_LIMB_ONE<<sh); cp = MPFR_TMP_LIMBS_ALLOC (n); mpn_rshift(cp, MPFR_MANT(c), n, 1); if (MPFR_LIKELY(c0 == 0)) { /* Result is exact: no need of rounding! */ ap = MPFR_MANT(a); mpn_sub_n (ap, bp, cp, n); MPFR_SET_EXP(a, bx); /* No expo overflow! */ /* No truncate or normalize is needed */ MPFR_ASSERTD(ap[n-1] > ~ap[n-1]); /* No rounding is necessary since the result is exact */ MPFR_TMP_FREE(marker); return 0; } ap = MPFR_MANT(a); mask = ~MPFR_LIMB_MASK(sh); cp[0] &= mask; /* Delete last bit of c */ mpn_sub_n (ap, bp, cp, n); MPFR_SET_EXP(a, bx); /* No expo overflow! */ MPFR_ASSERTD( !(ap[0] & ~mask) ); /* Check last bits */ /* No normalize is needed */ MPFR_ASSERTD(ap[n-1] > ~ap[n-1]); /* Rounding is necessary since c0 = 1*/ /* Cp =-1 and C'p+1=0 */ bcp = 1; bcp1 = 0; if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { /* Even Rule apply: Check Ap-1 */ if (MPFR_LIKELY( (ap[0] & (MPFR_LIMB_ONE<<sh)) == 0) ) goto truncate; else goto sub_one_ulp; } MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ) goto sub_one_ulp; else goto truncate; } else if (MPFR_LIKELY(limb < MPFR_LIMB_HIGHBIT)) { /* We lose at least one bit of prec */ /* Calcul of 2*b-c (Exact) */ /* Shift b in the allocated temporary block */ SubD1Lose: bp = MPFR_TMP_LIMBS_ALLOC (n); mpn_lshift (bp, MPFR_MANT(b), n, 1); ap = MPFR_MANT(a); mpn_sub_n (ap, bp, cp, n); bx--; goto ExactNormalize; } else { /* Case: limb = 100000000000 */ /* Check while b[k] == c'[k] (C' is C shifted by 1) */ /* If b[k]<c'[k] => We lose at least one bit*/ /* If b[k]>c'[k] => We don't lose any bit */ /* If k==-1 => We don't lose any bit AND the result is 100000000000 0000000000 00000000000 */ mp_limb_t carry; do { carry = cp[k]&MPFR_LIMB_ONE; k--; } while (k>=0 && bp[k]==(carry=cp[k]/2+(carry<<(GMP_NUMB_BITS-1)))); if (MPFR_UNLIKELY(k<0)) { /*If carry then (sh==0 and Virtual c'[-1] > Virtual b[-1]) */ if (MPFR_UNLIKELY(carry)) /* carry = cp[0]&MPFR_LIMB_ONE */ { /* FIXME: Can be faster? */ MPFR_ASSERTD(sh == 0); goto SubD1Lose; } /* Result is a power of 2 */ ap = MPFR_MANT (a); MPN_ZERO (ap, n); ap[n-1] = MPFR_LIMB_HIGHBIT; MPFR_SET_EXP (a, bx); /* No expo overflow! */ /* No Normalize is needed*/ /* No Rounding is needed */ MPFR_TMP_FREE (marker); return 0; } /* carry = cp[k]/2+(cp[k-1]&1)<<(GMP_NUMB_BITS-1) = c'[k]*/ else if (bp[k] > carry) goto SubD1NoLose; else { MPFR_ASSERTD(bp[k]<carry); goto SubD1Lose; } } } } else if (MPFR_UNLIKELY(d >= p)) { ap = MPFR_MANT(a); MPFR_UNSIGNED_MINUS_MODULO(sh, p); /* We can't set A before since we use cp for rounding... */ /* Perform rounding: check if a=b or a=b-ulp(b) */ if (MPFR_UNLIKELY(d == p)) { /* cp == -1 and c'p+1 = ? */ bcp = 1; /* We need Cp+1 later for a very improbable case. */ bbcp = (MPFR_MANT(c)[n-1] & (MPFR_LIMB_ONE<<(GMP_NUMB_BITS-2))); /* We need also C'p+1 for an even more unprobable case... */ if (MPFR_LIKELY( bbcp )) bcp1 = 1; else { cp = MPFR_MANT(c); if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && cp[k]==0); bcp1 = (k>=0); } else bcp1 = 1; } DEBUG( printf("(D=P) Cp=-1 Cp+1=%d C'p+1=%d \n", bbcp!=0, bcp1!=0) ); bp = MPFR_MANT (b); /* Even if src and dest overlap, it is ok using MPN_COPY */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { if (MPFR_UNLIKELY( bcp && bcp1==0 )) /* Cp=-1 and C'p+1=0: Even rule Apply! */ /* Check Ap-1 = Bp-1 */ if ((bp[0] & (MPFR_LIMB_ONE<<sh)) == 0) { MPN_COPY(ap, bp, n); goto truncate; } MPN_COPY(ap, bp, n); goto sub_one_ulp; } MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ) { MPN_COPY(ap, bp, n); goto sub_one_ulp; } else { MPN_COPY(ap, bp, n); goto truncate; } } else { /* Cp=0, Cp+1=-1 if d==p+1, C'p+1=-1 */ bcp = 0; bbcp = (d==p+1); bcp1 = 1; DEBUG( printf("(D>P) Cp=%d Cp+1=%d C'p+1=%d\n", bcp!=0,bbcp!=0,bcp1!=0) ); /* Need to compute C'p+2 if d==p+1 and if rnd_mode=NEAREST (Because of a very improbable case) */ if (MPFR_UNLIKELY(d==p+1 && rnd_mode==MPFR_RNDN)) { cp = MPFR_MANT(c); if (MPFR_UNLIKELY(cp[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && cp[k]==0); bbcp1 = (k>=0); } else bbcp1 = 1; DEBUG( printf("(D>P) C'p+2=%d\n", bbcp1!=0) ); } /* Copy mantissa B in A */ MPN_COPY(ap, MPFR_MANT(b), n); /* Round */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) goto truncate; MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ) goto sub_one_ulp; else /* rnd_mode = AWAY */ goto truncate; } } else { mpfr_uexp_t dm; mp_size_t m; mp_limb_t mask; /* General case: 2 <= d < p */ MPFR_UNSIGNED_MINUS_MODULO(sh, p); cp = MPFR_TMP_LIMBS_ALLOC (n); /* Shift c in temporary allocated place */ dm = d % GMP_NUMB_BITS; m = d / GMP_NUMB_BITS; if (MPFR_UNLIKELY(dm == 0)) { /* dm = 0 and m > 0: Just copy */ MPFR_ASSERTD(m!=0); MPN_COPY(cp, MPFR_MANT(c)+m, n-m); MPN_ZERO(cp+n-m, m); } else if (MPFR_LIKELY(m == 0)) { /* dm >=2 and m == 0: just shift */ MPFR_ASSERTD(dm >= 2); mpn_rshift(cp, MPFR_MANT(c), n, dm); } else { /* dm > 0 and m > 0: shift and zero */ mpn_rshift(cp, MPFR_MANT(c)+m, n-m, dm); MPN_ZERO(cp+n-m, m); } DEBUG( mpfr_print_mant_binary("Before", MPFR_MANT(c), p) ); DEBUG( mpfr_print_mant_binary("B= ", MPFR_MANT(b), p) ); DEBUG( mpfr_print_mant_binary("After ", cp, p) ); /* Compute bcp=Cp and bcp1=C'p+1 */ if (MPFR_LIKELY(sh)) { /* Try to compute them from C' rather than C (FIXME: Faster?) */ bcp = (cp[0] & (MPFR_LIMB_ONE<<(sh-1))) ; if (MPFR_LIKELY( cp[0] & MPFR_LIMB_MASK(sh-1) )) bcp1 = 1; else { /* We can't compute C'p+1 from C'. Compute it from C */ /* Start from bit x=p-d+sh in mantissa C (+sh since we have already looked sh bits in C'!) */ mpfr_prec_t x = p-d+sh-1; if (MPFR_LIKELY(x>p)) /* We are already looked at all the bits of c, so C'p+1 = 0*/ bcp1 = 0; else { mp_limb_t *tp = MPFR_MANT(c); mp_size_t kx = n-1 - (x / GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); DEBUG (printf ("(First) x=%lu Kx=%ld Sx=%lu\n", (unsigned long) x, (long) kx, (unsigned long) sx)); /* Looks at the last bits of limb kx (if sx=0 does nothing)*/ if (tp[kx] & MPFR_LIMB_MASK(sx)) bcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bcp1 = (kx >= 0); } } } } else { /* Compute Cp and C'p+1 from C with sh=0 */ mp_limb_t *tp = MPFR_MANT(c); /* Start from bit x=p-d in mantissa C */ mpfr_prec_t x = p-d; mp_size_t kx = n-1 - (x / GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); MPFR_ASSERTD(p >= d); bcp = (tp[kx] & (MPFR_LIMB_ONE<<sx)); /* Looks at the last bits of limb kx (If sx=0, does nothing)*/ if (tp[kx] & MPFR_LIMB_MASK(sx)) bcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bcp1 = (kx>=0); } } DEBUG( printf("sh=%lu Cp=%d C'p+1=%d\n", sh, bcp!=0, bcp1!=0) ); /* Check if we can lose a bit, and if so compute Cp+1 and C'p+2 */ bp = MPFR_MANT(b); if (MPFR_UNLIKELY((bp[n-1]-cp[n-1]) <= MPFR_LIMB_HIGHBIT)) { /* We can lose a bit so we precompute Cp+1 and C'p+2 */ /* Test for trivial case: since C'p+1=0, Cp+1=0 and C'p+2 =0 */ if (MPFR_LIKELY(bcp1 == 0)) { bbcp = 0; bbcp1 = 0; } else /* bcp1 != 0 */ { /* We can lose a bit: compute Cp+1 and C'p+2 from mantissa C */ mp_limb_t *tp = MPFR_MANT(c); /* Start from bit x=(p+1)-d in mantissa C */ mpfr_prec_t x = p+1-d; mp_size_t kx = n-1 - (x/GMP_NUMB_BITS); mpfr_prec_t sx = GMP_NUMB_BITS-1-(x%GMP_NUMB_BITS); MPFR_ASSERTD(p > d); DEBUG (printf ("(pre) x=%lu Kx=%ld Sx=%lu\n", (unsigned long) x, (long) kx, (unsigned long) sx)); bbcp = (tp[kx] & (MPFR_LIMB_ONE<<sx)) ; /* Looks at the last bits of limb kx (If sx=0, does nothing)*/ /* If Cp+1=0, since C'p+1!=0, C'p+2=1 ! */ if (MPFR_LIKELY(bbcp==0 || (tp[kx]&MPFR_LIMB_MASK(sx)))) bbcp1 = 1; else { /*kx += (sx==0);*/ /*If sx==0, tp[kx] hasn't been checked*/ do { kx--; } while (kx>=0 && tp[kx]==0); bbcp1 = (kx>=0); DEBUG (printf ("(Pre) Scan done for %ld\n", (long) kx)); } } /*End of Bcp1 != 0*/ DEBUG( printf("(Pre) Cp+1=%d C'p+2=%d\n", bbcp!=0, bbcp1!=0) ); } /* End of "can lose a bit" */ /* Clean shifted C' */ mask = ~MPFR_LIMB_MASK (sh); cp[0] &= mask; /* Subtract the mantissa c from b in a */ ap = MPFR_MANT(a); mpn_sub_n (ap, bp, cp, n); DEBUG( mpfr_print_mant_binary("Sub= ", ap, p) ); /* Normalize: we lose at max one bit*/ if (MPFR_UNLIKELY(MPFR_LIMB_MSB(ap[n-1]) == 0)) { /* High bit is not set and we have to fix it! */ /* Ap >= 010000xxx001 */ mpn_lshift(ap, ap, n, 1); /* Ap >= 100000xxx010 */ if (MPFR_UNLIKELY(bcp!=0)) /* Check if Cp = -1 */ /* Since Cp == -1, we have to substract one more */ { mpn_sub_1(ap, ap, n, MPFR_LIMB_ONE<<sh); MPFR_ASSERTD(MPFR_LIMB_MSB(ap[n-1]) != 0); } /* Ap >= 10000xxx001 */ /* Final exponent -1 since we have shifted the mantissa */ bx--; /* Update bcp and bcp1 */ MPFR_ASSERTN(bbcp != (mp_limb_t) -1); MPFR_ASSERTN(bbcp1 != (mp_limb_t) -1); bcp = bbcp; bcp1 = bbcp1; /* We dont't have anymore a valid Cp+1! But since Ap >= 100000xxx001, the final sub can't unnormalize!*/ } MPFR_ASSERTD( !(ap[0] & ~mask) ); /* Rounding */ if (MPFR_LIKELY(rnd_mode == MPFR_RNDN)) { if (MPFR_LIKELY(bcp==0)) goto truncate; else if ((bcp1) || ((ap[0] & (MPFR_LIMB_ONE<<sh)) != 0)) goto sub_one_ulp; else goto truncate; } /* Update rounding mode */ MPFR_UPDATE_RND_MODE(rnd_mode, MPFR_IS_NEG(a)); if (rnd_mode == MPFR_RNDZ && (MPFR_LIKELY(bcp || bcp1))) goto sub_one_ulp; goto truncate; } MPFR_RET_NEVER_GO_HERE (); /* Sub one ulp to the result */ sub_one_ulp: mpn_sub_1 (ap, ap, n, MPFR_LIMB_ONE << sh); /* Result should be smaller than exact value: inexact=-1 */ inexact = -1; /* Check normalisation */ if (MPFR_UNLIKELY(MPFR_LIMB_MSB(ap[n-1]) == 0)) { /* ap was a power of 2, and we lose a bit */ /* Now it is 0111111111111111111[00000 */ mpn_lshift(ap, ap, n, 1); bx--; /* And the lost bit x depends on Cp+1, and Cp */ /* Compute Cp+1 if it isn't already compute (ie d==1) */ /* FIXME: Is this case possible? */ if (MPFR_UNLIKELY(d == 1)) bbcp = 0; DEBUG( printf("(SubOneUlp)Cp=%d, Cp+1=%d C'p+1=%d\n", bcp!=0,bbcp!=0,bcp1!=0)); /* Compute the last bit (Since we have shifted the mantissa) we need one more bit!*/ MPFR_ASSERTN(bbcp != (mp_limb_t) -1); if ( (rnd_mode == MPFR_RNDZ && bcp==0) || (rnd_mode==MPFR_RNDN && bbcp==0) || (bcp && bcp1==0) ) /*Exact result*/ { ap[0] |= MPFR_LIMB_ONE<<sh; if (rnd_mode == MPFR_RNDN) inexact = 1; DEBUG( printf("(SubOneUlp) Last bit set\n") ); } /* Result could be exact if C'p+1 = 0 and rnd == Zero since we have had one more bit to the result */ /* Fixme: rnd_mode == MPFR_RNDZ needed ? */ if (bcp1==0 && rnd_mode==MPFR_RNDZ) { DEBUG( printf("(SubOneUlp) Exact result\n") ); inexact = 0; } } goto end_of_sub; truncate: /* Check if the result is an exact power of 2: 100000000000 in which cases, we could have to do sub_one_ulp due to some nasty reasons: If Result is a Power of 2: + If rnd = AWAY, | If Cp=-1 and C'p+1 = 0, SubOneUlp and the result is EXACT. If Cp=-1 and C'p+1 =-1, SubOneUlp and the result is above. Otherwise truncate + If rnd = NEAREST, If Cp= 0 and Cp+1 =-1 and C'p+2=-1, SubOneUlp and the result is above If cp=-1 and C'p+1 = 0, SubOneUlp and the result is exact. Otherwise truncate. X bit should always be set if SubOneUlp*/ if (MPFR_UNLIKELY(ap[n-1] == MPFR_LIMB_HIGHBIT)) { mp_size_t k = n-1; do { k--; } while (k>=0 && ap[k]==0); if (MPFR_UNLIKELY(k<0)) { /* It is a power of 2! */ /* Compute Cp+1 if it isn't already compute (ie d==1) */ /* FIXME: Is this case possible? */ if (d == 1) bbcp=0; DEBUG( printf("(Truncate) Cp=%d, Cp+1=%d C'p+1=%d C'p+2=%d\n", \ bcp!=0, bbcp!=0, bcp1!=0, bbcp1!=0) ); MPFR_ASSERTN(bbcp != (mp_limb_t) -1); MPFR_ASSERTN((rnd_mode != MPFR_RNDN) || (bcp != 0) || (bbcp == 0) || (bbcp1 != (mp_limb_t) -1)); if (((rnd_mode != MPFR_RNDZ) && bcp) || ((rnd_mode == MPFR_RNDN) && (bcp == 0) && (bbcp) && (bbcp1))) { DEBUG( printf("(Truncate) Do sub\n") ); mpn_sub_1 (ap, ap, n, MPFR_LIMB_ONE << sh); mpn_lshift(ap, ap, n, 1); ap[0] |= MPFR_LIMB_ONE<<sh; bx--; /* FIXME: Explain why it works (or why not)... */ inexact = (bcp1 == 0) ? 0 : (rnd_mode==MPFR_RNDN) ? -1 : 1; goto end_of_sub; } } } /* Calcul of Inexact flag.*/ inexact = MPFR_LIKELY(bcp || bcp1) ? 1 : 0; end_of_sub: /* Update Expo */ /* FIXME: Is this test really useful? If d==0 : Exact case. This is never called. if 1 < d < p : bx=MPFR_EXP(b) or MPFR_EXP(b)-1 > MPFR_EXP(c) > emin if d == 1 : bx=MPFR_EXP(b). If we could lose any bits, the exact normalisation is called. if d >= p : bx=MPFR_EXP(b) >= MPFR_EXP(c) + p > emin After SubOneUlp, we could have one bit less. if 1 < d < p : bx >= MPFR_EXP(b)-2 >= MPFR_EXP(c) > emin if d == 1 : bx >= MPFR_EXP(b)-1 = MPFR_EXP(c) > emin. if d >= p : bx >= MPFR_EXP(b)-1 > emin since p>=2. */ MPFR_ASSERTD( bx >= __gmpfr_emin); /* if (MPFR_UNLIKELY(bx < __gmpfr_emin)) { DEBUG( printf("(Final Underflow)\n") ); if (rnd_mode == MPFR_RNDN && (bx < __gmpfr_emin - 1 || (inexact >= 0 && mpfr_powerof2_raw (a)))) rnd_mode = MPFR_RNDZ; MPFR_TMP_FREE(marker); return mpfr_underflow (a, rnd_mode, MPFR_SIGN(a)); } */ MPFR_SET_EXP (a, bx); MPFR_TMP_FREE(marker); MPFR_RET (inexact * MPFR_INT_SIGN (a)); }
int mpfr_exp2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode) { int inexact; long xint; mpfr_t xfrac; MPFR_SAVE_EXPO_DECL (expo); MPFR_LOG_FUNC (("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode), ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(y), mpfr_log_prec, y, inexact)); if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x))) { if (MPFR_IS_NAN (x)) { MPFR_SET_NAN (y); MPFR_RET_NAN; } else if (MPFR_IS_INF (x)) { if (MPFR_IS_POS (x)) MPFR_SET_INF (y); else MPFR_SET_ZERO (y); MPFR_SET_POS (y); MPFR_RET (0); } else /* 2^0 = 1 */ { MPFR_ASSERTD (MPFR_IS_ZERO(x)); return mpfr_set_ui (y, 1, rnd_mode); } } /* since the smallest representable non-zero float is 1/2*2^__gmpfr_emin, if x < __gmpfr_emin - 1, the result is either 1/2*2^__gmpfr_emin or 0 */ MPFR_ASSERTN (MPFR_EMIN_MIN >= LONG_MIN + 2); if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emin - 1) < 0)) { mpfr_rnd_t rnd2 = rnd_mode; /* in round to nearest mode, round to zero when x <= __gmpfr_emin-2 */ if (rnd_mode == MPFR_RNDN && mpfr_cmp_si_2exp (x, __gmpfr_emin - 2, 0) <= 0) rnd2 = MPFR_RNDZ; return mpfr_underflow (y, rnd2, 1); } MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX); if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax) >= 0)) return mpfr_overflow (y, rnd_mode, 1); /* We now know that emin - 1 <= x < emax. */ MPFR_SAVE_EXPO_MARK (expo); /* 2^x = 1 + x*log(2) + O(x^2) for x near zero, and for |x| <= 1 we have |2^x - 1| <= x < 2^EXP(x). If x > 0 we must round away from 0 (dir=1); if x < 0 we must round toward 0 (dir=0). */ MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, - MPFR_GET_EXP (x), 0, MPFR_IS_POS (x), rnd_mode, expo, {}); xint = mpfr_get_si (x, MPFR_RNDZ); mpfr_init2 (xfrac, MPFR_PREC (x)); mpfr_sub_si (xfrac, x, xint, MPFR_RNDN); /* exact */ if (MPFR_IS_ZERO (xfrac)) { mpfr_set_ui (y, 1, MPFR_RNDN); inexact = 0; } else { /* Declaration of the intermediary variable */ mpfr_t t; /* Declaration of the size variable */ mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */ mpfr_prec_t Nt; /* working precision */ mpfr_exp_t err; /* error */ MPFR_ZIV_DECL (loop); /* compute the precision of intermediary variable */ /* the optimal number of bits : see algorithms.tex */ Nt = Ny + 5 + MPFR_INT_CEIL_LOG2 (Ny); /* initialize of intermediary variable */ mpfr_init2 (t, Nt); /* First computation */ MPFR_ZIV_INIT (loop, Nt); for (;;) { /* compute exp(x*ln(2))*/ mpfr_const_log2 (t, MPFR_RNDU); /* ln(2) */ mpfr_mul (t, xfrac, t, MPFR_RNDU); /* xfrac * ln(2) */ err = Nt - (MPFR_GET_EXP (t) + 2); /* Estimate of the error */ mpfr_exp (t, t, MPFR_RNDN); /* exp(xfrac * ln(2)) */ if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode))) break; /* Actualisation of the precision */ MPFR_ZIV_NEXT (loop, Nt); mpfr_set_prec (t, Nt); } MPFR_ZIV_FREE (loop); inexact = mpfr_set (y, t, rnd_mode); mpfr_clear (t); } mpfr_clear (xfrac); MPFR_CLEAR_FLAGS (); mpfr_mul_2si (y, y, xint, MPFR_RNDN); /* exact or overflow */ /* Note: We can have an overflow only when t was rounded up to 2. */ MPFR_ASSERTD (MPFR_IS_PURE_FP (y) || inexact > 0); MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags); MPFR_SAVE_EXPO_FREE (expo); return mpfr_check_range (y, inexact, rnd_mode); }