Add lgammal_r().

We already provide lgammaf_r() and lgamma_r(). It's not hard to also add
lgammal_r(), for consistency.

I am currently working on porting openlibm to an environment where
global state, and thus signgam, is not available. By adding lgammal_r(),
I can trivially disable support for signgam by just patching up
src/e_lgamma{f,,l}.c. That way there is no need to patch up the actual
algorithms.
This commit is contained in:
Ed Schouten 2015-01-08 11:23:28 +01:00
parent 24cec16fcc
commit 55ac462808
6 changed files with 37 additions and 23 deletions

View file

@ -16,7 +16,7 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*/ */
/* lgammal /* lgammal_r
* *
* Natural logarithm of gamma function * Natural logarithm of gamma function
* *
@ -24,10 +24,10 @@
* *
* SYNOPSIS: * SYNOPSIS:
* *
* long double x, y, lgammal(); * long double x, y, lgammal_r();
* extern int signgam; * int signgam;
* *
* y = lgammal(x); * y = lgammal_r(x, &signgam);
* *
* *
* *
@ -35,8 +35,7 @@
* *
* Returns the base e (2.718...) logarithm of the absolute * Returns the base e (2.718...) logarithm of the absolute
* value of the gamma function of the argument. * value of the gamma function of the argument.
* The sign (+1 or -1) of the gamma function is returned in a * The sign (+1 or -1) of the gamma function is returned through signgamp.
* global (extern) variable named signgam.
* *
* The positive domain is partitioned into numerous segments for approximation. * The positive domain is partitioned into numerous segments for approximation.
* For x > 10, * For x > 10,
@ -757,12 +756,12 @@ deval (long double x, const long double *p, int n)
long double long double
lgammal(long double x) lgammal_r(long double x, int *signgamp)
{ {
long double p, q, w, z, nx; long double p, q, w, z, nx;
int i, nn; int i, nn;
signgam = 1; *signgamp = 1;
if (! finite (x)) if (! finite (x))
return x * x; return x * x;
@ -770,7 +769,7 @@ lgammal(long double x)
if (x == 0.0L) if (x == 0.0L)
{ {
if (signbit (x)) if (signbit (x))
signgam = -1; *signgamp = -1;
return one / fabsl (x); return one / fabsl (x);
} }
@ -782,9 +781,9 @@ lgammal(long double x)
return (one / (p - p)); return (one / (p - p));
i = p; i = p;
if ((i & 1) == 0) if ((i & 1) == 0)
signgam = -1; *signgamp = -1;
else else
signgam = 1; *signgamp = 1;
z = q - p; z = q - p;
if (z > 0.5L) if (z > 0.5L)
{ {
@ -793,7 +792,7 @@ lgammal(long double x)
} }
z = q * sinl (PIL * z); z = q * sinl (PIL * z);
if (z == 0.0L) if (z == 0.0L)
return (signgam * huge * huge); return (*signgamp * huge * huge);
w = lgammal (q); w = lgammal (q);
z = logl (PIL / z) - w; z = logl (PIL / z) - w;
return (z); return (z);
@ -1025,7 +1024,7 @@ lgammal(long double x)
} }
if (x > MAXLGM) if (x > MAXLGM)
return (signgam * huge * huge); return (*signgamp * huge * huge);
q = ls2pi - x; q = ls2pi - x;
q = (x - 0.5L) * logl (x) + q; q = (x - 0.5L) * logl (x) + q;

View file

@ -1,6 +1,6 @@
$(CUR_SRCS) += invtrig.c \ $(CUR_SRCS) += invtrig.c \
e_acoshl.c e_powl.c k_tanl.c s_exp2l.c \ e_acoshl.c e_powl.c k_tanl.c s_exp2l.c \
e_atanhl.c e_lgammal.c e_sinhl.c s_asinhl.c s_expm1l.c \ e_atanhl.c e_lgammal_r.c e_sinhl.c s_asinhl.c s_expm1l.c \
e_coshl.c e_log10l.c e_tgammal.c \ e_coshl.c e_log10l.c e_tgammal.c \
e_expl.c e_log2l.c k_cosl.c s_log1pl.c s_tanhl.c \ e_expl.c e_log2l.c k_cosl.c s_log1pl.c s_tanhl.c \
e_logl.c k_sinl.c s_erfl.c e_logl.c k_sinl.c s_erfl.c

View file

@ -25,7 +25,7 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*/ */
/* lgammal(x) /* lgammal_r(x, signgamp)
* Reentrant version of the logarithm of the Gamma function * Reentrant version of the logarithm of the Gamma function
* with user provide pointer for the sign of Gamma(x). * with user provide pointer for the sign of Gamma(x).
* *
@ -89,7 +89,6 @@
#include <openlibm.h> #include <openlibm.h>
#include "math_private.h" #include "math_private.h"
extern int signgam;
static const long double static const long double
half = 0.5L, half = 0.5L,
@ -267,20 +266,20 @@ sin_pi(long double x)
long double long double
lgammal(long double x) lgammal_r(long double x, int *signgamp)
{ {
long double t, y, z, nadj, p, p1, p2, q, r, w; long double t, y, z, nadj, p, p1, p2, q, r, w;
int i, ix; int i, ix;
u_int32_t se, i0, i1; u_int32_t se, i0, i1;
signgam = 1; *signgamp = 1;
GET_LDOUBLE_WORDS (se, i0, i1, x); GET_LDOUBLE_WORDS (se, i0, i1, x);
ix = se & 0x7fff; ix = se & 0x7fff;
if ((ix | i0 | i1) == 0) if ((ix | i0 | i1) == 0)
{ {
if (se & 0x8000) if (se & 0x8000)
signgam = -1; *signgamp = -1;
return one / fabsl (x); return one / fabsl (x);
} }
@ -294,7 +293,7 @@ lgammal(long double x)
{ /* |x|<2**-63, return -log(|x|) */ { /* |x|<2**-63, return -log(|x|) */
if (se & 0x8000) if (se & 0x8000)
{ {
signgam = -1; *signgamp = -1;
return -logl (-x); return -logl (-x);
} }
else else
@ -307,7 +306,7 @@ lgammal(long double x)
return one / fabsl (t); /* -integer */ return one / fabsl (t); /* -integer */
nadj = logl (pi / fabsl (t * x)); nadj = logl (pi / fabsl (t * x));
if (t < zero) if (t < zero)
signgam = -1; *signgamp = -1;
x = -x; x = -x;
} }

