long double
cbrtl(long double x) {
long double s, t, r, w, y;
double dx, dy;
int *py = (int *) &dy;
int n, m, m3, sx;
if (!finitel(x))
return (x + x);
if (iszerol(x))
return (x);
sx = signbitl(x);
x = fabsl(x);
n = ilogbl(x);
m = n / 3;
m3 = m + m + m;
y = scalbnl(x, -m3);
dx = (double) y;
dy = cbrt(dx);
py[1 - n0] += 2;
if (py[1 - n0] == 0)
py[n0] += 1;
/* one step newton iteration to 113 bits with error < 0.667ulps */
t = (long double) dy;
t = scalbnl(t, m);
s = t * t;
r = x / s;
w = t + t;
r = (r - t) / (w + r);
t += t * r;
return (sx == 0 ? t : -t);
}
long double
expl(long double x) {
int *px = (int *) &x, ix, j, k, m;
long double t, r;
ix = px[0]; /* high word of x */
if (ix >= 0x7fff0000)
return (x + x); /* NaN of +inf */
if (((unsigned) ix) >= 0xffff0000)
return (-one / x); /* NaN or -inf */
if ((ix & 0x7fffffff) < 0x3fc30000) {
if ((int) x < 1)
return (one + x); /* |x|<2^-60 */
}
if (ix > 0) {
if (x > ovflthreshold)
return (scalbnl(x, 20000));
k = (int) (invln2_32 * (x + ln2_64));
} else {
if (x < unflthreshold)
return (scalbnl(-x, -40000));
k = (int) (invln2_32 * (x - ln2_64));
}
j = k&0x1f;
m = k>>5;
t = (long double) k;
x = (x - t * ln2_32hi) - t * ln2_32lo;
t = x * x;
r = (x - t * (t1 + t * (t2 + t * (t3 + t * (t4 + t * t5))))) - two;
x = _TBL_expl_hi[j] - ((_TBL_expl_hi[j] * (x + x)) / r -
_TBL_expl_lo[j]);
return (scalbnl(x, m));
}
long double
hypotl (long double x, long double y)
{
int exx;
int eyy;
int scale;
long double xx =fabsl(x);
long double yy =fabsl(y);
if (!isfinite(xx) || !isfinite(yy))
{
/* Annex F.9.4.3, hypot returns +infinity if
either component is an infinity, even when the
other compoent is NaN. */
return (isinf(xx) || isinf(yy)) ? INFINITY : NAN;
}
if (xx == 0.0L)
return yy;
if (yy == 0.0L)
return xx;
/* Get exponents */
exx = logbl (xx);
eyy = logbl (yy);
/* Check if large differences in scale */
scale = exx - eyy;
if ( scale > PRECL)
return xx;
if ( scale < -PRECL)
return yy;
/* Exponent of approximate geometric mean (x 2) */
scale = (exx + eyy) >> 1;
/* Rescale: Geometric mean is now about 2 */
x = scalbnl(xx, -scale);
y = scalbnl(yy, -scale);
xx = sqrtl(x * x + y * y);
/* Check for overflow and underflow */
exx = logbl(xx);
exx += scale;
if (exx > LDBL_MAX_EXP)
{
errno = ERANGE;
return __INFL;
}
if (exx < LDBL_MIN_EXP)
return 0.0L;
/* Undo scaling */
return (scalbnl (xx, scale));
}
ldcomplex
csinhl(ldcomplex z) {
long double t, x, y, S, C;
int hx, ix, hy, iy, n;
ldcomplex ans;
x = LD_RE(z);
y = LD_IM(z);
hx = HI_XWORD(x);
ix = hx & 0x7fffffff;
hy = HI_XWORD(y);
iy = hy & 0x7fffffff;
x = fabsl(x);
y = fabsl(y);
(void) sincosl(y, &S, &C);
if (ix >= 0x4004e000) { /* |x| > 60 = prec/2 (14,28,34,60) */
if (ix >= 0x400C62E4) { /* |x| > 11356.52... ~ log(2**16384) */
if (ix >= 0x7fff0000) { /* |x| is inf or NaN */
if (y == zero) {
LD_RE(ans) = x;
LD_IM(ans) = y;
} else if (iy >= 0x7fff0000) {
LD_RE(ans) = x;
LD_IM(ans) = x - y;
} else {
LD_RE(ans) = C * x;
LD_IM(ans) = S * x;
}
} else {
/* return exp(x)=t*2**n */
t = __k_cexpl(x, &n);
LD_RE(ans) = scalbnl(C * t, n - 1);
LD_IM(ans) = scalbnl(S * t, n - 1);
}
} else {
t = expl(x) * half;
LD_RE(ans) = C * t;
LD_IM(ans) = S * t;
}
} else {
if (x == zero) { /* x = 0, return (0,S) */
LD_RE(ans) = zero;
LD_IM(ans) = S;
} else {
LD_RE(ans) = C * sinhl(x);
LD_IM(ans) = S * coshl(x);
}
}
if (hx < 0)
LD_RE(ans) = -LD_RE(ans);
if (hy < 0)
LD_IM(ans) = -LD_IM(ans);
return (ans);
}
/*
* Compute ldexp(a+b, scale) with a single rounding error. It is assumed
* that the result will be subnormal, and care is taken to ensure that
* double rounding does not occur.
*/
static inline long double add_and_denormalize(long double a, long double b, int scale)
{
struct dd sum;
int bits_lost;
union ldshape u;
sum = dd_add(a, b);
/*
* If we are losing at least two bits of accuracy to denormalization,
* then the first lost bit becomes a round bit, and we adjust the
* lowest bit of sum.hi to make it a sticky bit summarizing all the
* bits in sum.lo. With the sticky bit adjusted, the hardware will
* break any ties in the correct direction.
*
* If we are losing only one bit to denormalization, however, we must
* break the ties manually.
*/
if (sum.lo != 0) {
u.f = sum.hi;
bits_lost = -u.i.se - scale + 1;
if ((bits_lost != 1) ^ LASTBIT(u))
sum.hi = nextafterl(sum.hi, INFINITY * sum.lo);
}
return scalbnl(sum.hi, scale);
}
long double expl(long double x)
{
long double px, xx;
int k;
if (isnan(x))
return x;
if (x > 11356.5234062941439488L) /* x > ln(2^16384 - 0.5) */
return x * 0x1p16383L;
if (x < -11399.4985314888605581L) /* x < ln(2^-16446) */
return -0x1p-16445L/x;
/* Express e**x = e**f 2**k
* = e**(f + k ln(2))
*/
px = floorl(LOG2E * x + 0.5);
k = px;
x -= px * LN2HI;
x -= px * LN2LO;
/* rational approximation of the fractional part:
* e**x = 1 + 2x P(x**2)/(Q(x**2) - x P(x**2))
*/
xx = x * x;
px = x * __polevll(xx, P, 2);
x = px/(__polevll(xx, Q, 3) - px);
x = 1.0 + 2.0 * x;
return scalbnl(x, k);
}
void test_scalbn()
{
static_assert((std::is_same<decltype(scalbn((double)0, (int)0)), double>::value), "");
static_assert((std::is_same<decltype(scalbnf(0, (int)0)), float>::value), "");
static_assert((std::is_same<decltype(scalbnl(0, (int)0)), long double>::value), "");
assert(scalbn(1, 1) == 2);
}
long double
tanl(long double x)
{
union IEEEl2bits z;
int i, e0, s;
double xd[NX], yd[PREC];
long double hi, lo;
z.e = x;
s = z.bits.sign;
z.bits.sign = 0;
/* If x = +-0 or x is subnormal, then tan(x) = x. */
if (z.bits.exp == 0)
return (x);
/* If x = NaN or Inf, then tan(x) = NaN. */
if (z.bits.exp == 32767)
return ((x - x) / (x - x));
/* Optimize the case where x is already within range. */
if (z.e < M_PI_4) {
hi = __kernel_tanl(z.e, 0, 0);
return (s ? -hi : hi);
}
/* Split z.e into a 24-bit representation. */
e0 = ilogbl(z.e) - 23;
z.e = scalbnl(z.e, -e0);
for (i = 0; i < NX; i++) {
xd[i] = (double)((int32_t)z.e);
z.e = (z.e - xd[i]) * two24;
}
/* yd contains the pieces of xd rem pi/2 such that |yd| < pi/4. */
e0 = __kernel_rem_pio2(xd, yd, e0, NX, PREC);
#if PREC == 2
hi = (long double)yd[0] + yd[1];
lo = yd[1] - (hi - yd[0]);
#else /* PREC == 3 */
long double t;
t = (long double)yd[2] + yd[1];
hi = t + yd[0];
lo = yd[0] - (hi - t);
#endif
switch (e0 & 3) {
case 0:
case 2:
hi = __kernel_tanl(hi, lo, 0);
break;
case 1:
case 3:
hi = __kernel_tanl(hi, lo, 1);
break;
}
return (s ? -hi : hi);
}
long double ldexpl(long double value, int exp)
{
if(!isfinite(value)||value==0.0) return value;
value = scalbnl(value,exp);
// if(!finitel(value)||value==0.0) errno = ERANGE;
return value;
}
int
__rem_pio2l(long double x, long double *y)
{
long double z, w;
double t[3], v[5];
int e0, i, nx, n, sign;
sign = signbitl(x);
z = fabsl(x);
if (z <= pio4) {
y[0] = x;
y[1] = 0;
return (0);
}
e0 = ilogbl(z) - 23;
z = scalbnl(z, -e0);
for (i = 0; i < 3; i++) {
t[i] = (double)((int)(z));
z = (z - (long double)t[i]) * two24l;
}
nx = 3;
while (t[nx-1] == 0.0)
nx--; /* omit trailing zeros */
n = __rem_pio2m(t, v, e0, nx, 2, _TBL_ipio2l_inf);
z = (long double)v[1];
w = (long double)v[0];
y[0] = z + w;
y[1] = z - (y[0] - w);
if (sign == 1) {
y[0] = -y[0];
y[1] = -y[1];
return (-n);
}
return (n);
}
long double
log10l(long double x) {
long double y, z;
enum fp_direction_type rd;
int n;
if (!finitel(x))
return (x + fabsl(x)); /* x is +-INF or NaN */
else if (x > zero) {
n = ilogbl(x);
if (n < 0)
n += 1;
rd = __swapRD(fp_nearest);
y = n;
x = scalbnl(x, -n);
z = y * log10_2lo + ivln10 * logl(x);
z += y * log10_2hi;
if (rd != fp_nearest)
(void) __swapRD(rd);
return (z);
} else if (x == zero) /* -INF */
return (-one / zero);
else /* x <0 , return NaN */
return (zero / zero);
}
long double expm1l(long double x)
{
long double px, qx, xx;
int k;
/* Overflow. */
if (x > MAXLOGL)
return huge*huge; /* overflow */
if (x == 0.0)
return x;
/* Minimum value.*/
if (x < minarg)
return -1.0;
xx = C1 + C2;
/* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */
px = floorl(0.5 + x / xx);
k = px;
/* remainder times ln 2 */
x -= px * C1;
x -= px * C2;
/* Approximate exp(remainder ln 2).*/
px = (((( P4 * x + P3) * x + P2) * x + P1) * x + P0) * x;
qx = (((( x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0;
xx = x * x;
qx = x + (0.5 * xx + xx * px / qx);
/* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2).
We have qx = exp(remainder ln 2) - 1, so
exp(x) - 1 = 2^k (qx + 1) - 1 = 2^k qx + 2^k - 1. */
px = scalbnl(1.0, k);
x = px * qx + (px - 1.0);
return x;
}
/*
* exp2l(x): compute the base 2 exponential of x
*
* Accuracy: Peak error < 0.511 ulp.
*
* Method: (equally-spaced tables)
*
* Reduce x:
* x = 2**k + y, for integer k and |y| <= 1/2.
* Thus we have exp2l(x) = 2**k * exp2(y).
*
* Reduce y:
* y = i/TBLSIZE + z for integer i near y * TBLSIZE.
* Thus we have exp2(y) = exp2(i/TBLSIZE) * exp2(z),
* with |z| <= 2**-(TBLBITS+1).
*
* We compute exp2(i/TBLSIZE) via table lookup and exp2(z) via a
* degree-6 minimax polynomial with maximum error under 2**-69.
* The table entries each have 104 bits of accuracy, encoded as
* a pair of double precision values.
*/
long double exp2l(long double x)
{
union IEEEl2bits u, v;
long double r, z;
uint32_t hx, ix, i0;
union {uint32_t u; int32_t i;} k;
/* Filter out exceptional cases. */
u.e = x;
hx = u.xbits.expsign;
ix = hx & EXPMASK;
if (ix >= BIAS + 14) { /* |x| >= 16384 or x is NaN */
if (ix == EXPMASK) {
if (u.xbits.man == 1ULL << 63 && hx == 0xffff) /* -inf */
return 0;
return x;
}
if (x >= 16384) {
x *= 0x1p16383L;
return x;
}
if (x <= -16446)
return 0x1p-10000L*0x1p-10000L;
} else if (ix < BIAS - 64) /* |x| < 0x1p-64 */
return 1 + x;
/*
* Reduce x, computing z, i0, and k. The low bits of x + redux
* contain the 16-bit integer part of the exponent (k) followed by
* TBLBITS fractional bits (i0). We use bit tricks to extract these
* as integers, then set z to the remainder.
*
* Example: Suppose x is 0xabc.123456p0 and TBLBITS is 8.
* Then the low-order word of x + redux is 0x000abc12,
* We split this into k = 0xabc and i0 = 0x12 (adjusted to
* index into the table), then we compute z = 0x0.003456p0.
*/
u.e = x + redux;
i0 = u.bits.manl + TBLSIZE / 2;
k.u = i0 / TBLSIZE * TBLSIZE;
k.i /= TBLSIZE;
i0 %= TBLSIZE;
u.e -= redux;
z = x - u.e;
/* Compute r = exp2l(y) = exp2lt[i0] * p(z). */
long double t_hi = tbl[2*i0];
long double t_lo = tbl[2*i0 + 1];
/* XXX This gives > 1 ulp errors outside of FE_TONEAREST mode */
r = t_lo + (t_hi + t_lo) * z * (P1 + z * (P2 + z * (P3 + z * (P4
+ z * (P5 + z * P6))))) + t_hi;
return scalbnl(r, k.i);
}
long double
scalblnl (long double x, long n)
{
int in;
in = (int)n;
if (in != n) {
if (n > 0)
in = INT_MAX;
else
in = INT_MIN;
}
return (scalbnl(x, (int)n));
}
GFC_REAL_10
spacing_r10 (GFC_REAL_10 s, int p, int emin, GFC_REAL_10 tiny)
{
int e;
if (s == 0.)
return tiny;
frexpl (s, &e);
e = e - p;
e = e > emin ? e : emin;
#if defined (HAVE_LDEXPL)
return ldexpl (1., e);
#else
return scalbnl (1., e);
#endif
}
GFC_REAL_10
rrspacing_r10 (GFC_REAL_10 s, int p)
{
int e;
GFC_REAL_10 x;
x = fabsl (s);
if (x == 0.)
return 0.;
frexpl (s, &e);
#if defined (HAVE_LDEXPL)
return ldexpl (x, p - e);
#else
return scalbnl (x, p - e);
#endif
}
long double
sinhl(long double x)
{
long double r, t;
if (!finitel(x))
return (x + x); /* x is INF or NaN */
r = fabsl(x);
if (r < lnovft) {
t = expm1l(r);
r = copysignl((t + t / (one + t)) * half, x);
} else {
r = copysignl(expl((r - lnovft) - lnovlo), x);
r = scalbnl(r, 16383);
}
return (r);
}
long double
coshl(long double x) {
long double t, w;
w = fabsl(x);
if (!finitel(w))
return (w + w); /* x is INF or NaN */
if (w < thr1) {
t = w < tinyl ? w : expm1l(w);
w = one + t;
if (w != one)
w = one + (t * t) / (w + w);
return (w);
} else if (w < thr2) {
t = expl(w);
return (half * (t + one / t));
} else if (w <= lnovftL)
return (half * expl(w));
else {
return (scalbnl(expl((w - MEP1 * ln2hi) - MEP1 * ln2lo), ME));
}
}
long double
coshl(long double x) {
long double w, t;
w = fabsl(x);
if (!finitel(w))
return (w + w); /* x is INF or NaN */
if (w < thr1) {
if (w < tinyl)
return (one + w); /* inexact+directed rounding */
t = expm1l(w);
w = one + t;
w = one + (t * t) / (w + w);
return (w);
}
if (w < thr2) {
t = expl(w);
return (half * (t + one / t));
}
if (w <= lnovft)
return (half * expl(w));
return (scalbnl(expl((w - lnovft) - lnovlo), 16383));
}
GFC_REAL_10
set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i)
{
int dummy_exp;
return scalbnl (frexpl (s, &dummy_exp), i);
}
static int testl(long double long_double_x, int int_x, long long_x)
{
int r = 0;
r += __finitel(long_double_x);
r += __fpclassifyl(long_double_x);
r += __isinfl(long_double_x);
r += __isnanl(long_double_x);
r += __signbitl(long_double_x);
r += acoshl(long_double_x);
r += acosl(long_double_x);
r += asinhl(long_double_x);
r += asinl(long_double_x);
r += atan2l(long_double_x, long_double_x);
r += atanhl(long_double_x);
r += atanl(long_double_x);
r += cbrtl(long_double_x);
r += ceill(long_double_x);
r += copysignl(long_double_x, long_double_x);
r += coshl(long_double_x);
r += cosl(long_double_x);
r += erfcl(long_double_x);
r += erfl(long_double_x);
r += exp2l(long_double_x);
r += expl(long_double_x);
r += expm1l(long_double_x);
r += fabsl(long_double_x);
r += fdiml(long_double_x, long_double_x);
r += floorl(long_double_x);
r += fmal(long_double_x, long_double_x, long_double_x);
r += fmaxl(long_double_x, long_double_x);
r += fminl(long_double_x, long_double_x);
r += fmodl(long_double_x, long_double_x);
r += frexpl(long_double_x, &int_x);
r += hypotl(long_double_x, long_double_x);
r += ilogbl(long_double_x);
r += ldexpl(long_double_x, int_x);
r += lgammal(long_double_x);
r += llrintl(long_double_x);
r += llroundl(long_double_x);
r += log10l(long_double_x);
r += log1pl(long_double_x);
r += log2l(long_double_x);
r += logbl(long_double_x);
r += logl(long_double_x);
r += lrintl(long_double_x);
r += lroundl(long_double_x);
r += modfl(long_double_x, &long_double_x);
r += nearbyintl(long_double_x);
r += nextafterl(long_double_x, long_double_x);
r += nexttowardl(long_double_x, long_double_x);
r += powl(long_double_x, long_double_x);
r += remainderl(long_double_x, long_double_x);
r += remquol(long_double_x, long_double_x, &int_x);
r += rintl(long_double_x);
r += roundl(long_double_x);
r += scalblnl(long_double_x, long_x);
r += scalbnl(long_double_x, int_x);
r += sinhl(long_double_x);
r += sinl(long_double_x);
r += sqrtl(long_double_x);
r += tanhl(long_double_x);
r += tanl(long_double_x);
r += tgammal(long_double_x);
r += truncl(long_double_x);
return r;
}
TEST(math, scalbnl) {
ASSERT_FLOAT_EQ(12.0, scalbnl(3.0, 2));
}
long double
ldexpl(long double x, int n) {
return (scalbnl(x, n));
}
TEST(math, frexpl) {
int exp;
long double ldr = frexpl(1024.0, &exp);
ASSERT_FLOAT_EQ(1024.0, scalbnl(ldr, exp));
}
ldcomplex
cpowl(ldcomplex z, ldcomplex w) {
ldcomplex ans;
long double x, y, u, v, t, c, s, r;
long double t1, t2, t3, t4, x1, x2, y1, y2, u1, v1, b[4], w1, w2;
int ix, iy, hx, hy, hv, hu, iu, iv, i, j, k;
x = LD_RE(z);
y = LD_IM(z);
u = LD_RE(w);
v = LD_IM(w);
hx = HI_XWORD(x);
hy = HI_XWORD(y);
hu = HI_XWORD(u);
hv = HI_XWORD(v);
ix = hx & 0x7fffffff;
iy = hy & 0x7fffffff;
iu = hu & 0x7fffffff;
iv = hv & 0x7fffffff;
j = 0;
if (v == zero) { /* z**(real) */
if (u == one) { /* (anything) ** 1 is itself */
LD_RE(ans) = x;
LD_IM(ans) = y;
} else if (u == zero) { /* (anything) ** 0 is 1 */
LD_RE(ans) = one;
LD_IM(ans) = zero;
} else if (y == zero) { /* real ** real */
LD_IM(ans) = zero;
if (hx < 0 && ix < hiinf && iu < hiinf) {
/* -x ** u is exp(i*pi*u)*pow(x,u) */
r = powl(-x, u);
sincospil(u, &s, &c);
LD_RE(ans) = (c == zero)? c: c * r;
LD_IM(ans) = (s == zero)? s: s * r;
} else
LD_RE(ans) = powl(x, u);
} else if (x == zero || ix >= hiinf || iy >= hiinf) {
if (isnanl(x) || isnanl(y) || isnanl(u))
LD_RE(ans) = LD_IM(ans) = x + y + u;
else {
if (x == zero)
r = fabsl(y);
else
r = fabsl(x) + fabsl(y);
t = atan2pil(y, x);
sincospil(t * u, &s, &c);
LD_RE(ans) = (c == zero)? c: c * r;
LD_IM(ans) = (s == zero)? s: s * r;
}
} else if (fabsl(x) == fabsl(y)) { /* |x| = |y| */
if (hx >= 0) {
t = (hy >= 0)? 0.25L : -0.25L;
sincospil(t * u, &s, &c);
} else if ((LAST(u) & 3) == 0) {
t = (hy >= 0)? 0.75L : -0.75L;
sincospil(t * u, &s, &c);
} else {
r = (hy >= 0)? u : -u;
t = -0.25L * r;
w1 = r + t;
w2 = t - (w1 - r);
sincospil(w1, &t1, &t2);
sincospil(w2, &t3, &t4);
s = t1 * t4 + t3 * t2;
c = t2 * t4 - t1 * t3;
}
if (ix < 0x3ffe0000) /* |x| < 1/2 */
r = powl(fabsl(x + x), u) * exp2l(-0.5L * u);
else if (ix >= 0x3fff0000 || iu < 0x400cfff8)
/* |x| >= 1 or |u| < 16383 */
r = powl(fabsl(x), u) * exp2l(0.5L * u);
else /* special treatment */
j = 2;
if (j == 0) {
LD_RE(ans) = (c == zero)? c: c * r;
LD_IM(ans) = (s == zero)? s: s * r;
}
} else
j = 1;
if (j == 0)
return (ans);
}
if (iu >= hiinf || iv >= hiinf || ix >= hiinf || iy >= hiinf) {
/*
* non-zero imag part(s) with inf component(s) yields NaN
*/
t = fabsl(x) + fabsl(y) + fabsl(u) + fabsl(v);
LD_RE(ans) = LD_IM(ans) = t - t;
} else {
k = 0; /* no scaling */
if (iu > 0x7ffe0000 || iv > 0x7ffe0000) {
u *= 1.52587890625000000000e-05L;
v *= 1.52587890625000000000e-05L;
k = 1; /* scale u and v by 2**-16 */
}
/*
* Use similated higher precision arithmetic to compute:
* r = u * log(hypot(x, y)) - v * atan2(y, x)
* q = u * atan2(y, x) + v * log(hypot(x, y))
*/
t1 = __k_clog_rl(x, y, &t2);
t3 = __k_atan2l(y, x, &t4);
x1 = t1; HALF(x1);
y1 = t3; HALF(y1);
u1 = u; HALF(u1);
v1 = v; HALF(v1);
x2 = t2 - (x1 - t1); /* log(hypot(x,y)) = x1 + x2 */
y2 = t4 - (y1 - t3); /* atan2(y,x) = y1 + y2 */
/* compute q = u * atan2(y, x) + v * log(hypot(x, y)) */
if (j != 2) {
b[0] = u1 * y1;
b[1] = (u - u1) * y1 + u * y2;
if (j == 1) { /* v = 0 */
w1 = b[0] + b[1];
w2 = b[1] - (w1 - b[0]);
} else {
b[2] = v1 * x1;
b[3] = (v - v1) * x1 + v * x2;
w1 = sum4fpl(b, &w2);
}
sincosl(w1, &t1, &t2);
sincosl(w2, &t3, &t4);
s = t1 * t4 + t3 * t2;
c = t2 * t4 - t1 * t3;
if (k == 1) /* square j times */
for (i = 0; i < 10; i++) {
t1 = s * c;
c = (c + s) * (c - s);
s = t1 + t1;
}
}
/* compute r = u * (t1, t2) - v * (t3, t4) */
b[0] = u1 * x1;
b[1] = (u - u1) * x1 + u * x2;
if (j == 1) { /* v = 0 */
w1 = b[0] + b[1];
w2 = b[1] - (w1 - b[0]);
} else {
b[2] = -v1 * y1;
b[3] = (v1 - v) * y1 - v * y2;
w1 = sum4fpl(b, &w2);
}
/* scale back unless w1 is large enough to cause exception */
if (k != 0 && fabsl(w1) < 20000.0L) {
w1 *= 65536.0L; w2 *= 65536.0L;
}
hx = HI_XWORD(w1);
ix = hx & 0x7fffffff;
/* compute exp(w1 + w2) */
k = 0;
if (ix < 0x3f8c0000) /* exp(tiny < 2**-115) = 1 */
r = one;
else if (ix >= 0x400c6760) /* overflow/underflow */
r = (hx < 0)? tiny * tiny : huge * huge;
else { /* compute exp(w1 + w2) */
k = (int) (invln2 * w1 + ((hx >= 0)? 0.5L : -0.5L));
t1 = (long double) k;
t2 = w1 - t1 * ln2hil;
t3 = w2 - t1 * ln2lol;
r = expl(t2 + t3);
}
if (c != zero) c *= r;
if (s != zero) s *= r;
if (k != 0) {
c = scalbnl(c, k);
s = scalbnl(s, k);
}
LD_RE(ans) = c;
LD_IM(ans) = s;
}
return (ans);
}
void
domathl (void)
{
#ifndef NO_LONG_DOUBLE
long double f1;
long double f2;
int i1;
f1 = acosl(0.0);
fprintf( stdout, "acosl : %Lf\n", f1);
f1 = acoshl(0.0);
fprintf( stdout, "acoshl : %Lf\n", f1);
f1 = asinl(1.0);
fprintf( stdout, "asinl : %Lf\n", f1);
f1 = asinhl(1.0);
fprintf( stdout, "asinhl : %Lf\n", f1);
f1 = atanl(M_PI_4);
fprintf( stdout, "atanl : %Lf\n", f1);
f1 = atan2l(2.3, 2.3);
fprintf( stdout, "atan2l : %Lf\n", f1);
f1 = atanhl(1.0);
fprintf( stdout, "atanhl : %Lf\n", f1);
f1 = cbrtl(27.0);
fprintf( stdout, "cbrtl : %Lf\n", f1);
f1 = ceill(3.5);
fprintf( stdout, "ceill : %Lf\n", f1);
f1 = copysignl(3.5, -2.5);
fprintf( stdout, "copysignl : %Lf\n", f1);
f1 = cosl(M_PI_2);
fprintf( stdout, "cosl : %Lf\n", f1);
f1 = coshl(M_PI_2);
fprintf( stdout, "coshl : %Lf\n", f1);
f1 = erfl(42.0);
fprintf( stdout, "erfl : %Lf\n", f1);
f1 = erfcl(42.0);
fprintf( stdout, "erfcl : %Lf\n", f1);
f1 = expl(0.42);
fprintf( stdout, "expl : %Lf\n", f1);
f1 = exp2l(0.42);
fprintf( stdout, "exp2l : %Lf\n", f1);
f1 = expm1l(0.00042);
fprintf( stdout, "expm1l : %Lf\n", f1);
f1 = fabsl(-1.123);
fprintf( stdout, "fabsl : %Lf\n", f1);
f1 = fdiml(1.123, 2.123);
fprintf( stdout, "fdiml : %Lf\n", f1);
f1 = floorl(0.5);
fprintf( stdout, "floorl : %Lf\n", f1);
f1 = floorl(-0.5);
fprintf( stdout, "floorl : %Lf\n", f1);
f1 = fmal(2.1, 2.2, 3.01);
fprintf( stdout, "fmal : %Lf\n", f1);
f1 = fmaxl(-0.42, 0.42);
fprintf( stdout, "fmaxl : %Lf\n", f1);
f1 = fminl(-0.42, 0.42);
fprintf( stdout, "fminl : %Lf\n", f1);
f1 = fmodl(42.0, 3.0);
fprintf( stdout, "fmodl : %Lf\n", f1);
/* no type-specific variant */
i1 = fpclassify(1.0);
fprintf( stdout, "fpclassify : %d\n", i1);
f1 = frexpl(42.0, &i1);
fprintf( stdout, "frexpl : %Lf\n", f1);
f1 = hypotl(42.0, 42.0);
fprintf( stdout, "hypotl : %Lf\n", f1);
i1 = ilogbl(42.0);
fprintf( stdout, "ilogbl : %d\n", i1);
/* no type-specific variant */
i1 = isfinite(3.0);
fprintf( stdout, "isfinite : %d\n", i1);
/* no type-specific variant */
i1 = isgreater(3.0, 3.1);
fprintf( stdout, "isgreater : %d\n", i1);
/* no type-specific variant */
i1 = isgreaterequal(3.0, 3.1);
fprintf( stdout, "isgreaterequal : %d\n", i1);
/* no type-specific variant */
i1 = isinf(3.0);
fprintf( stdout, "isinf : %d\n", i1);
/* no type-specific variant */
i1 = isless(3.0, 3.1);
fprintf( stdout, "isless : %d\n", i1);
/* no type-specific variant */
i1 = islessequal(3.0, 3.1);
fprintf( stdout, "islessequal : %d\n", i1);
/* no type-specific variant */
i1 = islessgreater(3.0, 3.1);
fprintf( stdout, "islessgreater : %d\n", i1);
/* no type-specific variant */
i1 = isnan(0.0);
fprintf( stdout, "isnan : %d\n", i1);
/* no type-specific variant */
i1 = isnormal(3.0);
fprintf( stdout, "isnormal : %d\n", i1);
/* no type-specific variant */
f1 = isunordered(1.0, 2.0);
fprintf( stdout, "isunordered : %d\n", i1);
f1 = j0l(1.2);
fprintf( stdout, "j0l : %Lf\n", f1);
f1 = j1l(1.2);
fprintf( stdout, "j1l : %Lf\n", f1);
f1 = jnl(2,1.2);
fprintf( stdout, "jnl : %Lf\n", f1);
f1 = ldexpl(1.2,3);
fprintf( stdout, "ldexpl : %Lf\n", f1);
f1 = lgammal(42.0);
fprintf( stdout, "lgammal : %Lf\n", f1);
f1 = llrintl(-0.5);
fprintf( stdout, "llrintl : %Lf\n", f1);
f1 = llrintl(0.5);
fprintf( stdout, "llrintl : %Lf\n", f1);
f1 = llroundl(-0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = llroundl(0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = logl(42.0);
fprintf( stdout, "logl : %Lf\n", f1);
f1 = log10l(42.0);
fprintf( stdout, "log10l : %Lf\n", f1);
f1 = log1pl(42.0);
fprintf( stdout, "log1pl : %Lf\n", f1);
f1 = log2l(42.0);
fprintf( stdout, "log2l : %Lf\n", f1);
f1 = logbl(42.0);
fprintf( stdout, "logbl : %Lf\n", f1);
f1 = lrintl(-0.5);
fprintf( stdout, "lrintl : %Lf\n", f1);
f1 = lrintl(0.5);
fprintf( stdout, "lrintl : %Lf\n", f1);
f1 = lroundl(-0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = lroundl(0.5);
fprintf( stdout, "lroundl : %Lf\n", f1);
f1 = modfl(42.0,&f2);
fprintf( stdout, "lmodfl : %Lf\n", f1);
f1 = nanl("");
fprintf( stdout, "nanl : %Lf\n", f1);
f1 = nearbyintl(1.5);
fprintf( stdout, "nearbyintl : %Lf\n", f1);
f1 = nextafterl(1.5,2.0);
fprintf( stdout, "nextafterl : %Lf\n", f1);
f1 = powl(3.01, 2.0);
fprintf( stdout, "powl : %Lf\n", f1);
f1 = remainderl(3.01,2.0);
fprintf( stdout, "remainderl : %Lf\n", f1);
f1 = remquol(29.0,3.0,&i1);
fprintf( stdout, "remquol : %Lf\n", f1);
f1 = rintl(0.5);
fprintf( stdout, "rintl : %Lf\n", f1);
f1 = rintl(-0.5);
fprintf( stdout, "rintl : %Lf\n", f1);
f1 = roundl(0.5);
fprintf( stdout, "roundl : %Lf\n", f1);
f1 = roundl(-0.5);
fprintf( stdout, "roundl : %Lf\n", f1);
f1 = scalblnl(1.2,3);
fprintf( stdout, "scalblnl : %Lf\n", f1);
f1 = scalbnl(1.2,3);
fprintf( stdout, "scalbnl : %Lf\n", f1);
/* no type-specific variant */
i1 = signbit(1.0);
fprintf( stdout, "signbit : %i\n", i1);
f1 = sinl(M_PI_4);
fprintf( stdout, "sinl : %Lf\n", f1);
f1 = sinhl(M_PI_4);
fprintf( stdout, "sinhl : %Lf\n", f1);
f1 = sqrtl(9.0);
fprintf( stdout, "sqrtl : %Lf\n", f1);
f1 = tanl(M_PI_4);
fprintf( stdout, "tanl : %Lf\n", f1);
f1 = tanhl(M_PI_4);
fprintf( stdout, "tanhl : %Lf\n", f1);
f1 = tgammal(2.1);
fprintf( stdout, "tgammal : %Lf\n", f1);
f1 = truncl(3.5);
fprintf( stdout, "truncl : %Lf\n", f1);
f1 = y0l(1.2);
fprintf( stdout, "y0l : %Lf\n", f1);
f1 = y1l(1.2);
fprintf( stdout, "y1l : %Lf\n", f1);
f1 = ynl(3,1.2);
fprintf( stdout, "ynl : %Lf\n", f1);
#endif
}
TEST(math, scalbnl) {
ASSERT_DOUBLE_EQ(12.0L, scalbnl(3.0L, 2));
}
TEST(math, frexpl) {
int exp;
long double ldr = frexpl(1024.0L, &exp);
ASSERT_DOUBLE_EQ(1024.0L, scalbnl(ldr, exp));
}
long double powl(long double x, long double y)
{
/* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */
int i, nflg, iyflg, yoddint;
long e;
volatile long double z=0;
long double w=0, W=0, Wa=0, Wb=0, ya=0, yb=0, u=0;
/* make sure no invalid exception is raised by nan comparision */
if (isnan(x)) {
if (!isnan(y) && y == 0.0)
return 1.0;
return x;
}
if (isnan(y)) {
if (x == 1.0)
return 1.0;
return y;
}
if (x == 1.0)
return 1.0; /* 1**y = 1, even if y is nan */
if (x == -1.0 && !isfinite(y))
return 1.0; /* -1**inf = 1 */
if (y == 0.0)
return 1.0; /* x**0 = 1, even if x is nan */
if (y == 1.0)
return x;
if (y >= LDBL_MAX) {
if (x > 1.0 || x < -1.0)
return INFINITY;
if (x != 0.0)
return 0.0;
}
if (y <= -LDBL_MAX) {
if (x > 1.0 || x < -1.0)
return 0.0;
if (x != 0.0 || y == -INFINITY)
return INFINITY;
}
if (x >= LDBL_MAX) {
if (y > 0.0)
return INFINITY;
return 0.0;
}
w = floorl(y);
/* Set iyflg to 1 if y is an integer. */
iyflg = 0;
if (w == y)
iyflg = 1;
/* Test for odd integer y. */
yoddint = 0;
if (iyflg) {
ya = fabsl(y);
ya = floorl(0.5 * ya);
yb = 0.5 * fabsl(w);
if( ya != yb )
yoddint = 1;
}
if (x <= -LDBL_MAX) {
if (y > 0.0) {
if (yoddint)
return -INFINITY;
return INFINITY;
}
if (y < 0.0) {
if (yoddint)
return -0.0;
return 0.0;
}
}
nflg = 0; /* (x<0)**(odd int) */
if (x <= 0.0) {
if (x == 0.0) {
if (y < 0.0) {
if (signbit(x) && yoddint)
/* (-0.0)**(-odd int) = -inf, divbyzero */
return -1.0/0.0;
/* (+-0.0)**(negative) = inf, divbyzero */
return 1.0/0.0;
}
if (signbit(x) && yoddint)
return -0.0;
return 0.0;
}
if (iyflg == 0)
return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */
/* (x<0)**(integer) */
if (yoddint)
nflg = 1; /* negate result */
x = -x;
}
/* (+integer)**(integer) */
if (iyflg && floorl(x) == x && fabsl(y) < 32768.0) {
w = powil(x, (int)y);
return nflg ? -w : w;
}
/* separate significand from exponent */
x = frexpl(x, &i);
e = i;
/* find significand in antilog table A[] */
i = 1;
if (x <= A[17])
i = 17;
if (x <= A[i+8])
i += 8;
if (x <= A[i+4])
i += 4;
if (x <= A[i+2])
i += 2;
if (x >= A[1])
i = -1;
i += 1;
/* Find (x - A[i])/A[i]
* in order to compute log(x/A[i]):
*
* log(x) = log( a x/a ) = log(a) + log(x/a)
*
* log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a
*/
x -= A[i];
x -= B[i/2];
x /= A[i];
/* rational approximation for log(1+v):
*
* log(1+v) = v - v**2/2 + v**3 P(v) / Q(v)
*/
z = x*x;
w = x * (z * __polevll(x, P, 3) / __p1evll(x, Q, 3));
w = w - 0.5*z;
/* Convert to base 2 logarithm:
* multiply by log2(e) = 1 + LOG2EA
*/
z = LOG2EA * w;
z += w;
z += LOG2EA * x;
z += x;
/* Compute exponent term of the base 2 logarithm. */
w = -i;
w /= NXT;
w += e;
/* Now base 2 log of x is w + z. */
/* Multiply base 2 log by y, in extended precision. */
/* separate y into large part ya
* and small part yb less than 1/NXT
*/
ya = reducl(y);
yb = y - ya;
/* (w+z)(ya+yb)
* = w*ya + w*yb + z*y
*/
F = z * y + w * yb;
Fa = reducl(F);
Fb = F - Fa;
G = Fa + w * ya;
Ga = reducl(G);
Gb = G - Ga;
H = Fb + Gb;
Ha = reducl(H);
w = (Ga + Ha) * NXT;
/* Test the power of 2 for overflow */
if (w > MEXP)
return huge * huge; /* overflow */
if (w < MNEXP)
return twom10000 * twom10000; /* underflow */
e = w;
Hb = H - Ha;
if (Hb > 0.0) {
e += 1;
Hb -= 1.0/NXT; /*0.0625L;*/
}
/* Now the product y * log2(x) = Hb + e/NXT.
*
* Compute base 2 exponential of Hb,
* where -0.0625 <= Hb <= 0.
*/
z = Hb * __polevll(Hb, R, 6); /* z = 2**Hb - 1 */
/* Express e/NXT as an integer plus a negative number of (1/NXT)ths.
* Find lookup table entry for the fractional power of 2.
*/
if (e < 0)
i = 0;
else
i = 1;
i = e/NXT + i;
e = NXT*i - e;
w = A[e];
z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */
z = z + w;
z = scalbnl(z, i); /* multiply by integer power of 2 */
if (nflg)
z = -z;
return z;
}
long double
hypotl(long double x, long double y) {
int n0, n1, n2, n3;
long double t1, t2, y1, y2, w;
int *px = (int *) &x, *py = (int *) &y;
int *pt1 = (int *) &t1, *py1 = (int *) &y1;
enum fp_direction_type rd;
int j, k, nx, ny, nz;
if ((*(int *) &one) != 0) { /* determine word ordering */
n0 = 0;
n1 = 1;
n2 = 2;
n3 = 3;
} else {
n0 = 3;
n1 = 2;
n2 = 1;
n3 = 0;
}
px[n0] &= 0x7fffffff; /* clear sign bit of x and y */
py[n0] &= 0x7fffffff;
k = 0x7fff0000;
nx = px[n0] & k; /* exponent of x and y */
ny = py[n0] & k;
if (ny > nx) {
w = x;
x = y;
y = w;
nz = ny;
ny = nx;
nx = nz;
} /* force x > y */
if ((nx - ny) >= 0x00730000)
return (x + y); /* x/y >= 2**116 */
if (nx < 0x5ff30000 && ny > 0x205b0000) { /* medium x,y */
/* save and set RD to Rounding to nearest */
rd = __swapRD(fp_nearest);
w = x - y;
if (w > y) {
pt1[n0] = px[n0];
pt1[n1] = px[n1];
pt1[n2] = pt1[n3] = 0;
t2 = x - t1;
x = sqrtl(t1 * t1 - (y * (-y) - t2 * (x + t1)));
} else {
x = x + x;
py1[n0] = py[n0];
py1[n1] = py[n1];
py1[n2] = py1[n3] = 0;
y2 = y - y1;
pt1[n0] = px[n0];
pt1[n1] = px[n1];
pt1[n2] = pt1[n3] = 0;
t2 = x - t1;
x = sqrtl(t1 * y1 - (w * (-w) - (t2 * y1 + y2 * x)));
}
if (rd != fp_nearest)
(void) __swapRD(rd); /* restore rounding mode */
return (x);
} else {
if (nx == k || ny == k) { /* x or y is INF or NaN */
if (isinfl(x))
t2 = x;
else if (isinfl(y))
t2 = y;
else
t2 = x + y; /* invalid if x or y is sNaN */
return (t2);
}
if (ny == 0) {
if (y == zero || x == zero)
return (x + y);
t1 = scalbnl(one, 16381);
x *= t1;
y *= t1;
return (scalbnl(one, -16381) * hypotl(x, y));
}
j = nx - 0x3fff0000;
px[n0] -= j;
py[n0] -= j;
pt1[n0] = nx;
pt1[n1] = pt1[n2] = pt1[n3] = 0;
return (t1 * hypotl(x, y));
}
}
