float __nexttowardf(float x, long double y)
{
int32_t hx,ix;
int64_t hy,iy;
double yhi;
GET_FLOAT_WORD(hx,x);
yhi = ldbl_high (y);
EXTRACT_WORDS64 (hy, yhi);
ix = hx&0x7fffffff; /* |x| */
iy = hy&0x7fffffffffffffffLL; /* |y| */
if((ix>0x7f800000) || /* x is nan */
(iy>0x7ff0000000000000LL))
/* y is nan */
return x+y;
if((long double) x==y) return y; /* x=y, return y */
if(ix==0) { /* x == 0 */
float u;
SET_FLOAT_WORD(x,(u_int32_t)((hy>>32)&0x80000000)|1);/* return +-minsub*/
u = math_opt_barrier (x);
u = u * u;
math_force_eval (u); /* raise underflow flag */
return x;
}
long double __asinhl(long double x)
{
long double t,w;
int64_t hx,ix;
double xhi;
xhi = ldbl_high (x);
EXTRACT_WORDS64 (hx, xhi);
ix = hx&0x7fffffffffffffffLL;
if(ix>=0x7ff0000000000000LL) return x+x; /* x is inf or NaN */
if(ix< 0x3c70000000000000LL) { /* |x|<2**-56 */
math_check_force_underflow (x);
if(huge+x>one) return x; /* return x inexact except 0 */
}
if(ix>0x4370000000000000LL) { /* |x| > 2**56 */
w = __ieee754_logl(fabsl(x))+ln2;
} else if (ix>0x4000000000000000LL) { /* 2**56 >= |x| > 2.0 */
t = fabs(x);
w = __ieee754_logl(2.0*t+one/(sqrtl(x*x+one)+t));
} else { /* 2.0 >= |x| >= 2**-56 */
t = x*x;
w =__log1pl(fabsl(x)+t/(one+sqrtl(one+t)));
}
if(hx>0) return w; else return -w;
}
double __nexttoward(double x, long double y)
{
int32_t hx,ix;
int64_t hy,iy;
uint32_t lx;
double yhi;
EXTRACT_WORDS(hx,lx,x);
yhi = ldbl_high (y);
EXTRACT_WORDS64(hy,yhi);
ix = hx&0x7fffffff; /* |x| */
iy = hy&0x7fffffffffffffffLL; /* |y| */
if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */
iy>0x7ff0000000000000LL) /* y is nan */
return x+y;
if((long double) x==y) return y; /* x=y, return y */
if((ix|lx)==0) { /* x == 0 */
double u;
INSERT_WORDS(x,(uint32_t)((hy>>32)&0x80000000),1);/* return +-minsub */
u = math_opt_barrier (x);
u = u * u;
math_force_eval (u); /* raise underflow flag */
return x;
}
int
__issignalingl (long double x)
{
uint64_t xi;
/* For inspecting NaN status, we only have to look at the first of the pair
of IEEE 754 64-bit precision numbers. */
double xhi;
xhi = ldbl_high (x);
EXTRACT_WORDS64 (xi, xhi);
#ifdef HIGH_ORDER_BIT_IS_SET_FOR_SNAN
# error untested
/* We only have to care about the high-order bit of x's significand, because
having it set (sNaN) already makes the significand different from that
used to designate infinity. */
return (xi & UINT64_C (0x7ff8000000000000)) == UINT64_C (0x7ff8000000000000);
#else
/* To keep the following comparison simple, toggle the quiet/signaling bit,
so that it is set for sNaNs. This is inverse to IEEE 754-2008 (as well as
common practice for IEEE 754-1985). */
xi ^= UINT64_C (0x0008000000000000);
/* We have to compare for greater (instead of greater or equal), because x's
significand being all-zero designates infinity not NaN. */
return (xi & UINT64_C (0x7fffffffffffffff)) > UINT64_C (0x7ff8000000000000);
#endif
}
int
___signbitl (long double x)
{
int64_t e;
double xhi;
xhi = ldbl_high (x);
EXTRACT_WORDS64 (e, xhi);
return e < 0;
}
long double
getpayloadl (const long double *x)
{
double xhi = ldbl_high (*x);
uint64_t ix;
EXTRACT_WORDS64 (ix, xhi);
ix &= 0x7ffffffffffffULL;
if (FIX_INT_FP_CONVERT_ZERO && ix == 0)
return 0.0L;
return (long double) ix;
}
int
___finitel (long double x)
{
uint64_t hx;
double xhi;
xhi = ldbl_high (x);
EXTRACT_WORDS64 (hx, xhi);
hx &= 0x7fffffffffffffffLL;
hx -= 0x7ff0000000000000LL;
return hx >> 63;
}
long double
__ieee754_sinhl(long double x)
{
long double t,w,h;
int64_t ix,jx;
double xhi;
/* High word of |x|. */
xhi = ldbl_high (x);
EXTRACT_WORDS64 (jx, xhi);
ix = jx&0x7fffffffffffffffLL;
/* x is INF or NaN */
if(ix>=0x7ff0000000000000LL) return x+x;
h = 0.5;
if (jx<0) h = -h;
/* |x| in [0,40], return sign(x)*0.5*(E+E/(E+1))) */
if (ix < 0x4044000000000000LL) { /* |x|<40 */
if (ix<0x3c90000000000000LL) { /* |x|<2**-54 */
math_check_force_underflow (x);
if(shuge+x>one) return x;/* sinhl(tiny) = tiny with inexact */
}
t = __expm1l(fabsl(x));
if(ix<0x3ff0000000000000LL) return h*(2.0*t-t*t/(t+one));
w = t/(t+one);
return h*(t+w);
}
/* |x| in [40, log(maxdouble)] return 0.5*exp(|x|) */
if (ix < 0x40862e42fefa39efLL) return h*__ieee754_expl(fabsl(x));
/* |x| in [log(maxdouble), overflowthresold] */
if (ix <= 0x408633ce8fb9f87eLL) {
w = __ieee754_expl(0.5*fabsl(x));
t = h*w;
return t*w;
}
/* |x| > overflowthresold, sinh(x) overflow */
return x*shuge;
}
long double __tanhl(long double x)
{
long double t,z;
int64_t jx,ix;
double xhi;
/* High word of |x|. */
xhi = ldbl_high (x);
EXTRACT_WORDS64 (jx, xhi);
ix = jx&0x7fffffffffffffffLL;
/* x is INF or NaN */
if(ix>=0x7ff0000000000000LL) {
if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */
else return one/x-one; /* tanh(NaN) = NaN */
}
/* |x| < 40 */
if (ix < 0x4044000000000000LL) { /* |x|<40 */
if (ix == 0)
return x; /* x == +-0 */
if (ix<0x3c60000000000000LL) /* |x|<2**-57 */
{
math_check_force_underflow (x);
return x; /* tanh(small) = small */
}
if (ix>=0x3ff0000000000000LL) { /* |x|>=1 */
t = __expm1l(two*fabsl(x));
z = one - two/(t+two);
} else {
t = __expm1l(-two*fabsl(x));
z= -t/(t+two);
}
/* |x| > 40, return +-1 */
} else {
z = one - tiny; /* raised inexact flag */
}
return (jx>=0)? z: -z;
}
long double
__ieee754_log10l (long double x)
{
long double z;
long double y;
int e;
int64_t hx;
double xhi;
/* Test for domain */
xhi = ldbl_high (x);
EXTRACT_WORDS64 (hx, xhi);
if ((hx & 0x7fffffffffffffffLL) == 0)
return (-1.0L / (x - x));
if (hx < 0)
return (x - x) / (x - x);
if (hx >= 0x7ff0000000000000LL)
return (x + x);
if (x == 1.0L)
return 0.0L;
/* separate mantissa from exponent */
/* Note, frexp is used so that denormal numbers
* will be handled properly.
*/
x = __frexpl (x, &e);
/* logarithm using log(x) = z + z**3 P(z)/Q(z),
* where z = 2(x-1)/x+1)
*/
if ((e > 2) || (e < -2))
{
if (x < SQRTH)
{ /* 2( 2x-1 )/( 2x+1 ) */
e -= 1;
z = x - 0.5L;
y = 0.5L * z + 0.5L;
}
else
{ /* 2 (x-1)/(x+1) */
z = x - 0.5L;
z -= 0.5L;
y = 0.5L * x + 0.5L;
}
x = z / y;
z = x * x;
y = x * (z * neval (z, R, 5) / deval (z, S, 5));
goto done;
}
/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
if (x < SQRTH)
{
e -= 1;
x = 2.0 * x - 1.0L; /* 2x - 1 */
}
else
{
x = x - 1.0L;
}
z = x * x;
y = x * (z * neval (x, P, 12) / deval (x, Q, 11));
y = y - 0.5 * z;
done:
/* Multiply log of fraction by log10(e)
* and base 2 exponent by log10(2).
*/
z = y * L10EB;
z += x * L10EB;
z += e * L102B;
z += y * L10EA;
z += x * L10EA;
z += e * L102A;
return (z);
}
long double
__atanl (long double x)
{
int32_t k, sign, lx;
long double t, u, p, q;
double xhi;
xhi = ldbl_high (x);
EXTRACT_WORDS (k, lx, xhi);
sign = k & 0x80000000;
/* Check for IEEE special cases. */
k &= 0x7fffffff;
if (k >= 0x7ff00000)
{
/* NaN. */
if (((k - 0x7ff00000) | lx) != 0)
return (x + x);
/* Infinity. */
if (sign)
return -atantbl[83];
else
return atantbl[83];
}
if (k <= 0x3c800000) /* |x| <= 2**-55. */
{
math_check_force_underflow (x);
/* Raise inexact. */
if (1e300L + x > 0.0)
return x;
}
if (k >= 0x46c00000) /* |x| >= 2**109. */
{
/* Saturate result to {-,+}pi/2. */
if (sign)
return -atantbl[83];
else
return atantbl[83];
}
if (sign)
x = -x;
if (k >= 0x40248000) /* 10.25 */
{
k = 83;
t = -1.0/x;
}
else
{
/* Index of nearest table element.
Roundoff to integer is asymmetrical to avoid cancellation when t < 0
(cf. fdlibm). */
k = 8.0 * x + 0.25;
u = 0.125 * k;
/* Small arctan argument. */
t = (x - u) / (1.0 + x * u);
}
/* Arctan of small argument t. */
u = t * t;
p = ((((p4 * u) + p3) * u + p2) * u + p1) * u + p0;
q = ((((u + q4) * u + q3) * u + q2) * u + q1) * u + q0;
u = t * u * p / q + t;
/* arctan x = arctan u + arctan t */
u = atantbl[k] + u;
if (sign)
return (-u);
else
return u;
}
long double
__kernel_tanl (long double x, long double y, int iy)
{
long double z, r, v, w, s;
int32_t ix, sign, hx, lx;
double xhi;
xhi = ldbl_high (x);
EXTRACT_WORDS (hx, lx, xhi);
ix = hx & 0x7fffffff;
if (ix < 0x3c600000) /* x < 2**-57 */
{
if ((int) x == 0) /* generate inexact */
{
if ((ix | lx | (iy + 1)) == 0)
return one / fabs (x);
else if (iy == 1)
{
math_check_force_underflow (x);
return x;
}
else
return -one / x;
}
}
if (ix >= 0x3fe59420) /* |x| >= 0.6743316650390625 */
{
if ((hx & 0x80000000) != 0)
{
x = -x;
y = -y;
sign = -1;
}
else
sign = 1;
z = pio4hi - x;
w = pio4lo - y;
x = z + w;
y = 0.0;
}
z = x * x;
r = T0 + z * (T1 + z * (T2 + z * (T3 + z * T4)));
v = U0 + z * (U1 + z * (U2 + z * (U3 + z * (U4 + z))));
r = r / v;
s = z * x;
r = y + z * (s * r + y);
r += TH * s;
w = x + r;
if (ix >= 0x3fe59420)
{
v = (long double) iy;
w = (v - 2.0 * (x - (w * w / (w + v) - r)));
/* SIGN is set for arguments that reach this code, but not
otherwise, resulting in warnings that it may be used
uninitialized although in the cases where it is used it has
always been set. */
DIAG_PUSH_NEEDS_COMMENT;
DIAG_IGNORE_NEEDS_COMMENT (5, "-Wmaybe-uninitialized");
if (sign < 0)
w = -w;
DIAG_POP_NEEDS_COMMENT;
return w;
}
if (iy == 1)
return w;
else
{ /* if allow error up to 2 ulp,
simply return -1.0/(x+r) here */
/* compute -1.0/(x+r) accurately */
long double u1, z1;
u1 = ldbl_high (w);
v = r - (u1 - x); /* u1+v = r+x */
z = -1.0 / w;
z1 = ldbl_high (z);
s = 1.0 + z1 * u1;
return z1 + z * (s + z1 * v);
}
}
long double
__ieee754_gammal_r (long double x, int *signgamp)
{
int64_t hx;
double xhi;
long double ret;
xhi = ldbl_high (x);
EXTRACT_WORDS64 (hx, xhi);
if ((hx & 0x7fffffffffffffffLL) == 0)
{
/* Return value for x == 0 is Inf with divide by zero exception. */
*signgamp = 0;
return 1.0 / x;
}
if (hx < 0 && (u_int64_t) hx < 0xfff0000000000000ULL && __rintl (x) == x)
{
/* Return value for integer x < 0 is NaN with invalid exception. */
*signgamp = 0;
return (x - x) / (x - x);
}
if (hx == 0xfff0000000000000ULL)
{
/* x == -Inf. According to ISO this is NaN. */
*signgamp = 0;
return x - x;
}
if ((hx & 0x7ff0000000000000ULL) == 0x7ff0000000000000ULL)
{
/* Positive infinity (return positive infinity) or NaN (return
NaN). */
*signgamp = 0;
return x + x;
}
if (x >= 172.0L)
{
/* Overflow. */
*signgamp = 0;
return LDBL_MAX * LDBL_MAX;
}
else
{
SET_RESTORE_ROUNDL (FE_TONEAREST);
if (x > 0.0L)
{
*signgamp = 0;
int exp2_adj;
ret = gammal_positive (x, &exp2_adj);
ret = __scalbnl (ret, exp2_adj);
}
else if (x >= -0x1p-110L)
{
*signgamp = 0;
ret = 1.0L / x;
}
else
{
long double tx = __truncl (x);
*signgamp = (tx == 2.0L * __truncl (tx / 2.0L)) ? -1 : 1;
if (x <= -191.0L)
/* Underflow. */
ret = LDBL_MIN * LDBL_MIN;
else
{
long double frac = tx - x;
if (frac > 0.5L)
frac = 1.0L - frac;
long double sinpix = (frac <= 0.25L
? __sinl (M_PIl * frac)
: __cosl (M_PIl * (0.5L - frac)));
int exp2_adj;
ret = M_PIl / (-x * sinpix
* gammal_positive (-x, &exp2_adj));
ret = __scalbnl (ret, -exp2_adj);
if (ret < LDBL_MIN)
{
long double force_underflow = ret * ret;
math_force_eval (force_underflow);
}
}
}
}
if (isinf (ret) && x != 0)
{
if (*signgamp < 0)
return -(-__copysignl (LDBL_MAX, ret) * LDBL_MAX);
else
return __copysignl (LDBL_MAX, ret) * LDBL_MAX;
}
else if (ret == 0)
{
if (*signgamp < 0)
return -(-__copysignl (LDBL_MIN, ret) * LDBL_MIN);
else
return __copysignl (LDBL_MIN, ret) * LDBL_MIN;
}
else
return ret;
}
long double
__ieee754_hypotl(long double x, long double y)
{
long double a,b,a1,a2,b1,b2,w,kld;
int64_t j,k,ha,hb;
double xhi, yhi, hi, lo;
xhi = ldbl_high (x);
EXTRACT_WORDS64 (ha, xhi);
yhi = ldbl_high (y);
EXTRACT_WORDS64 (hb, yhi);
ha &= 0x7fffffffffffffffLL;
hb &= 0x7fffffffffffffffLL;
if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;}
a = fabsl(a); /* a <- |a| */
b = fabsl(b); /* b <- |b| */
if((ha-hb)>0x0780000000000000LL) {return a+b;} /* x/y > 2**120 */
k=0;
kld = 1.0L;
if(ha > 0x5f30000000000000LL) { /* a>2**500 */
if(ha >= 0x7ff0000000000000LL) { /* Inf or NaN */
w = a+b; /* for sNaN */
if (issignaling (a) || issignaling (b))
return w;
if(ha == 0x7ff0000000000000LL)
w = a;
if(hb == 0x7ff0000000000000LL)
w = b;
return w;
}
/* scale a and b by 2**-600 */
a *= 0x1p-600L;
b *= 0x1p-600L;
k = 600;
kld = 0x1p+600L;
}
else if(hb < 0x23d0000000000000LL) { /* b < 2**-450 */
if(hb <= 0x000fffffffffffffLL) { /* subnormal b or 0 */
if(hb==0) return a;
a *= 0x1p+1022L;
b *= 0x1p+1022L;
k = -1022;
kld = 0x1p-1022L;
} else { /* scale a and b by 2^600 */
a *= 0x1p+600L;
b *= 0x1p+600L;
k = -600;
kld = 0x1p-600L;
}
}
/* medium size a and b */
w = a-b;
if (w>b) {
ldbl_unpack (a, &hi, &lo);
a1 = hi;
a2 = lo;
/* a*a + b*b
= (a1+a2)*a + b*b
= a1*a + a2*a + b*b
= a1*(a1+a2) + a2*a + b*b
= a1*a1 + a1*a2 + a2*a + b*b
= a1*a1 + a2*(a+a1) + b*b */
w = sqrtl(a1*a1-(b*(-b)-a2*(a+a1)));
} else {
a = a+a;
ldbl_unpack (b, &hi, &lo);
b1 = hi;
b2 = lo;
ldbl_unpack (a, &hi, &lo);
a1 = hi;
a2 = lo;
/* a*a + b*b
= a*a + (a-b)*(a-b) - (a-b)*(a-b) + b*b
= a*a + w*w - (a*a - 2*a*b + b*b) + b*b
= w*w + 2*a*b
= w*w + (a1+a2)*b
= w*w + a1*b + a2*b
= w*w + a1*(b1+b2) + a2*b
= w*w + a1*b1 + a1*b2 + a2*b */
w = sqrtl(a1*b1-(w*(-w)-(a1*b2+a2*b)));
}
if(k!=0)
{
w *= kld;
math_check_force_underflow_nonneg (w);
return w;
}
else
return w;
}