View file

@ -4,7 +4,7 @@ $(CUR_SRCS) = common.c \
e_expf.c e_fmod.c e_fmodf.c e_gamma.c e_gamma_r.c e_gammaf.c \ e_expf.c e_fmod.c e_fmodf.c e_gamma.c e_gamma_r.c e_gammaf.c \
e_gammaf_r.c e_hypot.c e_hypotf.c e_j0.c e_j0f.c e_j1.c e_j1f.c \ e_gammaf_r.c e_hypot.c e_hypotf.c e_j0.c e_j0f.c e_j1.c e_j1f.c \
e_jn.c e_jnf.c e_lgamma.c e_lgamma_r.c e_lgammaf.c e_lgammaf_r.c \ e_jn.c e_jnf.c e_lgamma.c e_lgamma_r.c e_lgammaf.c e_lgammaf_r.c \
e_log.c e_log10.c e_log10f.c e_log2.c e_log2f.c e_logf.c \ e_lgammal.c e_log.c e_log10.c e_log10f.c e_log2.c e_log2f.c e_logf.c \
e_pow.c e_powf.c e_remainder.c e_remainderf.c e_scalb.c e_scalbf.c \ e_pow.c e_powf.c e_remainder.c e_remainderf.c e_scalb.c e_scalbf.c \
e_rem_pio2.c e_rem_pio2f.c \ e_rem_pio2.c e_rem_pio2f.c \
e_sinh.c e_sinhf.c e_sqrt.c e_sqrtf.c \ e_sinh.c e_sinhf.c e_sqrt.c e_sqrtf.c \

12
src/e_lgammal.c Normal file
View file

@ -0,0 +1,12 @@
#include "cdefs-compat.h"
#include "openlibm.h"
#include "math_private.h"
extern int signgam;
DLLEXPORT long double
lgammal(long double x)
{
return (lgammal_r(x, &signgam));
}

View file

@ -558,9 +558,13 @@ long double tanhl(long double);
long double tanl(long double); long double tanl(long double);
long double tgammal(long double); long double tgammal(long double);
long double truncl(long double); long double truncl(long double);
#endif /* __ISO_C_VISIBLE >= 1999 */ #endif /* __ISO_C_VISIBLE >= 1999 */
/* Reentrant version of lgammal. */
#if __BSD_VISIBLE
long double lgammal_r(long double, int *);
#endif /* __BSD_VISIBLE */
#include "openlibm_complex.h" #include "openlibm_complex.h"
#if defined(__cplusplus) #if defined(__cplusplus)