* sysdeps/ieee754/ldbl-96/e_lgammal_r.c: New file.
	Contributed by Stephen L. Moshier <moshier@na-net.ornl.gov>.

	* sysdeps/ieee754/ldbl-96/e_gammal_r.c: Fix handling of boundary cases.

	* sysdeps/ieee754/dbl-64/e_gamma_r.c: Always initialize sign variable.
	* sysdeps/ieee754/flt-32/e_gammaf_r.c: Likewise.

	* sysdeps/i386/fpu/libm-test-ulps: Adjust after addition of lgammal.
This commit is contained in:
Ulrich Drepper 2001-03-04 19:25:06 +00:00
parent 73807ef933
commit 3bde1a69c1
6 changed files with 462 additions and 8 deletions

View File

@ -1,5 +1,15 @@
2001-03-04 Ulrich Drepper <drepper@redhat.com>
* sysdeps/ieee754/ldbl-96/e_lgammal_r.c: New file.
Contributed by Stephen L. Moshier <moshier@na-net.ornl.gov>.
* sysdeps/ieee754/ldbl-96/e_gammal_r.c: Fix handling of boundary cases.
* sysdeps/ieee754/dbl-64/e_gamma_r.c: Always initialize sign variable.
* sysdeps/ieee754/flt-32/e_gammaf_r.c: Likewise.
* sysdeps/i386/fpu/libm-test-ulps: Adjust after addition of lgammal.
* sysdeps/unix/sysv/linux/ia64/bits/siginfo.h: Fix typo in last change.
2001-03-04 Andreas Jaeger <aj@suse.de>

View File

@ -598,6 +598,8 @@ ldouble: 4096
Test "gamma (-0.5) == log(2*sqrt(pi))":
double: 1
idouble: 1
ldouble: 1
ildouble: 1
# hypot
Test "hypot (-0.7, -12.4) == 12.419742348374220601176836866763271":
@ -772,6 +774,8 @@ ildouble: 1
Test "lgamma (-0.5) == log(2*sqrt(pi))":
double: 1
idouble: 1
ldouble: 1
ildouble: 1
Test "lgamma (0.7) == 0.26086724653166651439":
double: 1
float: 1
@ -782,6 +786,8 @@ double: 1
float: 2
idouble: 1
ifloat: 2
ldouble: 1
ildouble: 1
# log
Test "log (1.0 / M_El) == -1":
@ -906,6 +912,8 @@ double: 2
float: 1
idouble: 2
ifloat: 1
ldouble: 2
ildouble: 2
Test "tgamma (0.5) == sqrt (pi)":
float: 1
ifloat: 1
@ -1439,6 +1447,8 @@ ldouble: 4096
Function: "gamma":
double: 1
idouble: 1
ldouble: 1
ildouble: 1
Function: "hypot":
double: 1
@ -1473,6 +1483,8 @@ double: 1
float: 2
idouble: 1
ifloat: 2
ldouble: 1
ildouble: 1
Function: "log":
double: 1
@ -1547,6 +1559,8 @@ double: 2
float: 1
idouble: 2
ifloat: 1
ldouble: 2
ildouble: 2
Function: "y0":
double: 3

View File

@ -1,5 +1,5 @@
/* Implementation of gamma function according to ISO C.
Copyright (C) 1997, 1999 Free Software Foundation, Inc.
Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997.
@ -46,8 +46,11 @@ __ieee754_gamma_r (double x, int *signgamp)
return (x - x) / (x - x);
}
if ((unsigned int) hx == 0xfff00000 && lx==0)
/* x == -Inf. According to ISO this is NaN. */
return x - x;
{
/* x == -Inf. According to ISO this is NaN. */
*signgamp = 0;
return x - x;
}
/* XXX FIXME. */
return __ieee754_exp (__ieee754_lgamma_r (x, signgamp));

View File

@ -1,5 +1,5 @@
/* Implementation of gamma function according to ISO C.
Copyright (C) 1997, 1999 Free Software Foundation, Inc.
Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997.
@ -45,8 +45,11 @@ __ieee754_gammaf_r (float x, int *signgamp)
return (x - x) / (x - x);
}
if (hx == 0xff800000)
/* x == -Inf. According to ISO this is NaN. */
return x - x;
{
/* x == -Inf. According to ISO this is NaN. */
*signgamp = 0;
return x - x;
}
/* XXX FIXME. */
return __ieee754_expf (__ieee754_lgammaf_r (x, signgamp));

