double
__tanh (double x)
{
double t, z;
int32_t jx, ix, lx;
/* High word of |x|. */
EXTRACT_WORDS (jx, lx, x);
ix = jx & 0x7fffffff;
/* x is INF or NaN */
if (ix >= 0x7ff00000)
{
if (jx >= 0)
return one / x + one; /* tanh(+-inf)=+-1 */
else
return one / x - one; /* tanh(NaN) = NaN */
}
/* |x| < 22 */
if (ix < 0x40360000) /* |x|<22 */
{
if ((ix | lx) == 0)
return x; /* x == +-0 */
if (ix < 0x3c800000) /* |x|<2**-55 */
{
if (fabs (x) < DBL_MIN)
{
double force_underflow = x * x;
math_force_eval (force_underflow);
}
return x * (one + x); /* tanh(small) = small */
}
if (ix >= 0x3ff00000) /* |x|>=1 */
{
t = __expm1 (two * fabs (x));
z = one - two / (t + two);
}
else
{
t = __expm1 (-two * fabs (x));
z = -t / (t + two);
}
/* |x| > 22, return +-1 */
}
else
{
z = one - tiny; /* raised inexact flag */
}
return (jx >= 0) ? z : -z;
}
double
__ieee754_cosh (double x)
{
double t, w;
int32_t ix;
u_int32_t lx;
/* High word of |x|. */
GET_HIGH_WORD (ix, x);
ix &= 0x7fffffff;
/* |x| in [0,22] */
if (ix < 0x40360000)
{
/* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
if (ix < 0x3fd62e43)
{
if (ix < 0x3c800000)
return one; /* cosh(tiny) = 1 */
t = __expm1 (fabs (x));
w = one + t;
return one + (t * t) / (w + w);
}
/* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */
t = __ieee754_exp (fabs (x));
return half * t + half / t;
}
/* |x| in [22, log(maxdouble)] return half*exp(|x|) */
if (ix < 0x40862e42)
return half * __ieee754_exp (fabs (x));
/* |x| in [log(maxdouble), overflowthresold] */
GET_LOW_WORD (lx, x);
if (ix < 0x408633ce || ((ix == 0x408633ce) && (lx <= (u_int32_t) 0x8fb9f87d)))
{
w = __ieee754_exp (half * fabs (x));
t = half * w;
return t * w;
}
/* x is INF or NaN */
if (ix >= 0x7ff00000)
return x * x;
/* |x| > overflowthresold, cosh(x) overflow */
return huge * huge;
}
Err mathlib_expm1(UInt16 refnum, double x, double *result) {
#pragma unused(refnum)
*result = __expm1(x);
return mlErrNone;
}
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
tanh (double __x)
{
return __expm1 (__x) * __sgn1 (-__x);
}