int
mpfr_underflow (mpfr_ptr x, mp_rnd_t rnd_mode, int sign)
{
int inex;
MPFR_ASSERT_SIGN (sign);
if (rnd_mode == GMP_RNDN
|| MPFR_IS_RNDUTEST_OR_RNDDNOTTEST(rnd_mode, MPFR_IS_POS_SIGN (sign)))
{
mpfr_setmin (x, __gmpfr_emin);
inex = 1;
}
else
{
MPFR_SET_ZERO(x);
inex = -1;
}
MPFR_SET_SIGN(x, sign);
__gmpfr_flags |= MPFR_FLAGS_INEXACT | MPFR_FLAGS_UNDERFLOW;
return sign > 0 ? inex : -inex;
}
/* 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_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
mpfr_div (mpfr_ptr q, mpfr_srcptr u, mpfr_srcptr v, mp_rnd_t rnd_mode)
{
mp_srcptr up, vp, bp;
mp_size_t usize, vsize;
mp_ptr ap, qp, rp;
mp_size_t asize, bsize, qsize, rsize;
mp_exp_t qexp;
mp_size_t err, k;
mp_limb_t tonearest;
int inex, sh, can_round = 0, sign_quotient;
unsigned int cc = 0, rw;
TMP_DECL (marker);
/**************************************************************************
* *
* This part of the code deals with special cases *
* *
**************************************************************************/
if (MPFR_ARE_SINGULAR(u,v))
{
if (MPFR_IS_NAN(u) || MPFR_IS_NAN(v))
{
MPFR_SET_NAN(q);
MPFR_RET_NAN;
}
sign_quotient = MPFR_MULT_SIGN( MPFR_SIGN(u) , MPFR_SIGN(v) );
MPFR_SET_SIGN(q, sign_quotient);
if (MPFR_IS_INF(u))
{
if (MPFR_IS_INF(v))
{
MPFR_SET_NAN(q);
MPFR_RET_NAN;
}
else
{
MPFR_SET_INF(q);
MPFR_RET(0);
}
}
else if (MPFR_IS_INF(v))
{
MPFR_SET_ZERO(q);
MPFR_RET(0);
}
else if (MPFR_IS_ZERO(v))
{
if (MPFR_IS_ZERO(u))
{
MPFR_SET_NAN(q);
MPFR_RET_NAN;
}
else
{
MPFR_SET_INF(q);
MPFR_RET(0);
}
}
else
{
MPFR_ASSERTD(MPFR_IS_ZERO(u));
MPFR_SET_ZERO(q);
MPFR_RET(0);
}
}
MPFR_CLEAR_FLAGS(q);
/**************************************************************************
* *
* End of the part concerning special values. *
* *
**************************************************************************/
sign_quotient = MPFR_MULT_SIGN( MPFR_SIGN(u) , MPFR_SIGN(v) );
up = MPFR_MANT(u);
vp = MPFR_MANT(v);
MPFR_SET_SIGN(q, sign_quotient);
TMP_MARK (marker);
usize = MPFR_LIMB_SIZE(u);
vsize = MPFR_LIMB_SIZE(v);
/**************************************************************************
* *
* First try to use only part of u, v. If this is not sufficient, *
* use the full u and v, to avoid long computations eg. in the case *
* u = v. *
* *
**************************************************************************/
/* The dividend is a, length asize. The divisor is b, length bsize. */
qsize = (MPFR_PREC(q) + 3) / BITS_PER_MP_LIMB + 1;
/* in case PREC(q)=PREC(v), then vsize=qsize with probability 1-4/b
where b is the number of bits per limb */
if (MPFR_LIKELY(vsize <= qsize))
{
bsize = vsize;
bp = vp;
}
else /* qsize < vsize: take only the qsize high limbs of the divisor */
{
bsize = qsize;
bp = (mp_srcptr) vp + (vsize - qsize);
}
/* we have {bp, bsize} * (1 + errb) = (true divisor)
with 0 <= errb < 2^(-qsize*BITS_PER_MP_LIMB+1) */
asize = bsize + qsize;
ap = (mp_ptr) TMP_ALLOC (asize * BYTES_PER_MP_LIMB);
/* if all arguments have same precision, then asize will be about 2*usize */
if (MPFR_LIKELY(asize > usize))
{
/* copy u into the high limbs of {ap, asize}, and pad with zeroes */
/* FIXME: could we copy only the qsize high limbs of the dividend? */
MPN_COPY (ap + asize - usize, up, usize);
MPN_ZERO (ap, asize - usize);
}
else /* truncate the high asize limbs of u into {ap, asize} */
MPN_COPY (ap, up + usize - asize, asize);
/* we have {ap, asize} = (true dividend) * (1 - erra)
with 0 <= erra < 2^(-asize*BITS_PER_MP_LIMB).
This {ap, asize} / {bp, bsize} =
(true dividend) / (true divisor) * (1 - erra) (1 + errb) */
/* Allocate limbs for quotient and remainder. */
qp = (mp_ptr) TMP_ALLOC ((qsize + 1) * BYTES_PER_MP_LIMB);
rp = (mp_ptr) TMP_ALLOC (bsize * BYTES_PER_MP_LIMB);
rsize = bsize;
mpn_tdiv_qr (qp, rp, 0, ap, asize, bp, bsize);
sh = - (int) qp[qsize];
/* since u and v are normalized, sh is 0 or -1 */
/* we have {qp, qsize + 1} = {ap, asize} / {bp, bsize} (1 - errq)
with 0 <= errq < 2^(-qsize*BITS_PER_MP_LIMB+1+sh)
thus {qp, qsize + 1} =
(true dividend) / (true divisor) * (1 - erra) (1 + errb) (1 - errq).
In fact, since the truncated dividend and {rp, bsize} do not overlap,
we have: {qp, qsize + 1} =
(true dividend) / (true divisor) * (1 - erra') (1 + errb)
where 0 <= erra' < 2^(-qsize*BITS_PER_MP_LIMB+sh) */
/* Estimate number of correct bits. */
err = qsize * BITS_PER_MP_LIMB;
/* We want to check if rounding is possible, but without normalizing
because we might have to divide again if rounding is impossible, or
if the result might be exact. We have however to mimic normalization */
/*
To detect asap if the result is inexact, so as to avoid doing the
division completely, we perform the following check :
- if rnd_mode != GMP_RNDN, and the result is exact, we are unable
to round simultaneously to zero and to infinity ;
- if rnd_mode == GMP_RNDN, and if we can round to zero with one extra
bit of precision, we can decide rounding. Hence in that case, check
as in the case of GMP_RNDN, with one extra bit. Note that in the case
of close to even rounding we shall do the division completely, but
this is necessary anyway : we need to know whether this is really
even rounding or not.
*/
if (MPFR_UNLIKELY(asize < usize || bsize < vsize))
{
{
mp_rnd_t rnd_mode1, rnd_mode2;
mp_exp_t tmp_exp;
mp_prec_t tmp_prec;
if (bsize < vsize)
err -= 2; /* divisor is truncated */
#if 0 /* commented this out since the truncation of the dividend is already
taken into account in {rp, bsize}, which does not overlap with the
neglected part of the dividend */
else if (asize < usize)
err --; /* dividend is truncated */
#endif
if (MPFR_LIKELY(rnd_mode == GMP_RNDN))
{
rnd_mode1 = GMP_RNDZ;
rnd_mode2 = MPFR_IS_POS_SIGN(sign_quotient) ? GMP_RNDU : GMP_RNDD;
sh++;
}
else
{
rnd_mode1 = rnd_mode;
switch (rnd_mode)
{
case GMP_RNDU:
rnd_mode2 = GMP_RNDD; break;
case GMP_RNDD:
rnd_mode2 = GMP_RNDU; break;
default:
rnd_mode2 = MPFR_IS_POS_SIGN(sign_quotient) ?
GMP_RNDU : GMP_RNDD;
break;
}
}
tmp_exp = err + sh + BITS_PER_MP_LIMB;
tmp_prec = MPFR_PREC(q) + sh + BITS_PER_MP_LIMB;
can_round =
mpfr_can_round_raw (qp, qsize + 1, sign_quotient, tmp_exp,
GMP_RNDN, rnd_mode1, tmp_prec)
& mpfr_can_round_raw (qp, qsize + 1, sign_quotient, tmp_exp,
GMP_RNDN, rnd_mode2, tmp_prec);
/* restore original value of sh, i.e. sh = - qp[qsize] */
sh -= (rnd_mode == GMP_RNDN);
}
int
mpfr_acos (mpfr_ptr acos, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t xp, arcc, tmp;
mpfr_exp_t supplement;
mpfr_prec_t prec;
int sign, compared, inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("acos[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec(acos), mpfr_log_prec, acos, inexact));
/* Singular cases */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_INF (x))
{
MPFR_SET_NAN (acos);
MPFR_RET_NAN;
}
else /* necessarily x=0 */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
/* acos(0)=Pi/2 */
MPFR_SAVE_EXPO_MARK (expo);
inexact = mpfr_const_pi (acos, rnd_mode);
mpfr_div_2ui (acos, acos, 1, rnd_mode); /* exact */
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (acos, inexact, rnd_mode);
}
}
/* Set x_p=|x| */
sign = MPFR_SIGN (x);
mpfr_init2 (xp, MPFR_PREC (x));
mpfr_abs (xp, x, MPFR_RNDN); /* Exact */
compared = mpfr_cmp_ui (xp, 1);
if (MPFR_UNLIKELY (compared >= 0))
{
mpfr_clear (xp);
if (compared > 0) /* acos(x) = NaN for x > 1 */
{
MPFR_SET_NAN(acos);
MPFR_RET_NAN;
}
else
{
if (MPFR_IS_POS_SIGN (sign)) /* acos(+1) = +0 */
return mpfr_set_ui (acos, 0, rnd_mode);
else /* acos(-1) = Pi */
return mpfr_const_pi (acos, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Compute the supplement */
mpfr_ui_sub (xp, 1, xp, MPFR_RNDD);
if (MPFR_IS_POS_SIGN (sign))
supplement = 2 - 2 * MPFR_GET_EXP (xp);
else
supplement = 2 - MPFR_GET_EXP (xp);
mpfr_clear (xp);
prec = MPFR_PREC (acos);
prec += MPFR_INT_CEIL_LOG2(prec) + 10 + supplement;
/* VL: The following change concerning prec comes from r3145
"Optimize mpfr_acos by choosing a better initial precision."
but it doesn't seem to be correct and leads to problems (assertion
failure or very important inefficiency) with tiny arguments.
Therefore, I've disabled it. */
/* If x ~ 2^-N, acos(x) ~ PI/2 - x - x^3/6
If Prec < 2*N, we can't round since x^3/6 won't be counted. */
#if 0
if (MPFR_PREC (acos) >= MPFR_PREC (x) && MPFR_GET_EXP (x) < 0)
{
mpfr_uexp_t pmin = (mpfr_uexp_t) (-2 * MPFR_GET_EXP (x)) + 5;
MPFR_ASSERTN (pmin <= MPFR_PREC_MAX);
if (prec < pmin)
prec = pmin;
}
#endif
mpfr_init2 (tmp, prec);
mpfr_init2 (arcc, prec);
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
/* acos(x) = Pi/2 - asin(x) = Pi/2 - atan(x/sqrt(1-x^2)) */
mpfr_sqr (tmp, x, MPFR_RNDN);
mpfr_ui_sub (tmp, 1, tmp, MPFR_RNDN);
mpfr_sqrt (tmp, tmp, MPFR_RNDN);
mpfr_div (tmp, x, tmp, MPFR_RNDN);
mpfr_atan (arcc, tmp, MPFR_RNDN);
mpfr_const_pi (tmp, MPFR_RNDN);
mpfr_div_2ui (tmp, tmp, 1, MPFR_RNDN);
mpfr_sub (arcc, tmp, arcc, MPFR_RNDN);
if (MPFR_LIKELY (MPFR_CAN_ROUND (arcc, prec - supplement,
MPFR_PREC (acos), rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, prec);
mpfr_set_prec (tmp, prec);
mpfr_set_prec (arcc, prec);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (acos, arcc, rnd_mode);
mpfr_clear (tmp);
mpfr_clear (arcc);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (acos, inexact, rnd_mode);
}
