long double
__lgamma_negl (long double x, int *signgamp)
{
/* Determine the half-integer region X lies in, handle exact
integers and determine the sign of the result. */
int i = __floorl (-2 * x);
if ((i & 1) == 0 && i == -2 * x)
return 1.0L / 0.0L;
long double xn = ((i & 1) == 0 ? -i / 2 : (-i - 1) / 2);
i -= 4;
*signgamp = ((i & 2) == 0 ? -1 : 1);
SET_RESTORE_ROUNDL (FE_TONEAREST);
/* Expand around the zero X0 = X0_HI + X0_LO. */
long double x0_hi = lgamma_zeros[i][0], x0_lo = lgamma_zeros[i][1];
long double xdiff = x - x0_hi - x0_lo;
/* For arguments in the range -3 to -2, use polynomial
approximations to an adjusted version of the gamma function. */
if (i < 2)
{
int j = __floorl (-8 * x) - 16;
long double xm = (-33 - 2 * j) * 0.0625L;
long double x_adj = x - xm;
size_t deg = poly_deg[j];
size_t end = poly_end[j];
long double g = poly_coeff[end];
for (size_t j = 1; j <= deg; j++)
g = g * x_adj + poly_coeff[end - j];
return __log1pl (g * xdiff / (x - xn));
}
/* The result we want is log (sinpi (X0) / sinpi (X))
+ log (gamma (1 - X0) / gamma (1 - X)). */
long double x_idiff = fabsl (xn - x), x0_idiff = fabsl (xn - x0_hi - x0_lo);
long double log_sinpi_ratio;
if (x0_idiff < x_idiff * 0.5L)
/* Use log not log1p to avoid inaccuracy from log1p of arguments
close to -1. */
log_sinpi_ratio = __ieee754_logl (lg_sinpi (x0_idiff)
/ lg_sinpi (x_idiff));
else
{
/* Use log1p not log to avoid inaccuracy from log of arguments
close to 1. X0DIFF2 has positive sign if X0 is further from
XN than X is from XN, negative sign otherwise. */
long double x0diff2 = ((i & 1) == 0 ? xdiff : -xdiff) * 0.5L;
long double sx0d2 = lg_sinpi (x0diff2);
long double cx0d2 = lg_cospi (x0diff2);
log_sinpi_ratio = __log1pl (2 * sx0d2
* (-sx0d2 + cx0d2 * lg_cotpi (x_idiff)));
}
long double log_gamma_ratio;
long double y0 = 1 - x0_hi;
long double y0_eps = -x0_hi + (1 - y0) - x0_lo;
long double y = 1 - x;
long double y_eps = -x + (1 - y);
/* We now wish to compute LOG_GAMMA_RATIO
= log (gamma (Y0 + Y0_EPS) / gamma (Y + Y_EPS)). XDIFF
accurately approximates the difference Y0 + Y0_EPS - Y -
Y_EPS. Use Stirling's approximation. First, we may need to
adjust into the range where Stirling's approximation is
sufficiently accurate. */
long double log_gamma_adj = 0;
if (i < 8)
{
int n_up = (9 - i) / 2;
long double ny0, ny0_eps, ny, ny_eps;
ny0 = y0 + n_up;
ny0_eps = y0 - (ny0 - n_up) + y0_eps;
y0 = ny0;
y0_eps = ny0_eps;
ny = y + n_up;
ny_eps = y - (ny - n_up) + y_eps;
y = ny;
y_eps = ny_eps;
long double prodm1 = __lgamma_productl (xdiff, y - n_up, y_eps, n_up);
log_gamma_adj = -__log1pl (prodm1);
}
long double log_gamma_high
= (xdiff * __log1pl ((y0 - e_hi - e_lo + y0_eps) / e_hi)
+ (y - 0.5L + y_eps) * __log1pl (xdiff / y) + log_gamma_adj);
/* Compute the sum of (B_2k / 2k(2k-1))(Y0^-(2k-1) - Y^-(2k-1)). */
long double y0r = 1 / y0, yr = 1 / y;
long double y0r2 = y0r * y0r, yr2 = yr * yr;
long double rdiff = -xdiff / (y * y0);
long double bterm[NCOEFF];
long double dlast = rdiff, elast = rdiff * yr * (yr + y0r);
bterm[0] = dlast * lgamma_coeff[0];
for (size_t j = 1; j < NCOEFF; j++)
{
long double dnext = dlast * y0r2 + elast;
long double enext = elast * yr2;
bterm[j] = dnext * lgamma_coeff[j];
dlast = dnext;
elast = enext;
}
long double log_gamma_low = 0;
for (size_t j = 0; j < NCOEFF; j++)
log_gamma_low += bterm[NCOEFF - 1 - j];
log_gamma_ratio = log_gamma_high + log_gamma_low;
return log_sinpi_ratio + log_gamma_ratio;
}
long double
__expm1l (long double x)
{
long double px, qx, xx;
int32_t ix, sign;
ieee854_long_double_shape_type u;
int k;
/* Detect infinity and NaN. */
u.value = x;
ix = u.parts32.w0;
sign = ix & 0x80000000;
ix &= 0x7fffffff;
if (ix >= 0x7fff0000)
{
/* Infinity. */
if (((ix & 0xffff) | u.parts32.w1 | u.parts32.w2 | u.parts32.w3) == 0)
{
if (sign)
return -1.0L;
else
return x;
}
/* NaN. No invalid exception. */
return x;
}
/* expm1(+- 0) = +- 0. */
if ((ix == 0) && (u.parts32.w1 | u.parts32.w2 | u.parts32.w3) == 0)
return x;
/* Overflow. */
if (x > maxlog)
return (big * big);
/* Minimum value. */
if (x < minarg)
return (4.0/big - 1.0L);
/* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */
xx = C1 + C2; /* ln 2. */
px = __floorl (0.5 + x / xx);
k = px;
/* remainder times ln 2 */
x -= px * C1;
x -= px * C2;
/* Approximate exp(remainder ln 2). */
px = (((((((P7 * x
+ P6) * x
+ P5) * x + P4) * x + P3) * x + P2) * x + P1) * x + P0) * x;
qx = (((((((x
+ Q7) * x
+ Q6) * x + Q5) * x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0;
xx = x * x;
qx = x + (0.5 * xx + xx * px / qx);
/* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2).
We have qx = exp(remainder ln 2) - 1, so
exp(x) - 1 = 2^k (qx + 1) - 1
= 2^k qx + 2^k - 1. */
px = ldexpl (1.0L, k);
x = px * qx + (px - 1.0);
return x;
}
