X-Git-Url: http://nsz.repo.hu/git/?a=blobdiff_plain;f=src%2Fmath%2Flgammal.c;h=55ec5325ed1382166baec88a264b6fe9940faf03;hb=6739b13a172aad9c01572c04cadacc99c7041811;hp=ec7c9a0425d524555656e9bbbd860aa02bfdb7b0;hpb=8c071f872b2844ca297275176047f8d23eec96a7;p=musl diff --git a/src/math/lgammal.c b/src/math/lgammal.c index ec7c9a04..55ec5325 100644 --- a/src/math/lgammal.c +++ b/src/math/lgammal.c @@ -87,18 +87,18 @@ #define _GNU_SOURCE #include "libm.h" +#include "libc.h" #if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +double __lgamma_r(double x, int *sg); + long double __lgammal_r(long double x, int *sg) { return __lgamma_r(x, sg); } #elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 static const long double -half = 0.5L, -one = 1.0L, pi = 3.14159265358979323846264L, -two63 = 9.223372036854775808e18L, /* lgam(1+x) = 0.5 x + x a(x)/b(x) -0.268402099609375 <= x <= 0 @@ -200,125 +200,79 @@ w5 = 8.412723297322498080632E-4L, w6 = -1.880801938119376907179E-3L, w7 = 4.885026142432270781165E-3L; -static const long double zero = 0.0L; - +/* sin(pi*x) assuming x > 2^-1000, if sin(pi*x)==0 the sign is arbitrary */ static long double sin_pi(long double x) { - long double y, z; - int n, ix; - uint32_t se, i0, i1; + int n; - GET_LDOUBLE_WORDS(se, i0, i1, x); - ix = se & 0x7fff; - ix = (ix << 16) | (i0 >> 16); - if (ix < 0x3ffd8000) /* 0.25 */ - return sinl(pi * x); - y = -x; /* x is assume negative */ + /* spurious inexact if odd int */ + x *= 0.5; + x = 2.0*(x - floorl(x)); /* x mod 2.0 */ - /* - * argument reduction, make sure inexact flag not raised if input - * is an integer - */ - z = floorl(y); - if (z != y) { /* inexact anyway */ - y *= 0.5; - y = 2.0*(y - floorl(y));/* y = |x| mod 2.0 */ - n = (int) (y*4.0); - } else { - if (ix >= 0x403f8000) { /* 2^64 */ - y = zero; /* y must be even */ - n = 0; - } else { - if (ix < 0x403e8000) /* 2^63 */ - z = y + two63; /* exact */ - GET_LDOUBLE_WORDS(se, i0, i1, z); - n = i1 & 1; - y = n; - n <<= 2; - } - } + n = (int)(x*4.0); + n = (n+1)/2; + x -= n*0.5f; + x *= pi; switch (n) { - case 0: - y = sinl(pi * y); - break; - case 1: - case 2: - y = cosl(pi * (half - y)); - break; - case 3: - case 4: - y = sinl(pi * (one - y)); - break; - case 5: - case 6: - y = -cosl(pi * (y - 1.5)); - break; - default: - y = sinl(pi * (y - 2.0)); - break; + default: /* case 4: */ + case 0: return __sinl(x, 0.0, 0); + case 1: return __cosl(x, 0.0); + case 2: return __sinl(-x, 0.0, 0); + case 3: return -__cosl(x, 0.0); } - return -y; } long double __lgammal_r(long double x, int *sg) { long double t, y, z, nadj, p, p1, p2, q, r, w; - int i, ix; - uint32_t se, i0, i1; + union ldshape u = {x}; + uint32_t ix = (u.i.se & 0x7fffU)<<16 | u.i.m>>48; + int sign = u.i.se >> 15; + int i; *sg = 1; - GET_LDOUBLE_WORDS(se, i0, i1, x); - ix = se & 0x7fff; - if ((ix | i0 | i1) == 0) { - if (se & 0x8000) - *sg = -1; - return one / fabsl(x); - } - - ix = (ix << 16) | (i0 >> 16); - - /* purge off +-inf, NaN, +-0, and negative arguments */ + /* purge off +-inf, NaN, +-0, tiny and negative arguments */ if (ix >= 0x7fff0000) return x * x; - if (ix < 0x3fc08000) { /* |x|<2**-63, return -log(|x|) */ - if (se & 0x8000) { + if (sign) { *sg = -1; - return -logl(-x); + x = -x; } return -logl(x); } - if (se & 0x8000) { - t = sin_pi (x); - if (t == zero) - return one / fabsl(t); /* -integer */ - nadj = logl(pi / fabsl(t * x)); - if (t < zero) - *sg = -1; + if (sign) { x = -x; + t = sin_pi(x); + if (t == 0.0) + return 1.0 / (x-x); /* -integer */ + if (t > 0.0) + *sg = -1; + else + t = -t; + nadj = logl(pi / (t * x)); } - /* purge off 1 and 2 */ - if ((((ix - 0x3fff8000) | i0 | i1) == 0) || - (((ix - 0x40008000) | i0 | i1) == 0)) + /* purge off 1 and 2 (so the sign is ok with downward rounding) */ + if ((ix == 0x3fff8000 || ix == 0x40008000) && u.i.m == 0) { r = 0; - else if (ix < 0x40008000) { /* x < 2.0 */ + } else if (ix < 0x40008000) { /* x < 2.0 */ if (ix <= 0x3ffee666) { /* 8.99993896484375e-1 */ /* lgamma(x) = lgamma(x+1) - log(x) */ - r = -logl (x); + r = -logl(x); if (ix >= 0x3ffebb4a) { /* 7.31597900390625e-1 */ - y = x - one; + y = x - 1.0; i = 0; } else if (ix >= 0x3ffced33) { /* 2.31639862060546875e-1 */ - y = x - (tc - one); + y = x - (tc - 1.0); i = 1; } else { /* x < 0.23 */ y = x; i = 2; } } else { - r = zero; + r = 0.0; if (ix >= 0x3fffdda6) { /* 1.73162841796875 */ /* [1.7316,2] */ y = x - 2.0; @@ -329,7 +283,7 @@ long double __lgammal_r(long double x, int *sg) { i = 1; } else { /* [0.9, 1.23] */ - y = x - one; + y = x - 1.0; i = 2; } } @@ -337,7 +291,7 @@ long double __lgammal_r(long double x, int *sg) { case 0: p1 = a0 + y * (a1 + y * (a2 + y * (a3 + y * (a4 + y * a5)))); p2 = b0 + y * (b1 + y * (b2 + y * (b3 + y * (b4 + y)))); - r += half * y + y * p1/p2; + r += 0.5 * y + y * p1/p2; break; case 1: p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6))))); @@ -348,17 +302,17 @@ long double __lgammal_r(long double x, int *sg) { case 2: p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * (u5 + y * u6)))))); p2 = v0 + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * (v5 + y))))); - r += (-half * y + p1 / p2); + r += (-0.5 * y + p1 / p2); } } else if (ix < 0x40028000) { /* 8.0 */ /* x < 8.0 */ i = (int)x; - t = zero; y = x - (double)i; p = y * (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6)))))); q = r0 + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * (r6 + y)))))); - r = half * y + p / q; - z = one;/* lgamma(1+s) = log(s) + lgamma(s) */ + r = 0.5 * y + p / q; + z = 1.0; + /* lgamma(1+s) = log(s) + lgamma(s) */ switch (i) { case 7: z *= (y + 6.0); /* FALLTHRU */ @@ -370,24 +324,25 @@ long double __lgammal_r(long double x, int *sg) { z *= (y + 3.0); /* FALLTHRU */ case 3: z *= (y + 2.0); /* FALLTHRU */ - r += logl (z); + r += logl(z); break; } } else if (ix < 0x40418000) { /* 2^66 */ /* 8.0 <= x < 2**66 */ - t = logl (x); - z = one / x; + t = logl(x); + z = 1.0 / x; y = z * z; w = w0 + z * (w1 + y * (w2 + y * (w3 + y * (w4 + y * (w5 + y * (w6 + y * w7)))))); - r = (x - half) * (t - one) + w; + r = (x - 0.5) * (t - 1.0) + w; } else /* 2**66 <= x <= inf */ - r = x * (logl (x) - one); - if (se & 0x8000) + r = x * (logl(x) - 1.0); + if (sign) r = nadj - r; return r; } #endif +#if (LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024) || (LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384) extern int __signgam; long double lgammal(long double x) @@ -396,3 +351,4 @@ long double lgammal(long double x) } weak_alias(__lgammal_r, lgammal_r); +#endif