static double
large_lgam(double x)
{
double z, p, x1;
struct Double t, u, v;
u = __log__D(x);
u.a -= 1.0;
if (x > 1e15) {
v.a = x - 0.5;
TRUNC(v.a);
v.b = (x - v.a) - 0.5;
t.a = u.a*v.a;
t.b = x*u.b + v.b*u.a;
if (_IEEE == 0 && !finite(t.a))
return(infnan(ERANGE));
return(t.a + t.b);
}
x1 = 1./x;
z = x1*x1;
p = pb0+z*(pb1+z*(pb2+z*(pb3+z*(pb4+z*(pb5+z*(pb6+z*pb7))))));
/* error in approximation = 2.8e-19 */
p = p*x1; /* error < 2.3e-18 absolute */
/* 0 < p < 1/64 (at x = 5.5) */
v.a = x = x - 0.5;
TRUNC(v.a); /* truncate v.a to 26 bits. */
v.b = x - v.a;
t.a = v.a*u.a; /* t = (x-.5)*(log(x)-1) */
t.b = v.b*u.a + x*u.b;
t.b += p; t.b += lns2pi; /* return t + lns2pi + p */
return (t.a + t.b);
}
static double
neg_gam(double x)
{
int sgn = 1;
struct Double lg, lsine;
double y, z;
y = ceil(x);
if (y == x) /* Negative integer. */
if (_IEEE)
return ((x - x) / zero);
else
return (infnan(ERANGE));
z = y - x;
if (z > 0.5)
z = one - z;
y = 0.5 * y;
if (y == ceil(y))
sgn = -1;
if (z < .25)
z = sin(M_PI*z);
else
z = cos(M_PI*(0.5-z));
/* Special case: G(1-x) = Inf; G(x) may be nonzero. */
if (x < -170) {
if (x < -190)
return ((double)sgn*tiny*tiny);
y = one - x; /* exact: 128 < |x| < 255 */
lg = large_gam(y);
lsine = __log__D(M_PI/z); /* = TRUNC(log(u)) + small */
lg.a -= lsine.a; /* exact (opposite signs) */
lg.b -= lsine.b;
y = -(lg.a + lg.b);
z = (y + lg.a) + lg.b;
y = __exp__D(y, z);
if (sgn < 0) y = -y;
return (y);
}
y = one-x;
if (one-y == x)
y = tgamma(y);
else /* 1-x is inexact */
y = -x*tgamma(-x);
if (sgn < 0) y = -y;
return (M_PI / (y*z));
}
/*
* Accurate to max(ulp(1/128) absolute, 2^-66 relative) error.
*/
static struct Double
large_gam(double x)
{
double z, p;
struct Double t, u, v;
z = one/(x*x);
p = Pa0+z*(Pa1+z*(Pa2+z*(Pa3+z*(Pa4+z*(Pa5+z*(Pa6+z*Pa7))))));
p = p/x;
u = __log__D(x);
u.a -= one;
v.a = (x -= .5);
TRUNC(v.a);
v.b = x - v.a;
t.a = v.a*u.a; /* t = (x-.5)*(log(x)-1) */
t.b = v.b*u.a + x*u.b;
/* return t.a + t.b + lns2pi_hi + lns2pi_lo + p */
t.b += lns2pi_lo; t.b += p;
u.a = lns2pi_hi + t.b; u.a += t.a;
u.b = t.a - u.a;
u.b += lns2pi_hi; u.b += t.b;
return (u);
}
static double
small_lgam(double x)
{
int x_int;
double y, z, t, r = 0, p, q, hi, lo;
struct Double rr;
x_int = (x + .5);
y = x - x_int;
if (x_int <= 2 && y > RIGHT) {
t = y - x0;
y--; x_int++;
goto CONTINUE;
} else if (y < -LEFT) {
t = y +(1.0-x0);
CONTINUE:
z = t - x0_lo;
p = r0+z*(r1+z*(r2+z*(r3+z*(r4+z*r5))));
q = s0+z*(s1+z*(s2+z*(s3+z*s4)));
r = t*(z*(p/q) - x0_lo);
t = .5*t*t;
z = 1.0;
switch (x_int) {
case 6: z = (y + 5); /* FALLTHROUGH */
case 5: z *= (y + 4); /* FALLTHROUGH */
case 4: z *= (y + 3); /* FALLTHROUGH */
case 3: z *= (y + 2);
rr = __log__D(z);
rr.b += a0_lo; rr.a += a0_hi;
return(((r+rr.b)+t+rr.a));
case 2: return(((r+a0_lo)+t)+a0_hi);
case 0: r -= log1p(x); /* FALLTHROUGH */
default: rr = __log__D(x);
rr.a -= a0_hi; rr.b -= a0_lo;
return(((r - rr.b) + t) - rr.a);
}
} else {
p = p0+y*(p1+y*(p2+y*(p3+y*p4)));
q = q0+y*(q1+y*(q2+y*(q3+y*(q4+y*(q5+y*q6)))));
p = p*(y/q);
t = (double)(float) y;
z = y-t;
hi = (double)(float) (p+a1_hi);
lo = a1_hi - hi; lo += p; lo += a1_lo;
r = lo*y + z*hi; /* q + r = y*(a0+p/q) */
q = hi*t;
z = 1.0;
switch (x_int) {
case 6: z = (y + 5); /* FALLTHROUGH */
case 5: z *= (y + 4); /* FALLTHROUGH */
case 4: z *= (y + 3); /* FALLTHROUGH */
case 3: z *= (y + 2); /* FALLTHROUGH */
rr = __log__D(z);
r += rr.b; r += q;
return(rr.a + r);
case 2: return (q+ r);
case 0: rr = __log__D(x);
r -= rr.b; r -= log1p(x);
r += q; r-= rr.a;
return(r);
default: rr = __log__D(x);
r -= rr.b;
q -= rr.a;
return (r+q);
}
}
}