double
__ieee754_gamma_r (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. */
int32_t hx;
u_int32_t lx;
EXTRACT_WORDS (hx, lx, x);
if (((hx & 0x7fffffff) | lx) == 0)
{
/* Return value for x == 0 is NaN with invalid exception. */
*signgamp = 0;
return x / x;
}
if (hx < 0 && (u_int32_t) hx < 0xfff00000 && __rint (x) == x)
{
/* Return value for integer x < 0 is NaN with invalid exception. */
*signgamp = 0;
return (x - x) / (x - x);
}
if ((unsigned int) hx == 0xfff00000 && lx==0)
{
/* x == -Inf. According to ISO this is NaN. */
*signgamp = 0;
return x - x;
}
/* XXX FIXME. */
return __ieee754_exp (__ieee754_lgamma_r (x, signgamp));
}
double lgamma_r(double x, int *signgamp) /* wrapper lgamma_r */
{
#ifdef _IEEE_LIBM
return __ieee754_lgamma_r(x,signgamp);
#else
double y;
y = __ieee754_lgamma_r(x,signgamp);
if(_LIB_VERSION == _IEEE_) return y;
if(!finite(y)&&finite(x)) {
if(floor(x)==x&&x<=0.0)
return __kernel_standard(x,x,15); /* lgamma pole */
else
return __kernel_standard(x,x,14); /* lgamma overflow */
} else
return y;
#endif
}
DLLEXPORT double
__ieee754_lgamma(double x)
{
#ifdef OPENLIBM_ONLY_THREAD_SAFE
int signgam;
#endif
return __ieee754_lgamma_r(x,&signgam);
}
void
Math_lgamma(void *fp)
{
F_Math_lgamma *f;
f = fp;
f->ret->t1 = __ieee754_lgamma_r(f->x, &f->ret->t0);
}
double
gamma(double x)
{
#ifdef _IEEE_LIBM
return __ieee754_lgamma_r(x,&signgam);
#else
double y;
y = __ieee754_lgamma_r(x,&signgam);
if(_LIB_VERSION == _IEEE_) return y;
if(!finite(y)&&finite(x)) {
if(floor(x)==x&&x<=0.0)
return __kernel_standard(x,x,41); /* gamma pole */
else
return __kernel_standard(x,x,40); /* gamma overflow */
} else
return y;
#endif
}
double lgamma_r(double x, int *signgamp)
{
double y = __ieee754_lgamma_r(x, signgamp);
if (_LIB_VERSION == _IEEE_)
return y;
if (!isfinite(y) && isfinite(x)) {
if (floor(x) == x && x <= 0.0)
return __kernel_standard(x, x, 15); /* lgamma pole */
return __kernel_standard(x, x, 14); /* lgamma overflow */
}
return y;
}
double
__lgamma_r(double x, int *signgamp)
{
double y = __ieee754_lgamma_r(x,signgamp);
if(__builtin_expect(!__finite(y), 0)
&& __finite(x) && _LIB_VERSION != _IEEE_)
return __kernel_standard(x, x,
__floor(x)==x&&x<=0.0
? 15 /* lgamma pole */
: 14); /* lgamma overflow */
return y;
}
double
__lgamma(double x)
{
int local_signgam = 0;
double y = __ieee754_lgamma_r(x, &local_signgam);
//if(__builtin_expect(!__finite(y), 0)
// && __finite(x) && _LIB_VERSION != _IEEE_)
// return __kernel_standard(x, x,
// __floor(x)==x&&x<=0.0
// ? 15 /* lgamma pole */
// : 14); /* lgamma overflow */
return y;
}
double
__lgamma(double x)
{
int local_signgam = 0;
double y = __ieee754_lgamma_r(x,
_LIB_VERSION != _ISOC_
/* ISO C99 does not define the
global variable. */
? &signgam
: &local_signgam);
if(__builtin_expect(!__finite(y), 0)
&& __finite(x) && _LIB_VERSION != _IEEE_)
return __kernel_standard(x, x,
__floor(x)==x&&x<=0.0
? 15 /* lgamma pole */
: 14); /* lgamma overflow */
return y;
}
double
__ieee754_gamma_r(double x, int *signgamp)
{
return __ieee754_lgamma_r(x,signgamp);
}
double
__ieee754_lgamma(double x)
{
return __ieee754_lgamma_r(x,&signgam);
}
static double
gamma_positive (double x, int *exp2_adj)
{
int local_signgam;
if (x < 0.5)
{
*exp2_adj = 0;
return __ieee754_exp (__ieee754_lgamma_r (x + 1, &local_signgam)) / x;
}
else if (x <= 1.5)
{
*exp2_adj = 0;
return __ieee754_exp (__ieee754_lgamma_r (x, &local_signgam));
}
else if (x < 6.5)
{
/* Adjust into the range for using exp (lgamma). */
*exp2_adj = 0;
double n = __ceil (x - 1.5);
double x_adj = x - n;
double eps;
double prod = __gamma_product (x_adj, 0, n, &eps);
return (__ieee754_exp (__ieee754_lgamma_r (x_adj, &local_signgam))
* prod * (1.0 + eps));
}
else
{
double eps = 0;
double x_eps = 0;
double x_adj = x;
double prod = 1;
if (x < 12.0)
{
/* Adjust into the range for applying Stirling's
approximation. */
double n = __ceil (12.0 - x);
#if FLT_EVAL_METHOD != 0
volatile
#endif
double x_tmp = x + n;
x_adj = x_tmp;
x_eps = (x - (x_adj - n));
prod = __gamma_product (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. */
double exp_adj = -eps;
double x_adj_int = __round (x_adj);
double x_adj_frac = x_adj - x_adj_int;
int x_adj_log2;
double x_adj_mant = __frexp (x_adj, &x_adj_log2);
if (x_adj_mant < M_SQRT1_2)
{
x_adj_log2--;
x_adj_mant *= 2.0;
}
*exp2_adj = x_adj_log2 * (int) x_adj_int;
double ret = (__ieee754_pow (x_adj_mant, x_adj)
* __ieee754_exp2 (x_adj_log2 * x_adj_frac)
* __ieee754_exp (-x_adj)
* __ieee754_sqrt (2 * M_PI / x_adj)
/ prod);
exp_adj += x_eps * __ieee754_log (x);
double bsum = gamma_coeff[NCOEFF - 1];
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 * __expm1 (exp_adj);
}
}
//------------------------------------------------------------------------------
double Cmath::lgamma( double x )
{
double y;
struct fexception exc;
y = __ieee754_lgamma_r( x, &m_isigngam );
if( m_fdlib_version == _IEEE_ )
{
return y;
}
if( !finite( y ) && finite( x ) )
{
# ifndef HUGE_VAL
# define HUGE_VAL inf
double inf = 0.0;
set_high_word( inf, 0x7ff00000 ); // set inf to infinite
# endif
exc.name = "lgamma";
exc.err = 0;
exc.arg1 = x;
exc.arg2 = x;
if( m_fdlib_version == _SVID_ )
{
exc.retval = Huge();
}
else
{
exc.retval = HUGE_VAL;
}
if( floor( x ) == x && x <= 0.0 )
{
// lgamma(-integer)
exc.type = EX_SING;
if( m_fdlib_version == _POSIX_ )
{
errno = EDOM;
}
else if( !matherr( &exc ) )
{
errno = EDOM;
}
}
else
{
// lgamma(finite) overflow
exc.type = EX_OVERFLOW;
if( m_fdlib_version == _POSIX_ )
{
errno = ERANGE;
}
else if( !matherr( &exc ) )
{
errno = ERANGE;
}
}
if( exc.err != 0 )
{
errno = exc.err;
}
return exc.retval;
}
else
{
return y;
}
}