View File

@ -1,5 +1,5 @@
/* Implementation of gamma function according to ISO C.
Copyright (C) 1997, 1999 Free Software Foundation, Inc.
Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997.
@ -38,12 +38,18 @@ __ieee754_gammal_r (long double x, int *signgamp)
*signgamp = 0;
return x / x;
}
if ((hx & 0x8000) != 0 && (hx & 0x7fff) != 0x7fff && __rintl (x) == 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);
}
if (es == 0xffffffff && ((hx & 0x7fffffff) | lx) == 0)
{
/* x == -Inf. According to ISO this is NaN. */
*signgamp = 0;
return x - x;
}
/* XXX FIXME. */
return __ieee754_expl (__ieee754_lgammal_r (x, signgamp));

View File

@ -0,0 +1,418 @@
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunPro, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* Long double expansions contributed by
Stephen L. Moshier <moshier@na-net.ornl.gov> */
/* __ieee754_lgammal_r(x, signgamp)
* Reentrant version of the logarithm of the Gamma function
* with user provide pointer for the sign of Gamma(x).
*
* Method:
* 1. Argument Reduction for 0 < x <= 8
* Since gamma(1+s)=s*gamma(s), for x in [0,8], we may
* reduce x to a number in [1.5,2.5] by
* lgamma(1+s) = log(s) + lgamma(s)
* for example,
* lgamma(7.3) = log(6.3) + lgamma(6.3)
* = log(6.3*5.3) + lgamma(5.3)
* = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3)
* 2. Polynomial approximation of lgamma around its
* minimun ymin=1.461632144968362245 to maintain monotonicity.
* On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use
* Let z = x-ymin;
* lgamma(x) = -1.214862905358496078218 + z^2*poly(z)
* 2. Rational approximation in the primary interval [2,3]
* We use the following approximation:
* s = x-2.0;
* lgamma(x) = 0.5*s + s*P(s)/Q(s)
* Our algorithms are based on the following observation
*
* zeta(2)-1 2 zeta(3)-1 3
* lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ...
* 2 3
*
* where Euler = 0.5771... is the Euler constant, which is very
* close to 0.5.
*
* 3. For x>=8, we have
* lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+....
* (better formula:
* lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...)
* Let z = 1/x, then we approximation
* f(z) = lgamma(x) - (x-0.5)(log(x)-1)
* by
* 3 5 11
* w = w0 + w1*z + w2*z + w3*z + ... + w6*z
*
* 4. For negative x, since (G is gamma function)
* -x*G(-x)*G(x) = pi/sin(pi*x),
* we have
* G(x) = pi/(sin(pi*x)*(-x)*G(-x))
* since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0
* Hence, for x<0, signgam = sign(sin(pi*x)) and
* lgamma(x) = log(|Gamma(x)|)
* = log(pi/(|x*sin(pi*x)|)) - lgamma(-x);
* Note: one should avoid compute pi*(-x) directly in the
* computation of sin(pi*(-x)).
*
* 5. Special Cases
* lgamma(2+s) ~ s*(1-Euler) for tiny s
* lgamma(1)=lgamma(2)=0
* lgamma(x) ~ -log(x) for tiny x
* lgamma(0) = lgamma(inf) = inf
* lgamma(-integer) = +-inf
*
*/
#include "math.h"
#include "math_private.h"
#ifdef __STDC__
static const long double
#else
static long double
#endif
half = 0.5L,
one = 1.0L,
pi = 3.14159265358979323846264L,
/* lgam(1+x) = 0.5 x + x a(x)/b(x)
-0.268402099609375 <= x <= 0
peak relative error 6.6e-22 */
a0 = -6.343246574721079391729402781192128239938E2L,
a1 = 1.856560238672465796768677717168371401378E3L,
a2 = 2.404733102163746263689288466865843408429E3L,
a3 = 8.804188795790383497379532868917517596322E2L,
a4 = 1.135361354097447729740103745999661157426E2L,
a5 = 3.766956539107615557608581581190400021285E0L,
b0 = 8.214973713960928795704317259806842490498E3L,
b1 = 1.026343508841367384879065363925870888012E4L,
b2 = 4.553337477045763320522762343132210919277E3L,
b3 = 8.506975785032585797446253359230031874803E2L,
b4 = 6.042447899703295436820744186992189445813E1L,
/* b5 = 1.000000000000000000000000000000000000000E0 */
tc = 1.4616321449683623412626595423257213284682E0L,
tf = -1.2148629053584961146050602565082954242826E-1,/* double precision */
/* tt = (tail of tf), i.e. tf + tt has extended precision. */
tt = 3.3649914684731379602768989080467587736363E-18L,
/* lgam ( 1.4616321449683623412626595423257213284682E0 ) =
-1.2148629053584960809551455717769158215135617312999903886372437313313530E-1 */
/* lgam (x + tc) = tf + tt + x g(x)/h(x)
- 0.230003726999612341262659542325721328468 <= x
<= 0.2699962730003876587373404576742786715318
peak relative error 2.1e-21 */
g0 = 3.645529916721223331888305293534095553827E-18L,
g1 = 5.126654642791082497002594216163574795690E3L,
g2 = 8.828603575854624811911631336122070070327E3L,
g3 = 5.464186426932117031234820886525701595203E3L,
g4 = 1.455427403530884193180776558102868592293E3L,
g5 = 1.541735456969245924860307497029155838446E2L,
g6 = 4.335498275274822298341872707453445815118E0L,
h0 = 1.059584930106085509696730443974495979641E4L,
h1 = 2.147921653490043010629481226937850618860E4L,
h2 = 1.643014770044524804175197151958100656728E4L,
h3 = 5.869021995186925517228323497501767586078E3L,
h4 = 9.764244777714344488787381271643502742293E2L,
h5 = 6.442485441570592541741092969581997002349E1L,
/* h6 = 1.000000000000000000000000000000000000000E0 */
/* lgam (x+1) = -0.5 x + x u(x)/v(x)
-0.100006103515625 <= x <= 0.231639862060546875
peak relative error 1.3e-21 */
u0 = -8.886217500092090678492242071879342025627E1L,
u1 = 6.840109978129177639438792958320783599310E2L,
u2 = 2.042626104514127267855588786511809932433E3L,
u3 = 1.911723903442667422201651063009856064275E3L,
u4 = 7.447065275665887457628865263491667767695E2L,
u5 = 1.132256494121790736268471016493103952637E2L,
u6 = 4.484398885516614191003094714505960972894E0L,
v0 = 1.150830924194461522996462401210374632929E3L,
v1 = 3.399692260848747447377972081399737098610E3L,
v2 = 3.786631705644460255229513563657226008015E3L,
v3 = 1.966450123004478374557778781564114347876E3L,
v4 = 4.741359068914069299837355438370682773122E2L,
v5 = 4.508989649747184050907206782117647852364E1L,
/* v6 = 1.000000000000000000000000000000000000000E0 */
/* lgam (x+2) = .5 x + x s(x)/r(x)
0 <= x <= 1
peak relative error 7.2e-22 */
s0 = 1.454726263410661942989109455292824853344E6L,
s1 = -3.901428390086348447890408306153378922752E6L,
s2 = -6.573568698209374121847873064292963089438E6L,
s3 = -3.319055881485044417245964508099095984643E6L,
s4 = -7.094891568758439227560184618114707107977E5L,
s5 = -6.263426646464505837422314539808112478303E4L,
s6 = -1.684926520999477529949915657519454051529E3L,
r0 = -1.883978160734303518163008696712983134698E7L,
r1 = -2.815206082812062064902202753264922306830E7L,
r2 = -1.600245495251915899081846093343626358398E7L,
r3 = -4.310526301881305003489257052083370058799E6L,
r4 = -5.563807682263923279438235987186184968542E5L,
r5 = -3.027734654434169996032905158145259713083E4L,
r6 = -4.501995652861105629217250715790764371267E2L,
/* r6 = 1.000000000000000000000000000000000000000E0 */
/* lgam(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x w(1/x^2)
x >= 8
Peak relative error 1.51e-21
w0 = LS2PI - 0.5 */
w0 = 4.189385332046727417803e-1L,
w1 = 8.333333333333331447505E-2L,
w2 = -2.777777777750349603440E-3L,
w3 = 7.936507795855070755671E-4L,
w4 = -5.952345851765688514613E-4L,
w5 = 8.412723297322498080632E-4L,
w6 = -1.880801938119376907179E-3L,
w7 = 4.885026142432270781165E-3L;
#ifdef __STDC__
static const long double zero = 0.0L;
#else
static long double zero = 0.0L;
#endif
#ifdef __STDC__
static long double
sin_pi (long double x)
#else
static long double
sin_pi (x)
long double x;
#endif
{
long double y, z;
int n, ix;
u_int32_t se, i0, i1;
GET_LDOUBLE_WORDS (se, i0, i1, x);
ix = se & 0x7fff;
i1 = (ix << 16) | (i0 >> 16);
if (ix < 0x3ffd8000) /* 0.25 */
return __sinl (pi * x);
y = -x; /* x is assume negative */
/*
* argument reduction, make sure inexact flag not raised if input
* is an integer
*/
z = __floorl (y);
if (z != y)
{ /* inexact anyway */
y *= half;
y = 2.0 * (y - __floorl (y)); /* y = |x| mod 2.0 */
n = (int) (y * 4.0);
}
else
{
return (zero + zero);
}
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;
}
return -y;
}
#ifdef __STDC__
long double
__ieee754_lgammal_r (long double x, int *signgamp)
#else
long double
__ieee754_lgammal_r (x, signgamp)
long double x;
int *signgamp;
#endif
{
long double t, y, z, nadj, p, p1, p2, q, r, w;
int i, ix;
u_int32_t se, i0, i1;
GET_LDOUBLE_WORDS (se, i0, i1, x);
ix = se & 0x7fff;
if ((ix | i0 | i1) == 0)
return one / fabsl (x);
ix = (ix << 16) | (i0 >> 16);
/* purge off +-inf, NaN, +-0, and negative arguments */
*signgamp = 1;
if (ix >= 0x7fff0000)
return x * x;
if (ix < 0x3fc08000) /* 2^-63 */
{ /* |x|<2**-63, return -log(|x|) */
if (se & 0x8000)
{
*signgamp = -1;
return -__ieee754_logl (-x);
}
else
return -__ieee754_logl (x);
}
if (se & 0x8000)
{
if (x == __floorl(x))
return x / zero;
t = sin_pi (x);
if (t == zero)
return one / fabsl (t); /* -integer */
nadj = __ieee754_logl (pi / fabsl (t * x));
if (t < zero)
*signgamp = -1;
x = -x;
}
/* purge off 1 and 2 */
if ((((ix - 0x3fff8000) | i0 | i1) == 0)
|| (((ix - 0x40008000) | i0 | i1) == 0))
r = 0;
else if (ix < 0x40008000) /* 2.0 */
{
/* x < 2.0 */
if (ix <= 0x3ffee666) /* 8.99993896484375e-1 */
{
/* lgamma(x) = lgamma(x+1) - log(x) */
r = -__ieee754_logl (x);
if (ix >= 0x3ffebb4a) /* 7.31597900390625e-1 */
{
y = x - one;
i = 0;
}
else if (ix >= 0x3ffced33)/* 2.31639862060546875e-1 */
{
y = x - (tc - one);
i = 1;
}
else
{
/* x < 0.23 */
y = x;
i = 2;
}
}
else
{
r = zero;
if (ix >= 0x3fffdda6) /* 1.73162841796875 */
{
/* [1.7316,2] */
y = x - 2.0;
i = 0;
}
else if (ix >= 0x3fff9da6)/* 1.23162841796875 */
{
/* [1.23,1.73] */
y = x - tc;
i = 1;
}
else
{
/* [0.9, 1.23] */
y = x - one;
i = 2;
}
}
switch (i)
{
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;
break;
case 1:
p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6)))));
p2 = h0 + y * (h1 + y * (h2 + y * (h3 + y * (h4 + y * (h5 + y)))));
p = tt + y * p1/p2;
r += (tf + p);
break;
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);
}
}
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) */
switch (i)
{
case 7:
z *= (y + 6.0); /* FALLTHRU */
case 6:
z *= (y + 5.0); /* FALLTHRU */
case 5:
z *= (y + 4.0); /* FALLTHRU */
case 4:
z *= (y + 3.0); /* FALLTHRU */
case 3:
z *= (y + 2.0); /* FALLTHRU */
r += __ieee754_logl (z);
break;
}
}
else if (ix < 0x40418000) /* 2^66 */
{
/* 8.0 <= x < 2**66 */
t = __ieee754_logl (x);
z = one / 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;
}
else
/* 2**66 <= x <= inf */
r = x * (__ieee754_logl (x) - one);
if (se & 0x8000)
r = nadj - r;
return r;
}