long double __x2y2m1l (long double x, long double y) { long double vals[4]; SET_RESTORE_ROUNDL (FE_TONEAREST); mul_split (&vals[1], &vals[0], x, x); mul_split (&vals[3], &vals[2], y, y); if (x >= 0.75L) vals[1] -= 1.0L; else { vals[1] -= 0.5L; vals[3] -= 0.5L; } qsort (vals, 4, sizeof (long double), compare); /* Add up the values so that each element of VALS has absolute value at most equal to the last set bit of the next nonzero element. */ for (size_t i = 0; i <= 2; i++) { add_split (&vals[i + 1], &vals[i], vals[i + 1], vals[i]); qsort (vals + i + 1, 3 - i, sizeof (long double), compare); } /* Now any error from this addition will be small. */ return vals[3] + vals[2] + vals[1] + vals[0]; }
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 < 18) { int n_up = (19 - 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 __ieee754_gammal_r (long double x, int *signgamp) { int64_t hx; u_int64_t lx; long double ret; GET_LDOUBLE_WORDS64 (hx, lx, x); if (((hx & 0x7fffffffffffffffLL) | lx) == 0) { /* Return value for x == 0 is Inf with divide by zero exception. */ *signgamp = 0; return 1.0 / x; } if (hx < 0 && (u_int64_t) hx < 0xffff000000000000ULL && __rintl (x) == x) { /* Return value for integer x < 0 is NaN with invalid exception. */ *signgamp = 0; return (x - x) / (x - x); } if (hx == 0xffff000000000000ULL && lx == 0) { /* x == -Inf. According to ISO this is NaN. */ *signgamp = 0; return x - x; } if ((hx & 0x7fff000000000000ULL) == 0x7fff000000000000ULL) { /* Positive infinity (return positive infinity) or NaN (return NaN). */ *signgamp = 0; return x + x; } if (x >= 1756.0L) { /* Overflow. */ *signgamp = 0; return LDBL_MAX * LDBL_MAX; } else { SET_RESTORE_ROUNDL (FE_TONEAREST); if (x > 0.0L) { *signgamp = 0; int exp2_adj; ret = gammal_positive (x, &exp2_adj); ret = __scalbnl (ret, exp2_adj); } else if (x >= -LDBL_EPSILON / 4.0L) { *signgamp = 0; ret = 1.0L / x; } else { long double tx = __truncl (x); *signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1; if (x <= -1775.0L) /* Underflow. */ ret = LDBL_MIN * LDBL_MIN; else { long double frac = tx - x; if (frac > 0.5L) frac = 1.0L - frac; long double sinpix = (frac <= 0.25L ? __sinl (M_PIl * frac) : __cosl (M_PIl * (0.5L - frac))); int exp2_adj; ret = M_PIl / (-x * sinpix * gammal_positive (-x, &exp2_adj)); ret = __scalbnl (ret, -exp2_adj); } } } if (isinf (ret) && x != 0) { if (*signgamp < 0) return -(-__copysignl (LDBL_MAX, ret) * LDBL_MAX); else return __copysignl (LDBL_MAX, ret) * LDBL_MAX; } else if (ret == 0) { if (*signgamp < 0) return -(-__copysignl (LDBL_MIN, ret) * LDBL_MIN); else return __copysignl (LDBL_MIN, ret) * LDBL_MIN; } else return ret; }
long double __ieee754_y1l (long double x) { long double xx, xinv, z, p, q, c, s, cc, ss; if (! isfinite (x)) { if (x != x) return x; else return 0.0L; } if (x <= 0.0L) { if (x < 0.0L) return (zero / (zero * x)); return -HUGE_VALL + x; } xx = fabsl (x); if (xx <= 0x1p-114) { z = -TWOOPI / x; if (isinf (z)) __set_errno (ERANGE); return z; } if (xx <= 2.0L) { /* 0 <= x <= 2 */ SET_RESTORE_ROUNDL (FE_TONEAREST); z = xx * xx; p = xx * neval (z, Y0_2N, NY0_2N) / deval (z, Y0_2D, NY0_2D); p = -TWOOPI / xx + p; p = TWOOPI * __ieee754_logl (x) * __ieee754_j1l (x) + p; return p; } /* X = x - 3 pi/4 cos(X) = cos(x) cos(3 pi/4) + sin(x) sin(3 pi/4) = 1/sqrt(2) * (-cos(x) + sin(x)) sin(X) = sin(x) cos(3 pi/4) - cos(x) sin(3 pi/4) = -1/sqrt(2) * (sin(x) + cos(x)) cf. Fdlibm. */ __sincosl (xx, &s, &c); ss = -s - c; cc = s - c; if (xx <= LDBL_MAX / 2.0L) { z = __cosl (xx + xx); if ((s * c) > 0) cc = z / ss; else ss = z / cc; } if (xx > 0x1p256L) return ONEOSQPI * ss / __ieee754_sqrtl (xx); xinv = 1.0L / xx; z = xinv * xinv; if (xinv <= 0.25) { if (xinv <= 0.125) { if (xinv <= 0.0625) { p = neval (z, P16_IN, NP16_IN) / deval (z, P16_ID, NP16_ID); q = neval (z, Q16_IN, NQ16_IN) / deval (z, Q16_ID, NQ16_ID); } else { p = neval (z, P8_16N, NP8_16N) / deval (z, P8_16D, NP8_16D); q = neval (z, Q8_16N, NQ8_16N) / deval (z, Q8_16D, NQ8_16D); } } else if (xinv <= 0.1875) { p = neval (z, P5_8N, NP5_8N) / deval (z, P5_8D, NP5_8D); q = neval (z, Q5_8N, NQ5_8N) / deval (z, Q5_8D, NQ5_8D); } else { p = neval (z, P4_5N, NP4_5N) / deval (z, P4_5D, NP4_5D); q = neval (z, Q4_5N, NQ4_5N) / deval (z, Q4_5D, NQ4_5D); } } /* .25 */ else /* if (xinv <= 0.5) */ { if (xinv <= 0.375) { if (xinv <= 0.3125) { p = neval (z, P3r2_4N, NP3r2_4N) / deval (z, P3r2_4D, NP3r2_4D); q = neval (z, Q3r2_4N, NQ3r2_4N) / deval (z, Q3r2_4D, NQ3r2_4D); } else { p = neval (z, P2r7_3r2N, NP2r7_3r2N) / deval (z, P2r7_3r2D, NP2r7_3r2D); q = neval (z, Q2r7_3r2N, NQ2r7_3r2N) / deval (z, Q2r7_3r2D, NQ2r7_3r2D); } } else if (xinv <= 0.4375) { p = neval (z, P2r3_2r7N, NP2r3_2r7N) / deval (z, P2r3_2r7D, NP2r3_2r7D); q = neval (z, Q2r3_2r7N, NQ2r3_2r7N) / deval (z, Q2r3_2r7D, NQ2r3_2r7D); } else { p = neval (z, P2_2r3N, NP2_2r3N) / deval (z, P2_2r3D, NP2_2r3D); q = neval (z, Q2_2r3N, NQ2_2r3N) / deval (z, Q2_2r3D, NQ2_2r3D); } } p = 1.0L + z * p; q = z * q; q = q * xinv + 0.375L * xinv; z = ONEOSQPI * (p * ss + q * cc) / __ieee754_sqrtl (xx); return z; }
long double __ieee754_gammal_r (long double x, int *signgamp) { u_int32_t es, hx, lx; long double ret; GET_LDOUBLE_WORDS (es, hx, lx, x); if (__glibc_unlikely (((es & 0x7fff) | hx | lx) == 0)) { /* Return value for x == 0 is Inf with divide by zero exception. */ *signgamp = 0; return 1.0 / x; } if (__glibc_unlikely (es == 0xffffffff && ((hx & 0x7fffffff) | lx) == 0)) { /* x == -Inf. According to ISO this is NaN. */ *signgamp = 0; return x - x; } if (__glibc_unlikely ((es & 0x7fff) == 0x7fff)) { /* Positive infinity (return positive infinity) or NaN (return NaN). */ *signgamp = 0; return x + x; } if (__builtin_expect ((es & 0x8000) != 0, 0) && __rintl (x) == x) { /* Return value for integer x < 0 is NaN with invalid exception. */ *signgamp = 0; return (x - x) / (x - x); } if (x >= 1756.0L) { /* Overflow. */ *signgamp = 0; return LDBL_MAX * LDBL_MAX; } else { SET_RESTORE_ROUNDL (FE_TONEAREST); if (x > 0.0L) { *signgamp = 0; int exp2_adj; ret = gammal_positive (x, &exp2_adj); ret = __scalbnl (ret, exp2_adj); } else if (x >= -LDBL_EPSILON / 4.0L) { *signgamp = 0; ret = 1.0L / x; } else { long double tx = __truncl (x); *signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1; if (x <= -1766.0L) /* Underflow. */ ret = LDBL_MIN * LDBL_MIN; else { long double frac = tx - x; if (frac > 0.5L) frac = 1.0L - frac; long double sinpix = (frac <= 0.25L ? __sinl (M_PIl * frac) : __cosl (M_PIl * (0.5L - frac))); int exp2_adj; ret = M_PIl / (-x * sinpix * gammal_positive (-x, &exp2_adj)); ret = __scalbnl (ret, -exp2_adj); math_check_force_underflow_nonneg (ret); } } } if (isinf (ret) && x != 0) { if (*signgamp < 0) return -(-__copysignl (LDBL_MAX, ret) * LDBL_MAX); else return __copysignl (LDBL_MAX, ret) * LDBL_MAX; } else if (ret == 0) { if (*signgamp < 0) return -(-__copysignl (LDBL_MIN, ret) * LDBL_MIN); else return __copysignl (LDBL_MIN, ret) * LDBL_MIN; } else return ret; }