long double __ieee754_gammal_r (long double x, int *signgamp) { /* We don't have a real gamma implementation now. We'll use lgamma and the exp function. But due to the required boundary conditions we must check some values separately. */ int64_t hx; u_int64_t lx; GET_LDOUBLE_WORDS64 (hx, lx, x); if (((hx | lx) & 0x7fffffffffffffffLL) == 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 < 0xfff0000000000000ULL && __rintl (x) == x) { /* Return value for integer x < 0 is NaN with invalid exception. */ *signgamp = 0; return (x - x) / (x - x); } if (hx == 0xfff0000000000000ULL) { /* x == -Inf. According to ISO this is NaN. */ *signgamp = 0; return x - x; } /* XXX FIXME. */ return __ieee754_expl (__ieee754_lgammal_r (x, signgamp)); }
long double __ieee754_gammal_r (long double x, int *signgamp) { /* We don't have a real gamma implementation now. We'll use lgamma and the exp function. But due to the required boundary conditions we must check some values separately. */ u_int32_t es, hx, lx; GET_LDOUBLE_WORDS (es, hx, lx, x); if (((es & 0x7fff) | hx | lx) == 0) { /* Return value for x == 0 is NaN with invalid exception. */ *signgamp = 0; return x / x; } if (es == 0xffffffff && ((hx & 0x7fffffff) | lx) == 0) { /* x == -Inf. According to ISO this is NaN. */ *signgamp = 0; return x - x; } if ((es & 0x7fff) == 0x7fff && ((hx & 0x7fffffff) | lx) != 0) /* NaN, return it. */ return x; if ((es & 0x8000) != 0 && x < 0xffffffff && __rintl (x) == x) { /* Return value for integer x < 0 is NaN with invalid exception. */ *signgamp = 0; return (x - x) / (x - x); } /* XXX FIXME. */ return __ieee754_expl (__ieee754_lgammal_r (x, signgamp)); }
long double __lgammal_r(long double x, int *signgamp) { long double y = __ieee754_lgammal_r(x,signgamp); if(__builtin_expect(!isfinite(y), 0) && isfinite(x) && _LIB_VERSION != _IEEE_) return __kernel_standard(x, x, floorl(x)==x&&x<=0.0 ? 215 /* lgamma pole */ : 214); /* lgamma overflow */ return y; }
long double __lgammal(long double x) { int local_signgam = 0; long double y = __ieee754_lgammal_r(x, _LIB_VERSION != _ISOC_ /* ISO C99 does not define the global variable. */ ? &signgam : &local_signgam); if(__builtin_expect(!__finitel(y), 0) && __finitel(x) && _LIB_VERSION != _IEEE_) return __kernel_standard_l(x, x, __floorl(x)==x&&x<=0.0L ? 215 /* lgamma pole */ : 214); /* lgamma overflow */ return y; }
long double __ieee754_lgammal_r (long double x, int *signgamp) { long double p, q, w, z, nx; int i, nn; *signgamp = 1; if (! __finitel (x)) return x * x; if (x == 0.0L) { if (__signbitl (x)) *signgamp = -1; } if (x < 0.0L) { q = -x; p = __floorl (q); if (p == q) return (one / (p - p)); i = p; if ((i & 1) == 0) *signgamp = -1; else *signgamp = 1; if (q < 0x1p-120L) return -__logl (q); z = q - p; if (z > 0.5L) { p += 1.0L; z = p - q; } z = q * __sinl (PIL * z); w = __ieee754_lgammal_r (q, &i); z = __logl (PIL / z) - w; return (z); } if (x < 13.5L) { p = 0.0L; nx = __floorl (x + 0.5L); nn = nx; switch (nn) { case 0: /* log gamma (x + 1) = log(x) + log gamma(x) */ if (x < 0x1p-120L) return -__logl (x); else if (x <= 0.125) { p = x * neval (x, RN1, NRN1) / deval (x, RD1, NRD1); } else if (x <= 0.375) { z = x - 0.25L; p = z * neval (z, RN1r25, NRN1r25) / deval (z, RD1r25, NRD1r25); p += lgam1r25b; p += lgam1r25a; } else if (x <= 0.625) { z = x + (1.0L - x0a); z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } else if (x <= 0.875) { z = x - 0.75L; p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); p += lgam1r75b; p += lgam1r75a; } else { z = x - 1.0L; p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); } p = p - __logl (x); break; case 1: if (x < 0.875L) { if (x <= 0.625) { z = x + (1.0L - x0a); z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } else if (x <= 0.875) { z = x - 0.75L; p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); p += lgam1r75b; p += lgam1r75a; } else { z = x - 1.0L; p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); } p = p - __logl (x); } else if (x < 1.0L) { z = x - 1.0L; p = z * neval (z, RNr9, NRNr9) / deval (z, RDr9, NRDr9); } else if (x == 1.0L) p = 0.0L; else if (x <= 1.125L) { z = x - 1.0L; p = z * neval (z, RN1, NRN1) / deval (z, RD1, NRD1); } else if (x <= 1.375) { z = x - 1.25L; p = z * neval (z, RN1r25, NRN1r25) / deval (z, RD1r25, NRD1r25); p += lgam1r25b; p += lgam1r25a; } else { /* 1.375 <= x+x0 <= 1.625 */ z = x - x0a; z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } break; case 2: if (x < 1.625L) { z = x - x0a; z = z - x0b; p = neval (z, RN1r5, NRN1r5) / deval (z, RD1r5, NRD1r5); p = p * z * z; p = p + y0b; p = p + y0a; } else if (x < 1.875L) { z = x - 1.75L; p = z * neval (z, RN1r75, NRN1r75) / deval (z, RD1r75, NRD1r75); p += lgam1r75b; p += lgam1r75a; } else if (x == 2.0L) p = 0.0L; else if (x < 2.375L) { z = x - 2.0L; p = z * neval (z, RN2, NRN2) / deval (z, RD2, NRD2); } else { z = x - 2.5L; p = z * neval (z, RN2r5, NRN2r5) / deval (z, RD2r5, NRD2r5); p += lgam2r5b; p += lgam2r5a; } break; case 3: if (x < 2.75) { z = x - 2.5L; p = z * neval (z, RN2r5, NRN2r5) / deval (z, RD2r5, NRD2r5); p += lgam2r5b; p += lgam2r5a; } else { z = x - 3.0L; p = z * neval (z, RN3, NRN3) / deval (z, RD3, NRD3); p += lgam3b; p += lgam3a; } break; case 4: z = x - 4.0L; p = z * neval (z, RN4, NRN4) / deval (z, RD4, NRD4); p += lgam4b; p += lgam4a; break; case 5: z = x - 5.0L; p = z * neval (z, RN5, NRN5) / deval (z, RD5, NRD5); p += lgam5b; p += lgam5a; break; case 6: z = x - 6.0L; p = z * neval (z, RN6, NRN6) / deval (z, RD6, NRD6); p += lgam6b; p += lgam6a; break; case 7: z = x - 7.0L; p = z * neval (z, RN7, NRN7) / deval (z, RD7, NRD7); p += lgam7b; p += lgam7a; break; case 8: z = x - 8.0L; p = z * neval (z, RN8, NRN8) / deval (z, RD8, NRD8); p += lgam8b; p += lgam8a; break; case 9: z = x - 9.0L; p = z * neval (z, RN9, NRN9) / deval (z, RD9, NRD9); p += lgam9b; p += lgam9a; break; case 10: z = x - 10.0L; p = z * neval (z, RN10, NRN10) / deval (z, RD10, NRD10); p += lgam10b; p += lgam10a; break; case 11: z = x - 11.0L; p = z * neval (z, RN11, NRN11) / deval (z, RD11, NRD11); p += lgam11b; p += lgam11a; break; case 12: z = x - 12.0L; p = z * neval (z, RN12, NRN12) / deval (z, RD12, NRD12); p += lgam12b; p += lgam12a; break; case 13: z = x - 13.0L; p = z * neval (z, RN13, NRN13) / deval (z, RD13, NRD13); p += lgam13b; p += lgam13a; break; } return p; } if (x > MAXLGM) return (*signgamp * huge * huge); q = ls2pi - x; q = (x - 0.5L) * __logl (x) + q; if (x > 1.0e18L) return (q); p = 1.0L / (x * x); q += neval (p, RASY, NRASY) / x; return (q); }
static long double gammal_positive (long double x, int *exp2_adj) { int local_signgam; if (x < 0.5L) { *exp2_adj = 0; return __ieee754_expl (__ieee754_lgammal_r (x + 1, &local_signgam)) / x; } else if (x <= 1.5L) { *exp2_adj = 0; return __ieee754_expl (__ieee754_lgammal_r (x, &local_signgam)); } else if (x < 12.5L) { /* Adjust into the range for using exp (lgamma). */ *exp2_adj = 0; long double n = __ceill (x - 1.5L); long double x_adj = x - n; long double eps; long double prod = __gamma_productl (x_adj, 0, n, &eps); return (__ieee754_expl (__ieee754_lgammal_r (x_adj, &local_signgam)) * prod * (1.0L + eps)); } else { long double eps = 0; long double x_eps = 0; long double x_adj = x; long double prod = 1; if (x < 24.0L) { /* Adjust into the range for applying Stirling's approximation. */ long double n = __ceill (24.0L - x); x_adj = x + n; x_eps = (x - (x_adj - n)); prod = __gamma_productl (x_adj - n, x_eps, n, &eps); } /* The result is now gamma (X_ADJ + X_EPS) / (PROD * (1 + EPS)). Compute gamma (X_ADJ + X_EPS) using Stirling's approximation, starting by computing pow (X_ADJ, X_ADJ) with a power of 2 factored out. */ long double exp_adj = -eps; long double x_adj_int = __roundl (x_adj); long double x_adj_frac = x_adj - x_adj_int; int x_adj_log2; long double x_adj_mant = __frexpl (x_adj, &x_adj_log2); if (x_adj_mant < M_SQRT1_2l) { x_adj_log2--; x_adj_mant *= 2.0L; } *exp2_adj = x_adj_log2 * (int) x_adj_int; long double ret = (__ieee754_powl (x_adj_mant, x_adj) * __ieee754_exp2l (x_adj_log2 * x_adj_frac) * __ieee754_expl (-x_adj) * __ieee754_sqrtl (2 * M_PIl / x_adj) / prod); exp_adj += x_eps * __ieee754_logl (x_adj); long double bsum = gamma_coeff[NCOEFF - 1]; long double x_adj2 = x_adj * x_adj; for (size_t i = 1; i <= NCOEFF - 1; i++) bsum = bsum / x_adj2 + gamma_coeff[NCOEFF - 1 - i]; exp_adj += bsum / x_adj; return ret + ret * __expm1l (exp_adj); } }