double
__ieee754_log2(double x)
{
double f,hfsq,hi,lo,r,val_hi,val_lo,w,y;
int32_t i,k,hx;
u_int32_t lx;
EXTRACT_WORDS(hx,lx,x);
k=0;
if (hx < 0x00100000) { /* x < 2**-1022 */
if (((hx&0x7fffffff)|lx)==0)
return -two54/vzero; /* log(+-0)=-inf */
if (hx<0) return (x-x)/zero; /* log(-#) = NaN */
k -= 54; x *= two54; /* subnormal number, scale up x */
GET_HIGH_WORD(hx,x);
}
if (hx >= 0x7ff00000) return x+x;
if (hx == 0x3ff00000 && lx == 0)
return zero; /* log(1) = +0 */
k += (hx>>20)-1023;
hx &= 0x000fffff;
i = (hx+0x95f64)&0x100000;
SET_HIGH_WORD(x,hx|(i^0x3ff00000)); /* normalize x or x/2 */
k += (i>>20);
y = (double)k;
f = x - 1.0;
hfsq = 0.5*f*f;
r = k_log1p(f);
/*
* f-hfsq must (for args near 1) be evaluated in extra precision
* to avoid a large cancellation when x is near sqrt(2) or 1/sqrt(2).
* This is fairly efficient since f-hfsq only depends on f, so can
* be evaluated in parallel with R. Not combining hfsq with R also
* keeps R small (though not as small as a true `lo' term would be),
* so that extra precision is not needed for terms involving R.
*
* Compiler bugs involving extra precision used to break Dekker's
* theorem for spitting f-hfsq as hi+lo, unless double_t was used
* or the multi-precision calculations were avoided when double_t
* has extra precision. These problems are now automatically
* avoided as a side effect of the optimization of combining the
* Dekker splitting step with the clear-low-bits step.
*
* y must (for args near sqrt(2) and 1/sqrt(2)) be added in extra
* precision to avoid a very large cancellation when x is very near
* these values. Unlike the above cancellations, this problem is
* specific to base 2. It is strange that adding +-1 is so much
* harder than adding +-ln2 or +-log10_2.
*
* This uses Dekker's theorem to normalize y+val_hi, so the
* compiler bugs are back in some configurations, sigh. And I
* don't want to used double_t to avoid them, since that gives a
* pessimization and the support for avoiding the pessimization
* is not yet available.
*
* The multi-precision calculations for the multiplications are
* routine.
*/
hi = f - hfsq;
SET_LOW_WORD(hi,0);
lo = (f - hi) - hfsq + r;
val_hi = hi*ivln2hi;
val_lo = (lo+hi)*ivln2lo + lo*ivln2hi;
/* spadd(val_hi, val_lo, y), except for not using double_t: */
w = y + val_hi;
val_lo += (y - w) + val_hi;
val_hi = w;
return val_lo + val_hi;
}
double
__ieee754_hypot (double x, double y)
{
double a, b, t1, t2, y1, y2, w;
int32_t j, k, ha, hb;
GET_HIGH_WORD (ha, x);
ha &= 0x7fffffff;
GET_HIGH_WORD (hb, y);
hb &= 0x7fffffff;
if (hb > ha)
{
a = y; b = x; j = ha; ha = hb; hb = j;
}
else
{
a = x; b = y;
}
SET_HIGH_WORD (a, ha); /* a <- |a| */
SET_HIGH_WORD (b, hb); /* b <- |b| */
if ((ha - hb) > 0x3c00000)
{
return a + b;
} /* x/y > 2**60 */
k = 0;
if (__glibc_unlikely (ha > 0x5f300000)) /* a>2**500 */
{
if (ha >= 0x7ff00000) /* Inf or NaN */
{
u_int32_t low;
w = a + b; /* for sNaN */
if (issignaling (a) || issignaling (b))
return w;
GET_LOW_WORD (low, a);
if (((ha & 0xfffff) | low) == 0)
w = a;
GET_LOW_WORD (low, b);
if (((hb ^ 0x7ff00000) | low) == 0)
w = b;
return w;
}
/* scale a and b by 2**-600 */
ha -= 0x25800000; hb -= 0x25800000; k += 600;
SET_HIGH_WORD (a, ha);
SET_HIGH_WORD (b, hb);
}
if (__builtin_expect (hb < 0x23d00000, 0)) /* b < 2**-450 */
{
if (hb <= 0x000fffff) /* subnormal b or 0 */
{
u_int32_t low;
GET_LOW_WORD (low, b);
if ((hb | low) == 0)
return a;
t1 = 0;
SET_HIGH_WORD (t1, 0x7fd00000); /* t1=2^1022 */
b *= t1;
a *= t1;
k -= 1022;
GET_HIGH_WORD (ha, a);
GET_HIGH_WORD (hb, b);
if (hb > ha)
{
t1 = a;
a = b;
b = t1;
j = ha;
ha = hb;
hb = j;
}
}
else /* scale a and b by 2^600 */
{
ha += 0x25800000; /* a *= 2^600 */
hb += 0x25800000; /* b *= 2^600 */
k -= 600;
SET_HIGH_WORD (a, ha);
SET_HIGH_WORD (b, hb);
}
}
/* medium size a and b */
w = a - b;
if (w > b)
{
t1 = 0;
SET_HIGH_WORD (t1, ha);
t2 = a - t1;
w = __ieee754_sqrt (t1 * t1 - (b * (-b) - t2 * (a + t1)));
}
else
{
a = a + a;
y1 = 0;
SET_HIGH_WORD (y1, hb);
y2 = b - y1;
t1 = 0;
SET_HIGH_WORD (t1, ha + 0x00100000);
t2 = a - t1;
w = __ieee754_sqrt (t1 * y1 - (w * (-w) - (t1 * y2 + t2 * b)));
}
if (k != 0)
{
u_int32_t high;
t1 = 1.0;
GET_HIGH_WORD (high, t1);
SET_HIGH_WORD (t1, high + (k << 20));
w *= t1;
math_check_force_underflow_nonneg (w);
return w;
}
else
return w;
}
double complex
ctanh(double complex z)
{
double x, y;
double t, beta, s, rho, denom;
uint32_t hx, ix, lx;
x = creal(z);
y = cimag(z);
EXTRACT_WORDS(hx, lx, x);
ix = hx & 0x7fffffff;
/*
* ctanh(NaN + i 0) = NaN + i 0
*
* ctanh(NaN + i y) = NaN + i NaN for y != 0
*
* The imaginary part has the sign of x*sin(2*y), but there's no
* special effort to get this right.
*
* ctanh(+-Inf +- i Inf) = +-1 +- 0
*
* ctanh(+-Inf + i y) = +-1 + 0 sin(2y) for y finite
*
* The imaginary part of the sign is unspecified. This special
* case is only needed to avoid a spurious invalid exception when
* y is infinite.
*/
if (ix >= 0x7ff00000) {
if ((ix & 0xfffff) | lx) /* x is NaN */
return (CMPLX(x, (y == 0 ? y : x * y)));
SET_HIGH_WORD(x, hx - 0x40000000); /* x = copysign(1, x) */
return (CMPLX(x, copysign(0, isinf(y) ? y : sin(y) * cos(y))));
}
/*
* ctanh(x + i NAN) = NaN + i NaN
* ctanh(x +- i Inf) = NaN + i NaN
*/
if (!isfinite(y))
return (CMPLX(y - y, y - y));
/*
* ctanh(+-huge + i +-y) ~= +-1 +- i 2sin(2y)/exp(2x), using the
* approximation sinh^2(huge) ~= exp(2*huge) / 4.
* We use a modified formula to avoid spurious overflow.
*/
if (ix >= 0x40360000) { /* x >= 22 */
double exp_mx = exp(-fabs(x));
return (CMPLX(copysign(1, x),
4 * sin(y) * cos(y) * exp_mx * exp_mx));
}
/* Kahan's algorithm */
t = tan(y);
beta = 1.0 + t * t; /* = 1 / cos^2(y) */
s = sinh(x);
rho = sqrt(1 + s * s); /* = cosh(x) */
denom = 1 + beta * s * s;
return (CMPLX((beta * rho * s) / denom, t / denom));
}
