--- /dev/null
+#ifndef _COMPLEX_H
+#define _COMPLEX_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define complex _Complex
+#define _Complex_I 1.0fi
+#define I _Complex_I
+
+double complex cacos(double complex);
+float complex cacosf(float complex);
+long double complex cacosl(long double complex);
+
+double complex casin(double complex);
+float complex casinf(float complex);
+long double complex casinl(long double complex);
+
+double complex catan(double complex);
+float complex catanf(float complex);
+long double complex catanl(long double complex);
+
+double complex ccos(double complex);
+float complex ccosf(float complex);
+long double complex ccosl(long double complex);
+
+double complex csin(double complex);
+float complex csinf(float complex);
+long double complex csinl(long double complex);
+
+double complex ctan(double complex);
+float complex ctanf(float complex);
+long double complex ctanl(long double complex);
+
+double complex cacosh(double complex);
+float complex cacoshf(float complex);
+long double complex cacoshl(long double complex);
+
+double complex casinh(double complex);
+float complex casinhf(float complex);
+long double complex casinhl(long double complex);
+
+double complex catanh(double complex);
+float complex catanhf(float complex);
+long double complex catanhl(long double complex);
+
+double complex ccosh(double complex);
+float complex ccoshf(float complex);
+long double complex ccoshl(long double complex);
+
+double complex csinh(double complex);
+float complex csinhf(float complex);
+long double complex csinhl(long double complex);
+
+double complex ctanh(double complex);
+float complex ctanhf(float complex);
+long double complex ctanhl(long double complex);
+
+double complex cexp(double complex);
+float complex cexpf(float complex);
+long double complex cexpl(long double complex);
+
+double complex clog(double complex);
+float complex clogf(float complex);
+long double complex clogl(long double complex);
+
+double cabs(double complex);
+float cabsf(float complex);
+long double cabsl(long double complex);
+
+double complex cpow(double complex, double complex);
+float complex cpowf(float complex, float complex);
+long double complex cpowl(long double complex, long double complex);
+
+double complex csqrt(double complex);
+float complex csqrtf(float complex);
+long double complex csqrtl(long double complex);
+
+double carg(double complex);
+float cargf(float complex);
+long double cargl(long double complex);
+
+double cimag(double complex);
+float cimagf(float complex);
+long double cimagl(long double complex);
+
+double complex conj(double complex);
+float complex conjf(float complex);
+long double complex conjl(long double complex);
+
+double complex cproj(double complex);
+float complex cprojf(float complex);
+long double complex cprojl(long double complex);
+
+double creal(double complex);
+float crealf(float complex);
+long double creall(long double complex);
+
+#ifdef __cplusplus
+}
+#endif
+#endif
#define FP_SUBNORMAL 3
#define FP_NORMAL 4
-int __fpclassifyf(float);
int __fpclassify(double);
+int __fpclassifyf(float);
int __fpclassifyl(long double);
+#define __FLOAT_BITS(f) (((union { float __f; __uint32_t __i; }){ (f) }).__i)
+#define __DOUBLE_BITS(f) (((union { double __f; __uint64_t __i; }){ (f) }).__i)
+
#define fpclassify(x) ( \
sizeof(x) == sizeof(float) ? __fpclassifyf(x) : \
sizeof(x) == sizeof(double) ? __fpclassify(x) : \
__fpclassifyl(x) )
-#define isinf(x) (fpclassify(x) == FP_INFINITE)
-#define isnan(x) (fpclassify(x) == FP_NAN)
-#define isnormal(x) (fpclassify(x) == FP_NORMAL)
-#define isfinite(x) (fpclassify(x) > FP_INFINITE)
+#define isinf(x) ( \
+ sizeof(x) == sizeof(float) ? (__FLOAT_BITS(x) & 0x7fffffff) == 0x7f800000 : \
+ sizeof(x) == sizeof(double) ? (__DOUBLE_BITS(x) & (__uint64_t)-1>>1) == (__uint64_t)0x7ff<<52 : \
+ __fpclassifyl(x) == FP_INFINITE)
+
+#define isnan(x) ( \
+ sizeof(x) == sizeof(float) ? (__FLOAT_BITS(x) & 0x7fffffff) > 0x7f800000 : \
+ sizeof(x) == sizeof(double) ? (__DOUBLE_BITS(x) & (__uint64_t)-1>>1) > (__uint64_t)0x7ff<<52 : \
+ __fpclassifyl(x) == FP_NAN)
+
+#define isnormal(x) ( \
+ sizeof(x) == sizeof(float) ? ((__FLOAT_BITS(x)+0x00800000) & 0x7fffffff) >= 0x01000000 : \
+ sizeof(x) == sizeof(double) ? ((__DOUBLE_BITS(x)+((__uint64_t)1<<52)) & (__uint64_t)-1>>1) >= (__uint64_t)1<<53 : \
+ __fpclassifyl(x) == FP_NORMAL)
-#define isunordered(x,y) (isnan((x)) ? ((y),1) : isnan((y)))
+#define isfinite(x) ( \
+ sizeof(x) == sizeof(float) ? (__FLOAT_BITS(x) & 0x7fffffff) < 0x7f800000 : \
+ sizeof(x) == sizeof(double) ? (__DOUBLE_BITS(x) & (__uint64_t)-1>>1) < (__uint64_t)0x7ff<<52 : \
+ __fpclassifyl(x) > FP_INFINITE)
+
+int __signbit(double);
+int __signbitf(float);
+int __signbitl(long double);
+
+#define signbit(x) ( \
+ sizeof(x) == sizeof(float) ? !!(__FLOAT_BITS(x) & 0x80000000) : \
+ sizeof(x) == sizeof(double) ? !!(__DOUBLE_BITS(x) & (__uint64_t)1<<63) : \
+ __signbitl(x) )
+
+#define isunordered(x,y) (isnan((x)) ? ((void)(y),1) : isnan((y)))
-static
#if __STDC_VERSION__ >= 199901L
inline
#endif
-int __isrel(long double __x, long double __y, int __rel)
+static int __isrel(long double __x, long double __y, int __rel)
{
if (isunordered(__x, __y)) return 0;
if (__rel==-2) return __x < __y;
#define M_2_SQRTPI 1.12837916709551257390 /* 2/sqrt(pi) */
#define M_SQRT2 1.41421356237309504880 /* sqrt(2) */
#define M_SQRT1_2 0.70710678118654752440 /* 1/sqrt(2) */
+
+extern int signgam;
+
+double gamma(double);
+float gammaf(float);
+long double gammal(long double);
+
+double lgamma_r(double, int*);
+float lgammaf_r(float, int*);
+long double lgammal_r(long double, int*);
+
double j0(double);
+float j0f(float);
+long double j0l(long double);
+
double j1(double);
+float j1f(float);
+long double j1l(long double);
+
double jn(int, double);
+float jnf(int, float);
+long double jnl(int, long double);
+
double y0(double);
+float y0f(float);
+long double y0l(long double);
+
double y1(double);
+float y1f(float);
+long double y1l(long double);
+
double yn(int, double);
-extern int signgam;
+float ynf(int, float);
+long double ynl(int, long double);
#endif
#ifdef _GNU_SOURCE
double scalb(double, double);
+float scalbf(float, float);
+long double scalbl(long double, long double);
#endif
#ifdef __cplusplus
--- /dev/null
+#ifndef _TGMATH_H
+#define _TGMATH_H
+
+/*
+the return types are only correct with gcc (__GNUC__)
+otherwise they are long double or long double complex
+
+the long double version of a function is never chosen when
+sizeof(double) == sizeof(long double)
+(but the return type is set correctly with gcc)
+*/
+
+#include <math.h>
+#include <complex.h>
+
+#define __IS_FP(x) !!((1?1:(x))/2)
+#define __IS_CX(x) (__IS_FP(x) && sizeof(x) == sizeof((x)+I))
+#define __IS_REAL(x) (__IS_FP(x) && 2*sizeof(x) == sizeof((x)+I))
+
+#define __FLT(x) (__IS_REAL(x) && sizeof(x) == sizeof(float))
+#define __LDBL(x) (__IS_REAL(x) && sizeof(x) == sizeof(long double) && sizeof(long double) != sizeof(double))
+
+#define __FLTCX(x) (__IS_CX(x) && sizeof(x) == sizeof(float complex))
+#define __DBLCX(x) (__IS_CX(x) && sizeof(x) == sizeof(double complex))
+#define __LDBLCX(x) (__IS_CX(x) && sizeof(x) == sizeof(long double complex) && sizeof(long double) != sizeof(double))
+
+/* return type */
+
+#ifdef __GNUC__
+/* cast to double when x is integral, otherwise use typeof(x) */
+#define __RETCAST(x) (__typeof__(*( \
+ 0 ? (__typeof__(0 ? (double *)0 : (void *)__IS_FP(x)))0 : \
+ (__typeof__(0 ? (__typeof__(x) *)0 : (void *)!__IS_FP(x)))0 )))
+/* 2 args case, consider complex types (for cpow) */
+#define __RETCAST_2(x, y) (__typeof__(*( \
+ 0 ? (__typeof__(0 ? (double *)0 : \
+ (void *)!((!__IS_FP(x) || !__IS_FP(y)) && __FLT((x)+(y)+1.0f))))0 : \
+ 0 ? (__typeof__(0 ? (double complex *)0 : \
+ (void *)!((!__IS_FP(x) || !__IS_FP(y)) && __FLTCX((x)+(y)))))0 : \
+ (__typeof__(0 ? (__typeof__((x)+(y)) *)0 : \
+ (void *)((!__IS_FP(x) || !__IS_FP(y)) && (__FLT((x)+(y)+1.0f) || __FLTCX((x)+(y))))))0 )))
+/* 3 args case, don't consider complex types (fma only) */
+#define __RETCAST_3(x, y, z) (__typeof__(*( \
+ 0 ? (__typeof__(0 ? (double *)0 : \
+ (void *)!((!__IS_FP(x) || !__IS_FP(y) || !__IS_FP(z)) && __FLT((x)+(y)+(z)+1.0f))))0 : \
+ (__typeof__(0 ? (__typeof__((x)+(y)) *)0 : \
+ (void *)((!__IS_FP(x) || !__IS_FP(y) || !__IS_FP(z)) && __FLT((x)+(y)+(z)+1.0f))))0 )))
+/* drop complex from the type of x */
+#define __TO_REAL(x) *( \
+ 0 ? (__typeof__(0 ? (double *)0 : (void *)!__DBLCX(x)))0 : \
+ 0 ? (__typeof__(0 ? (float *)0 : (void *)!__FLTCX(x)))0 : \
+ 0 ? (__typeof__(0 ? (long double *)0 : (void *)!__LDBLCX(x)))0 : \
+ (__typeof__(0 ? (__typeof__(x) *)0 : (void *)__IS_CX(x)))0 )
+#else
+#define __RETCAST(x)
+#define __RETCAST_2(x, y)
+#define __RETCAST_3(x, y, z)
+#endif
+
+/* function selection */
+
+#define __tg_real(fun, x) (__RETCAST(x)( \
+ __FLT(x) ? fun ## f (x) : \
+ __LDBL(x) ? fun ## l (x) : \
+ fun(x) ))
+
+#define __tg_real_2_1(fun, x, y) (__RETCAST(x)( \
+ __FLT(x) ? fun ## f (x, y) : \
+ __LDBL(x) ? fun ## l (x, y) : \
+ fun(x, y) ))
+
+#define __tg_real_2(fun, x, y) (__RETCAST_2(x, y)( \
+ __FLT(x) && __FLT(y) ? fun ## f (x, y) : \
+ __LDBL((x)+(y)) ? fun ## l (x, y) : \
+ fun(x, y) ))
+
+#define __tg_complex(fun, x) (__RETCAST((x)+I)( \
+ __FLTCX((x)+I) && __IS_FP(x) ? fun ## f (x) : \
+ __LDBLCX((x)+I) ? fun ## l (x) : \
+ fun(x) ))
+
+#define __tg_complex_retreal(fun, x) (__RETCAST(__TO_REAL(x))( \
+ __FLTCX((x)+I) && __IS_FP(x) ? fun ## f (x) : \
+ __LDBLCX((x)+I) ? fun ## l (x) : \
+ fun(x) ))
+
+#define __tg_real_complex(fun, x) (__RETCAST(x)( \
+ __FLTCX(x) ? c ## fun ## f (x) : \
+ __DBLCX(x) ? c ## fun (x) : \
+ __LDBLCX(x) ? c ## fun ## l (x) : \
+ __FLT(x) ? fun ## f (x) : \
+ __LDBL(x) ? fun ## l (x) : \
+ fun(x) ))
+
+/* special cases */
+
+#define __tg_real_remquo(x, y, z) (__RETCAST_2(x, y)( \
+ __FLT(x) && __FLT(y) ? remquof(x, y, z) : \
+ __LDBL((x)+(y)) ? remquol(x, y, z) : \
+ remquo(x, y, z) ))
+
+#define __tg_real_fma(x, y, z) (__RETCAST_3(x, y, z)( \
+ __FLT(x) && __FLT(y) && __FLT(z) ? fmaf(x, y, z) : \
+ __LDBL((x)+(y)+(z)) ? fmal(x, y, z) : \
+ fma(x, y, z) ))
+
+#define __tg_real_complex_pow(x, y) (__RETCAST_2(x, y)( \
+ __FLTCX((x)+(y)) && __IS_FP(x) && __IS_FP(y) ? cpowf(x, y) : \
+ __FLTCX((x)+(y)) ? cpow(x, y) : \
+ __DBLCX((x)+(y)) ? cpow(x, y) : \
+ __LDBLCX((x)+(y)) ? cpowl(x, y) : \
+ __FLT(x) && __FLT(y) ? powf(x, y) : \
+ __LDBL((x)+(y)) ? powl(x, y) : \
+ pow(x, y) ))
+
+#define __tg_real_complex_fabs(x) (__RETCAST(__TO_REAL(x))( \
+ __FLTCX(x) ? cabsf(x) : \
+ __DBLCX(x) ? cabs(x) : \
+ __LDBLCX(x) ? cabsl(x) : \
+ __FLT(x) ? fabsf(x) : \
+ __LDBL(x) ? fabsl(x) : \
+ fabs(x) ))
+
+/* tg functions */
+
+#define acos(x) __tg_real_complex(acos, (x))
+#define acosh(x) __tg_real_complex(acosh, (x))
+#define asin(x) __tg_real_complex(asin, (x))
+#define asinh(x) __tg_real_complex(asinh, (x))
+#define atan(x) __tg_real_complex(atan, (x))
+#define atan2(x,y) __tg_real_2(atan2, (x), (y))
+#define atanh(x) __tg_real_complex(atanh, (x))
+#define carg(x) __tg_complex_retreal(carg, (x))
+#define cbrt(x) __tg_real(cbrt, (x))
+#define ceil(x) __tg_real(ceil, (x))
+#define cimag(x) __tg_complex_retreal(cimag, (x))
+#define conj(x) __tg_complex(conj, (x))
+#define copysign(x,y) __tg_real_2(copysign, (x), (y))
+#define cos(x) __tg_real_complex(cos, (x))
+#define cosh(x) __tg_real_complex(cosh, (x))
+#define cproj(x) __tg_complex(cproj, (x))
+#define creal(x) __tg_complex_retreal(creal, (x))
+#define erf(x) __tg_real(erf, (x))
+#define erfc(x) __tg_real(erfc, (x))
+#define exp(x) __tg_real_complex(exp, (x))
+#define exp2(x) __tg_real(exp2, (x))
+#define expm1(x) __tg_real(expm1, (x))
+#define fabs(x) __tg_real_complex_fabs(x)
+#define fdim(x,y) __tg_real_2(fdim, (x), (y))
+#define floor(x) __tg_real(floor, (x))
+#define fma(x,y,z) __tg_real_fma((x), (y), (z))
+#define fmax(x,y) __tg_real_2(fmax, (x), (y))
+#define fmin(x,y) __tg_real_2(fmin, (x), (y))
+#define fmod(x,y) __tg_real_2(fmod, (x), (y))
+#define frexp(x,y) __tg_real_2_1(frexp, (x), (y))
+#define hypot(x,y) __tg_real_2(hypot, (x), (y))
+#define ilogb(x) __tg_real(ilogb, (x))
+#define ldexp(x,y) __tg_real_2_1(ldexp, (x), (y))
+#define lgamma(x) __tg_real(lgamma, (x))
+#define llrint(x) __tg_real(llrint, (x))
+#define llround(x) __tg_real(llround, (x))
+#define log(x) __tg_real_complex(log, (x))
+#define log10(x) __tg_real(log10, (x))
+#define log1p(x) __tg_real(log1p, (x))
+#define log2(x) __tg_real(log2, (x))
+#define logb(x) __tg_real(logb, (x))
+#define lrint(x) __tg_real(lrint, (x))
+#define lround(x) __tg_real(lround, (x))
+#define nearbyint(x) __tg_real(nearbyint, (x))
+#define nextafter(x,y) __tg_real_2(nextafter, (x), (y)
+#define nexttoward(x,y) __tg_real_2(nexttoward, (x), (y))
+#define pow(x,y) __tg_real_complex_pow((x), (y))
+#define remainder(x,y) __tg_real_2(remainder, (x), (y))
+#define remquo(x,y,z) __tg_real_remquo((x), (y), (z))
+#define rint(x) __tg_real(rint, (x))
+#define round(x) __tg_real(round, (x))
+#define scalbln(x,y) __tg_real_2_1(scalbln, (x), (y))
+#define scalbn(x,y) __tg_real_2_1(scalbn, (x), (y))
+#define sin(x) __tg_real_complex(sin, (x))
+#define sinh(x) __tg_real_complex(sinh, (x))
+#define sqrt(x) __tg_real_complex(sqrt, (x))
+#define tan(x) __tg_real_complex(tan, (x))
+#define tanh(x) __tg_real_complex(tanh, (x))
+#define tgamma(x) __tg_real(tgamma, (x))
+#define trunc(x) __tg_real(trunc, (x))
+
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_exp.c */
+/*-
+ * Copyright (c) 2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+static const uint32_t k = 1799; /* constant for reduction */
+static const double kln2 = 1246.97177782734161156; /* k * ln2 */
+
+/*
+ * Compute exp(x), scaled to avoid spurious overflow. An exponent is
+ * returned separately in 'expt'.
+ *
+ * Input: ln(DBL_MAX) <= x < ln(2 * DBL_MAX / DBL_MIN_DENORM) ~= 1454.91
+ * Output: 2**1023 <= y < 2**1024
+ */
+static double __frexp_exp(double x, int *expt)
+{
+ double exp_x;
+ uint32_t hx;
+
+ /*
+ * We use exp(x) = exp(x - kln2) * 2**k, carefully chosen to
+ * minimize |exp(kln2) - 2**k|. We also scale the exponent of
+ * exp_x to MAX_EXP so that the result can be multiplied by
+ * a tiny number without losing accuracy due to denormalization.
+ */
+ exp_x = exp(x - kln2);
+ GET_HIGH_WORD(hx, exp_x);
+ *expt = (hx >> 20) - (0x3ff + 1023) + k;
+ SET_HIGH_WORD(exp_x, (hx & 0xfffff) | ((0x3ff + 1023) << 20));
+ return exp_x;
+}
+
+/*
+ * __ldexp_cexp(x, expt) compute exp(x) * 2**expt.
+ * It is intended for large arguments (real part >= ln(DBL_MAX))
+ * where care is needed to avoid overflow.
+ *
+ * The present implementation is narrowly tailored for our hyperbolic and
+ * exponential functions. We assume expt is small (0 or -1), and the caller
+ * has filtered out very large x, for which overflow would be inevitable.
+ */
+double complex __ldexp_cexp(double complex z, int expt)
+{
+ double x, y, exp_x, scale1, scale2;
+ int ex_expt, half_expt;
+
+ x = creal(z);
+ y = cimag(z);
+ exp_x = __frexp_exp(x, &ex_expt);
+ expt += ex_expt;
+
+ /*
+ * Arrange so that scale1 * scale2 == 2**expt. We use this to
+ * compensate for scalbn being horrendously slow.
+ */
+ half_expt = expt / 2;
+ INSERT_WORDS(scale1, (0x3ff + half_expt) << 20, 0);
+ half_expt = expt - half_expt;
+ INSERT_WORDS(scale2, (0x3ff + half_expt) << 20, 0);
+
+ return cpack(cos(y) * exp_x * scale1 * scale2, sin(y) * exp_x * scale1 * scale2);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_expf.c */
+/*-
+ * Copyright (c) 2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+static const uint32_t k = 235; /* constant for reduction */
+static const float kln2 = 162.88958740F; /* k * ln2 */
+
+/*
+ * See __cexp.c for details.
+ *
+ * Input: ln(FLT_MAX) <= x < ln(2 * FLT_MAX / FLT_MIN_DENORM) ~= 192.7
+ * Output: 2**127 <= y < 2**128
+ */
+static float __frexp_expf(float x, int *expt)
+{
+ float exp_x;
+ uint32_t hx;
+
+ exp_x = expf(x - kln2);
+ GET_FLOAT_WORD(hx, exp_x);
+ *expt = (hx >> 23) - (0x7f + 127) + k;
+ SET_FLOAT_WORD(exp_x, (hx & 0x7fffff) | ((0x7f + 127) << 23));
+ return exp_x;
+}
+
+float complex __ldexp_cexpf(float complex z, int expt)
+{
+ float x, y, exp_x, scale1, scale2;
+ int ex_expt, half_expt;
+
+ x = crealf(z);
+ y = cimagf(z);
+ exp_x = __frexp_expf(x, &ex_expt);
+ expt += ex_expt;
+
+ half_expt = expt / 2;
+ SET_FLOAT_WORD(scale1, (0x7f + half_expt) << 23);
+ half_expt = expt - half_expt;
+ SET_FLOAT_WORD(scale2, (0x7f + half_expt) << 23);
+
+ return cpackf(cosf(y) * exp_x * scale1 * scale2,
+ sinf(y) * exp_x * scale1 * scale2);
+}
--- /dev/null
+#include "libm.h"
+
+double cabs(double complex z)
+{
+ return hypot(creal(z), cimag(z));
+}
--- /dev/null
+#include "libm.h"
+
+float cabsf(float complex z)
+{
+ return hypotf(crealf(z), cimagf(z));
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double cabsl(long double complex z)
+{
+ return cabs(z);
+}
+#else
+long double cabsl(long double complex z)
+{
+ return hypotl(creall(z), cimagl(z));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+// FIXME: Hull et al. "Implementing the complex arcsine and arccosine functions using exception handling" 1997
+
+/* acos(z) = pi/2 - asin(z) */
+
+double complex cacos(double complex z)
+{
+ z = casin(z);
+ return cpack(M_PI_2 - creal(z), -cimag(z));
+}
--- /dev/null
+#include "libm.h"
+
+// FIXME
+
+float complex cacosf(float complex z)
+{
+ z = casinf(z);
+ return cpackf((float)M_PI_2 - crealf(z), -cimagf(z));
+}
--- /dev/null
+#include "libm.h"
+
+/* acosh(z) = i acos(z) */
+
+double complex cacosh(double complex z)
+{
+ z = cacos(z);
+ return cpack(-cimag(z), creal(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex cacoshf(float complex z)
+{
+ z = cacosf(z);
+ return cpackf(-cimagf(z), crealf(z));
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex cacoshl(long double complex z)
+{
+ return cacosh(z);
+}
+#else
+long double complex cacoshl(long double complex z)
+{
+ z = cacosl(z);
+ return cpackl(-cimagl(z), creall(z));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex cacosl(long double complex z)
+{
+ return cacos(z);
+}
+#else
+// FIXME
+#define PI_2 1.57079632679489661923132169163975144L
+long double complex cacosl(long double complex z)
+{
+ z = casinl(z);
+ return cpackl(PI_2 - creall(z), -cimagl(z));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double carg(double complex z)
+{
+ return atan2(cimag(z), creal(z));
+}
--- /dev/null
+#include "libm.h"
+
+float cargf(float complex z)
+{
+ return atan2f(cimagf(z), crealf(z));
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double cargl(long double complex z)
+{
+ return carg(z);
+}
+#else
+long double cargl(long double complex z)
+{
+ return atan2l(cimagl(z), creall(z));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+// FIXME
+
+/* asin(z) = -i log(i z + sqrt(1 - z*z)) */
+
+double complex casin(double complex z)
+{
+ double complex w;
+ double x, y;
+
+ x = creal(z);
+ y = cimag(z);
+ w = cpack(1.0 - (x - y)*(x + y), -2.0*x*y);
+ return clog(cpack(-y, x) + csqrt(w));
+}
--- /dev/null
+#include "libm.h"
+
+// FIXME
+
+float complex casinf(float complex z)
+{
+ float complex w;
+ float x, y;
+
+ x = crealf(z);
+ y = cimagf(z);
+ w = cpackf(1.0 - (x - y)*(x + y), -2.0*x*y);
+ return clogf(cpackf(-y, x) + csqrtf(w));
+}
--- /dev/null
+#include "libm.h"
+
+/* asinh(z) = -i asin(i z) */
+
+double complex casinh(double complex z)
+{
+ z = casin(cpack(-cimag(z), creal(z)));
+ return cpack(cimag(z), -creal(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex casinhf(float complex z)
+{
+ z = casinf(cpackf(-cimagf(z), crealf(z)));
+ return cpackf(cimagf(z), -crealf(z));
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex casinhl(long double complex z)
+{
+ return casinh(z);
+}
+#else
+long double complex casinhl(long double complex z)
+{
+ z = casinl(cpackl(-cimagl(z), creall(z)));
+ return cpackl(cimagl(z), -creall(z));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex casinl(long double complex z)
+{
+ return casin(z);
+}
+#else
+// FIXME
+long double complex casinl(long double complex z)
+{
+ long double complex w;
+ long double x, y;
+
+ x = creall(z);
+ y = cimagl(z);
+ w = cpackl(1.0 - (x - y)*(x + y), -2.0*x*y);
+ return clogl(cpackl(-y, x) + csqrtl(w));
+}
+#endif
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/s_catan.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Complex circular arc tangent
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double complex catan();
+ * double complex z, w;
+ *
+ * w = catan (z);
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ * 1 ( 2x )
+ * Re w = - arctan(-----------) + k PI
+ * 2 ( 2 2)
+ * (1 - x - y )
+ *
+ * ( 2 2)
+ * 1 (x + (y+1) )
+ * Im w = - log(------------)
+ * 4 ( 2 2)
+ * (x + (y-1) )
+ *
+ * Where k is an arbitrary integer.
+ *
+ * catan(z) = -i catanh(iz).
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5900 1.3e-16 7.8e-18
+ * IEEE -10,+10 30000 2.3e-15 8.5e-17
+ * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2,
+ * had peak relative error 1.5e-16, rms relative error
+ * 2.9e-17. See also clog().
+ */
+
+#include "libm.h"
+
+#define MAXNUM 1.0e308
+
+static const double DP1 = 3.14159265160560607910E0;
+static const double DP2 = 1.98418714791870343106E-9;
+static const double DP3 = 1.14423774522196636802E-17;
+
+static double _redupi(double x)
+{
+ double t;
+ long i;
+
+ t = x/M_PI;
+ if (t >= 0.0)
+ t += 0.5;
+ else
+ t -= 0.5;
+
+ i = t; /* the multiple */
+ t = i;
+ t = ((x - t * DP1) - t * DP2) - t * DP3;
+ return t;
+}
+
+double complex catan(double complex z)
+{
+ double complex w;
+ double a, t, x, x2, y;
+
+ x = creal(z);
+ y = cimag(z);
+
+ if (x == 0.0 && y > 1.0)
+ goto ovrf;
+
+ x2 = x * x;
+ a = 1.0 - x2 - (y * y);
+ if (a == 0.0)
+ goto ovrf;
+
+ t = 0.5 * atan2(2.0 * x, a);
+ w = _redupi(t);
+
+ t = y - 1.0;
+ a = x2 + (t * t);
+ if (a == 0.0)
+ goto ovrf;
+
+ t = y + 1.0;
+ a = (x2 + t * t)/a;
+ w = w + (0.25 * log(a)) * I;
+ return w;
+
+ovrf:
+ // FIXME
+ w = MAXNUM + MAXNUM * I;
+ return w;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/s_catanf.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Complex circular arc tangent
+ *
+ *
+ * SYNOPSIS:
+ *
+ * float complex catanf();
+ * float complex z, w;
+ *
+ * w = catanf( z );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ * 1 ( 2x )
+ * Re w = - arctan(-----------) + k PI
+ * 2 ( 2 2)
+ * (1 - x - y )
+ *
+ * ( 2 2)
+ * 1 (x + (y+1) )
+ * Im w = - log(------------)
+ * 4 ( 2 2)
+ * (x + (y-1) )
+ *
+ * Where k is an arbitrary integer.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -10,+10 30000 2.3e-6 5.2e-8
+ */
+
+#include "libm.h"
+
+#define MAXNUMF 1.0e38F
+
+static const double DP1 = 3.140625;
+static const double DP2 = 9.67502593994140625E-4;
+static const double DP3 = 1.509957990978376432E-7;
+
+static float _redupif(float xx)
+{
+ float x, t;
+ long i;
+
+ x = xx;
+ t = x/(float)M_PI;
+ if (t >= 0.0f)
+ t += 0.5f;
+ else
+ t -= 0.5f;
+
+ i = t; /* the multiple */
+ t = i;
+ t = ((x - t * DP1) - t * DP2) - t * DP3;
+ return t;
+}
+
+float complex catanf(float complex z)
+{
+ float complex w;
+ float a, t, x, x2, y;
+
+ x = crealf(z);
+ y = cimagf(z);
+
+ if ((x == 0.0f) && (y > 1.0f))
+ goto ovrf;
+
+ x2 = x * x;
+ a = 1.0f - x2 - (y * y);
+ if (a == 0.0f)
+ goto ovrf;
+
+ t = 0.5f * atan2f(2.0f * x, a);
+ w = _redupif(t);
+
+ t = y - 1.0f;
+ a = x2 + (t * t);
+ if (a == 0.0f)
+ goto ovrf;
+
+ t = y + 1.0f;
+ a = (x2 + (t * t))/a;
+ w = w + (0.25f * logf (a)) * I;
+ return w;
+
+ovrf:
+ // FIXME
+ w = MAXNUMF + MAXNUMF * I;
+ return w;
+}
--- /dev/null
+#include "libm.h"
+
+/* atanh = -i atan(i z) */
+
+double complex catanh(double complex z)
+{
+ z = catan(cpack(-cimag(z), creal(z)));
+ return cpack(cimag(z), -creal(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex catanhf(float complex z)
+{
+ z = catanf(cpackf(-cimagf(z), crealf(z)));
+ return cpackf(cimagf(z), -crealf(z));
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex catanhl(long double complex z)
+{
+ return catanh(z);
+}
+#else
+long double complex catanhl(long double complex z)
+{
+ z = catanl(cpackl(-cimagl(z), creall(z)));
+ return cpackl(cimagl(z), -creall(z));
+}
+#endif
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/s_catanl.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Complex circular arc tangent
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double complex catanl();
+ * long double complex z, w;
+ *
+ * w = catanl( z );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * If
+ * z = x + iy,
+ *
+ * then
+ * 1 ( 2x )
+ * Re w = - arctan(-----------) + k PI
+ * 2 ( 2 2)
+ * (1 - x - y )
+ *
+ * ( 2 2)
+ * 1 (x + (y+1) )
+ * Im w = - log(------------)
+ * 4 ( 2 2)
+ * (x + (y-1) )
+ *
+ * Where k is an arbitrary integer.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -10,+10 5900 1.3e-16 7.8e-18
+ * IEEE -10,+10 30000 2.3e-15 8.5e-17
+ * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2,
+ * had peak relative error 1.5e-16, rms relative error
+ * 2.9e-17. See also clog().
+ */
+
+#include <complex.h>
+#include <float.h>
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex catanl(long double complex z)
+{
+ return catan(z);
+}
+#else
+static const long double PIL = 3.141592653589793238462643383279502884197169L;
+static const long double DP1 = 3.14159265358979323829596852490908531763125L;
+static const long double DP2 = 1.6667485837041756656403424829301998703007e-19L;
+static const long double DP3 = 1.8830410776607851167459095484560349402753e-39L;
+
+static long double redupil(long double x)
+{
+ long double t;
+ long i;
+
+ t = x / PIL;
+ if (t >= 0.0L)
+ t += 0.5L;
+ else
+ t -= 0.5L;
+
+ i = t; /* the multiple */
+ t = i;
+ t = ((x - t * DP1) - t * DP2) - t * DP3;
+ return t;
+}
+
+long double complex catanl(long double complex z)
+{
+ long double complex w;
+ long double a, t, x, x2, y;
+
+ x = creall(z);
+ y = cimagl(z);
+
+ if ((x == 0.0L) && (y > 1.0L))
+ goto ovrf;
+
+ x2 = x * x;
+ a = 1.0L - x2 - (y * y);
+ if (a == 0.0L)
+ goto ovrf;
+
+ t = atan2l(2.0L * x, a) * 0.5L;
+ w = redupil(t);
+
+ t = y - 1.0L;
+ a = x2 + (t * t);
+ if (a == 0.0L)
+ goto ovrf;
+
+ t = y + 1.0L;
+ a = (x2 + (t * t)) / a;
+ w = w + (0.25L * logl(a)) * I;
+ return w;
+
+ovrf:
+ // FIXME
+ w = LDBL_MAX + LDBL_MAX * I;
+ return w;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+/* cos(z) = cosh(i z) */
+
+double complex ccos(double complex z)
+{
+ return ccosh(cpack(-cimag(z), creal(z)));
+}
--- /dev/null
+#include "libm.h"
+
+float complex ccosf(float complex z)
+{
+ return ccoshf(cpackf(-cimagf(z), crealf(z)));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ccosh.c */
+/*-
+ * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Hyperbolic cosine of a complex argument z = x + i y.
+ *
+ * cosh(z) = cosh(x+iy)
+ * = cosh(x) cos(y) + i sinh(x) sin(y).
+ *
+ * Exceptional values are noted in the comments within the source code.
+ * These values and the return value were taken from n1124.pdf.
+ */
+
+#include "libm.h"
+
+static const double huge = 0x1p1023;
+
+double complex ccosh(double complex z)
+{
+ double x, y, h;
+ int32_t hx, hy, ix, iy, lx, ly;
+
+ x = creal(z);
+ y = cimag(z);
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hy, ly, y);
+
+ ix = 0x7fffffff & hx;
+ iy = 0x7fffffff & hy;
+
+ /* Handle the nearly-non-exceptional cases where x and y are finite. */
+ if (ix < 0x7ff00000 && iy < 0x7ff00000) {
+ if ((iy | ly) == 0)
+ return cpack(cosh(x), x * y);
+ if (ix < 0x40360000) /* small x: normal case */
+ return cpack(cosh(x) * cos(y), sinh(x) * sin(y));
+
+ /* |x| >= 22, so cosh(x) ~= exp(|x|) */
+ if (ix < 0x40862e42) {
+ /* x < 710: exp(|x|) won't overflow */
+ h = exp(fabs(x)) * 0.5;
+ return cpack(h * cos(y), copysign(h, x) * sin(y));
+ } else if (ix < 0x4096bbaa) {
+ /* x < 1455: scale to avoid overflow */
+ z = __ldexp_cexp(cpack(fabs(x), y), -1);
+ return cpack(creal(z), cimag(z) * copysign(1, x));
+ } else {
+ /* x >= 1455: the result always overflows */
+ h = huge * x;
+ return cpack(h * h * cos(y), h * sin(y));
+ }
+ }
+
+ /*
+ * cosh(+-0 +- I Inf) = dNaN + I sign(d(+-0, dNaN))0.
+ * The sign of 0 in the result is unspecified. Choice = normally
+ * the same as dNaN. Raise the invalid floating-point exception.
+ *
+ * cosh(+-0 +- I NaN) = d(NaN) + I sign(d(+-0, NaN))0.
+ * The sign of 0 in the result is unspecified. Choice = normally
+ * the same as d(NaN).
+ */
+ if ((ix | lx) == 0 && iy >= 0x7ff00000)
+ return cpack(y - y, copysign(0, x * (y - y)));
+
+ /*
+ * cosh(+-Inf +- I 0) = +Inf + I (+-)(+-)0.
+ *
+ * cosh(NaN +- I 0) = d(NaN) + I sign(d(NaN, +-0))0.
+ * The sign of 0 in the result is unspecified.
+ */
+ if ((iy | ly) == 0 && ix >= 0x7ff00000) {
+ if (((hx & 0xfffff) | lx) == 0)
+ return cpack(x * x, copysign(0, x) * y);
+ return cpack(x * x, copysign(0, (x + x) * y));
+ }
+
+ /*
+ * cosh(x +- I Inf) = dNaN + I dNaN.
+ * Raise the invalid floating-point exception for finite nonzero x.
+ *
+ * cosh(x + I NaN) = d(NaN) + I d(NaN).
+ * Optionally raises the invalid floating-point exception for finite
+ * nonzero x. Choice = don't raise (except for signaling NaNs).
+ */
+ if (ix < 0x7ff00000 && iy >= 0x7ff00000)
+ return cpack(y - y, x * (y - y));
+
+ /*
+ * cosh(+-Inf + I NaN) = +Inf + I d(NaN).
+ *
+ * cosh(+-Inf +- I Inf) = +Inf + I dNaN.
+ * The sign of Inf in the result is unspecified. Choice = always +.
+ * Raise the invalid floating-point exception.
+ *
+ * cosh(+-Inf + I y) = +Inf cos(y) +- I Inf sin(y)
+ */
+ if (ix >= 0x7ff00000 && ((hx & 0xfffff) | lx) == 0) {
+ if (iy >= 0x7ff00000)
+ return cpack(x * x, x * (y - y));
+ return cpack((x * x) * cos(y), x * sin(y));
+ }
+
+ /*
+ * cosh(NaN + I NaN) = d(NaN) + I d(NaN).
+ *
+ * cosh(NaN +- I Inf) = d(NaN) + I d(NaN).
+ * Optionally raises the invalid floating-point exception.
+ * Choice = raise.
+ *
+ * cosh(NaN + I y) = d(NaN) + I d(NaN).
+ * Optionally raises the invalid floating-point exception for finite
+ * nonzero y. Choice = don't raise (except for signaling NaNs).
+ */
+ return cpack((x * x) * (y - y), (x + x) * (y - y));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ccoshf.c */
+/*-
+ * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Hyperbolic cosine of a complex argument. See s_ccosh.c for details.
+ */
+
+#include "libm.h"
+
+static const float huge = 0x1p127;
+
+float complex ccoshf(float complex z)
+{
+ float x, y, h;
+ int32_t hx, hy, ix, iy;
+
+ x = crealf(z);
+ y = cimagf(z);
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hy, y);
+
+ ix = 0x7fffffff & hx;
+ iy = 0x7fffffff & hy;
+
+ if (ix < 0x7f800000 && iy < 0x7f800000) {
+ if (iy == 0)
+ return cpackf(coshf(x), x * y);
+ if (ix < 0x41100000) /* small x: normal case */
+ return cpackf(coshf(x) * cosf(y), sinhf(x) * sinf(y));
+
+ /* |x| >= 9, so cosh(x) ~= exp(|x|) */
+ if (ix < 0x42b17218) {
+ /* x < 88.7: expf(|x|) won't overflow */
+ h = expf(fabsf(x)) * 0.5f;
+ return cpackf(h * cosf(y), copysignf(h, x) * sinf(y));
+ } else if (ix < 0x4340b1e7) {
+ /* x < 192.7: scale to avoid overflow */
+ z = __ldexp_cexpf(cpackf(fabsf(x), y), -1);
+ return cpackf(crealf(z), cimagf(z) * copysignf(1, x));
+ } else {
+ /* x >= 192.7: the result always overflows */
+ h = huge * x;
+ return cpackf(h * h * cosf(y), h * sinf(y));
+ }
+ }
+
+ if (ix == 0 && iy >= 0x7f800000)
+ return cpackf(y - y, copysignf(0, x * (y - y)));
+
+ if (iy == 0 && ix >= 0x7f800000) {
+ if ((hx & 0x7fffff) == 0)
+ return cpackf(x * x, copysignf(0, x) * y);
+ return cpackf(x * x, copysignf(0, (x + x) * y));
+ }
+
+ if (ix < 0x7f800000 && iy >= 0x7f800000)
+ return cpackf(y - y, x * (y - y));
+
+ if (ix >= 0x7f800000 && (hx & 0x7fffff) == 0) {
+ if (iy >= 0x7f800000)
+ return cpackf(x * x, x * (y - y));
+ return cpackf((x * x) * cosf(y), x * sinf(y));
+ }
+
+ return cpackf((x * x) * (y - y), (x + x) * (y - y));
+}
--- /dev/null
+#include "libm.h"
+
+//FIXME
+long double complex ccoshl(long double complex z)
+{
+ return ccosh(z);
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex ccosl(long double complex z)
+{
+ return ccos(z);
+}
+#else
+long double complex ccosl(long double complex z)
+{
+ return ccoshl(cpackl(-cimagl(z), creall(z)));
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cexp.c */
+/*-
+ * Copyright (c) 2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+static const uint32_t
+exp_ovfl = 0x40862e42, /* high bits of MAX_EXP * ln2 ~= 710 */
+cexp_ovfl = 0x4096b8e4; /* (MAX_EXP - MIN_DENORM_EXP) * ln2 */
+
+double complex cexp(double complex z)
+{
+ double x, y, exp_x;
+ uint32_t hx, hy, lx, ly;
+
+ x = creal(z);
+ y = cimag(z);
+
+ EXTRACT_WORDS(hy, ly, y);
+ hy &= 0x7fffffff;
+
+ /* cexp(x + I 0) = exp(x) + I 0 */
+ if ((hy | ly) == 0)
+ return cpack(exp(x), y);
+ EXTRACT_WORDS(hx, lx, x);
+ /* cexp(0 + I y) = cos(y) + I sin(y) */
+ if (((hx & 0x7fffffff) | lx) == 0)
+ return cpack(cos(y), sin(y));
+
+ if (hy >= 0x7ff00000) {
+ if (lx != 0 || (hx & 0x7fffffff) != 0x7ff00000) {
+ /* cexp(finite|NaN +- I Inf|NaN) = NaN + I NaN */
+ return cpack(y - y, y - y);
+ } else if (hx & 0x80000000) {
+ /* cexp(-Inf +- I Inf|NaN) = 0 + I 0 */
+ return cpack(0.0, 0.0);
+ } else {
+ /* cexp(+Inf +- I Inf|NaN) = Inf + I NaN */
+ return cpack(x, y - y);
+ }
+ }
+
+ if (hx >= exp_ovfl && hx <= cexp_ovfl) {
+ /*
+ * x is between 709.7 and 1454.3, so we must scale to avoid
+ * overflow in exp(x).
+ */
+ return __ldexp_cexp(z, 0);
+ } else {
+ /*
+ * Cases covered here:
+ * - x < exp_ovfl and exp(x) won't overflow (common case)
+ * - x > cexp_ovfl, so exp(x) * s overflows for all s > 0
+ * - x = +-Inf (generated by exp())
+ * - x = NaN (spurious inexact exception from y)
+ */
+ exp_x = exp(x);
+ return cpack(exp_x * cos(y), exp_x * sin(y));
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cexpf.c */
+/*-
+ * Copyright (c) 2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+static const uint32_t
+exp_ovfl = 0x42b17218, /* MAX_EXP * ln2 ~= 88.722839355 */
+cexp_ovfl = 0x43400074; /* (MAX_EXP - MIN_DENORM_EXP) * ln2 */
+
+float complex cexpf(float complex z)
+{
+ float x, y, exp_x;
+ uint32_t hx, hy;
+
+ x = crealf(z);
+ y = cimagf(z);
+
+ GET_FLOAT_WORD(hy, y);
+ hy &= 0x7fffffff;
+
+ /* cexp(x + I 0) = exp(x) + I 0 */
+ if (hy == 0)
+ return cpackf(expf(x), y);
+ GET_FLOAT_WORD(hx, x);
+ /* cexp(0 + I y) = cos(y) + I sin(y) */
+ if ((hx & 0x7fffffff) == 0)
+ return cpackf(cosf(y), sinf(y));
+
+ if (hy >= 0x7f800000) {
+ if ((hx & 0x7fffffff) != 0x7f800000) {
+ /* cexp(finite|NaN +- I Inf|NaN) = NaN + I NaN */
+ return cpackf(y - y, y - y);
+ } else if (hx & 0x80000000) {
+ /* cexp(-Inf +- I Inf|NaN) = 0 + I 0 */
+ return cpackf(0.0, 0.0);
+ } else {
+ /* cexp(+Inf +- I Inf|NaN) = Inf + I NaN */
+ return cpackf(x, y - y);
+ }
+ }
+
+ if (hx >= exp_ovfl && hx <= cexp_ovfl) {
+ /*
+ * x is between 88.7 and 192, so we must scale to avoid
+ * overflow in expf(x).
+ */
+ return __ldexp_cexpf(z, 0);
+ } else {
+ /*
+ * Cases covered here:
+ * - x < exp_ovfl and exp(x) won't overflow (common case)
+ * - x > cexp_ovfl, so exp(x) * s overflows for all s > 0
+ * - x = +-Inf (generated by exp())
+ * - x = NaN (spurious inexact exception from y)
+ */
+ exp_x = expf(x);
+ return cpackf(exp_x * cosf(y), exp_x * sinf(y));
+ }
+}
--- /dev/null
+#include "libm.h"
+
+//FIXME
+long double complex cexpl(long double complex z)
+{
+ return cexp(z);
+}
--- /dev/null
+#include "libm.h"
+
+double (cimag)(double complex z)
+{
+ union dcomplex u = {z};
+ return u.a[1];
+}
--- /dev/null
+#include "libm.h"
+
+float (cimagf)(float complex z)
+{
+ union fcomplex u = {z};
+ return u.a[1];
+}
--- /dev/null
+#include "libm.h"
+
+long double (cimagl)(long double complex z)
+{
+ union lcomplex u = {z};
+ return u.a[1];
+}
--- /dev/null
+#include "libm.h"
+
+// FIXME
+
+/* log(z) = log(|z|) + i arg(z) */
+
+double complex clog(double complex z)
+{
+ double r, phi;
+
+ r = cabs(z);
+ phi = carg(z);
+ return cpack(log(r), phi);
+}
--- /dev/null
+#include "libm.h"
+
+// FIXME
+
+float complex clogf(float complex z)
+{
+ float r, phi;
+
+ r = cabsf(z);
+ phi = cargf(z);
+ return cpackf(logf(r), phi);
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex clogl(long double complex z)
+{
+ return clog(z);
+}
+#else
+// FIXME
+long double complex clogl(long double complex z)
+{
+ long double r, phi;
+
+ r = cabsl(z);
+ phi = cargl(z);
+ return cpackl(logl(r), phi);
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double complex conj(double complex z)
+{
+ return cpack(creal(z), -cimag(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex conjf(float complex z)
+{
+ return cpackf(crealf(z), -cimagf(z));
+}
--- /dev/null
+#include "libm.h"
+
+long double complex conjl(long double complex z)
+{
+ return cpackl(creall(z), -cimagl(z));
+}
--- /dev/null
+#include "libm.h"
+
+/* pow(z, c) = exp(c log(z)), See C99 G.6.4.1 */
+
+double complex cpow(double complex z, double complex c)
+{
+ return cexp(c * clog(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex cpowf(float complex z, float complex c)
+{
+ return cexpf(c * clogf(z));
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex cpowl(long double complex z, long double complex c)
+{
+ return cpow(z, c);
+}
+#else
+long double complex cpowl(long double complex z, long double complex c)
+{
+ return cexpl(c * clogl(z));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double complex cproj(double complex z)
+{
+ if (isinf(creal(z)) || isinf(cimag(z)))
+ return cpack(INFINITY, copysign(0.0, creal(z)));
+ return z;
+}
--- /dev/null
+#include "libm.h"
+
+float complex cprojf(float complex z)
+{
+ if (isinf(crealf(z)) || isinf(cimagf(z)))
+ return cpackf(INFINITY, copysignf(0.0, crealf(z)));
+ return z;
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex cprojl(long double complex z)
+{
+ return cproj(z);
+}
+#else
+long double complex cprojl(long double complex z)
+{
+ if (isinf(creall(z)) || isinf(cimagl(z)))
+ return cpackl(INFINITY, copysignl(0.0, creall(z)));
+ return z;
+}
+#endif
--- /dev/null
+#include <complex.h>
+
+double creal(double complex z)
+{
+ return z;
+}
--- /dev/null
+#include <complex.h>
+
+float crealf(float complex z)
+{
+ return z;
+}
--- /dev/null
+#include <complex.h>
+
+long double creall(long double complex z)
+{
+ return z;
+}
--- /dev/null
+#include "libm.h"
+
+/* sin(z) = -i sinh(i z) */
+
+double complex csin(double complex z)
+{
+ z = csinh(cpack(-cimag(z), creal(z)));
+ return cpack(cimag(z), -creal(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex csinf(float complex z)
+{
+ z = csinhf(cpackf(-cimagf(z), crealf(z)));
+ return cpackf(cimagf(z), -crealf(z));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_csinh.c */
+/*-
+ * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Hyperbolic sine of a complex argument z = x + i y.
+ *
+ * sinh(z) = sinh(x+iy)
+ * = sinh(x) cos(y) + i cosh(x) sin(y).
+ *
+ * Exceptional values are noted in the comments within the source code.
+ * These values and the return value were taken from n1124.pdf.
+ */
+
+#include "libm.h"
+
+static const double huge = 0x1p1023;
+
+double complex csinh(double complex z)
+{
+ double x, y, h;
+ int32_t hx, hy, ix, iy, lx, ly;
+
+ x = creal(z);
+ y = cimag(z);
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hy, ly, y);
+
+ ix = 0x7fffffff & hx;
+ iy = 0x7fffffff & hy;
+
+ /* Handle the nearly-non-exceptional cases where x and y are finite. */
+ if (ix < 0x7ff00000 && iy < 0x7ff00000) {
+ if ((iy | ly) == 0)
+ return cpack(sinh(x), y);
+ if (ix < 0x40360000) /* small x: normal case */
+ return cpack(sinh(x) * cos(y), cosh(x) * sin(y));
+
+ /* |x| >= 22, so cosh(x) ~= exp(|x|) */
+ if (ix < 0x40862e42) {
+ /* x < 710: exp(|x|) won't overflow */
+ h = exp(fabs(x)) * 0.5;
+ return cpack(copysign(h, x) * cos(y), h * sin(y));
+ } else if (ix < 0x4096bbaa) {
+ /* x < 1455: scale to avoid overflow */
+ z = __ldexp_cexp(cpack(fabs(x), y), -1);
+ return cpack(creal(z) * copysign(1, x), cimag(z));
+ } else {
+ /* x >= 1455: the result always overflows */
+ h = huge * x;
+ return cpack(h * cos(y), h * h * sin(y));
+ }
+ }
+
+ /*
+ * sinh(+-0 +- I Inf) = sign(d(+-0, dNaN))0 + I dNaN.
+ * The sign of 0 in the result is unspecified. Choice = normally
+ * the same as dNaN. Raise the invalid floating-point exception.
+ *
+ * sinh(+-0 +- I NaN) = sign(d(+-0, NaN))0 + I d(NaN).
+ * The sign of 0 in the result is unspecified. Choice = normally
+ * the same as d(NaN).
+ */
+ if ((ix | lx) == 0 && iy >= 0x7ff00000)
+ return cpack(copysign(0, x * (y - y)), y - y);
+
+ /*
+ * sinh(+-Inf +- I 0) = +-Inf + I +-0.
+ *
+ * sinh(NaN +- I 0) = d(NaN) + I +-0.
+ */
+ if ((iy | ly) == 0 && ix >= 0x7ff00000) {
+ if (((hx & 0xfffff) | lx) == 0)
+ return cpack(x, y);
+ return cpack(x, copysign(0, y));
+ }
+
+ /*
+ * sinh(x +- I Inf) = dNaN + I dNaN.
+ * Raise the invalid floating-point exception for finite nonzero x.
+ *
+ * sinh(x + I NaN) = d(NaN) + I d(NaN).
+ * Optionally raises the invalid floating-point exception for finite
+ * nonzero x. Choice = don't raise (except for signaling NaNs).
+ */
+ if (ix < 0x7ff00000 && iy >= 0x7ff00000)
+ return cpack(y - y, x * (y - y));
+
+ /*
+ * sinh(+-Inf + I NaN) = +-Inf + I d(NaN).
+ * The sign of Inf in the result is unspecified. Choice = normally
+ * the same as d(NaN).
+ *
+ * sinh(+-Inf +- I Inf) = +Inf + I dNaN.
+ * The sign of Inf in the result is unspecified. Choice = always +.
+ * Raise the invalid floating-point exception.
+ *
+ * sinh(+-Inf + I y) = +-Inf cos(y) + I Inf sin(y)
+ */
+ if (ix >= 0x7ff00000 && ((hx & 0xfffff) | lx) == 0) {
+ if (iy >= 0x7ff00000)
+ return cpack(x * x, x * (y - y));
+ return cpack(x * cos(y), INFINITY * sin(y));
+ }
+
+ /*
+ * sinh(NaN + I NaN) = d(NaN) + I d(NaN).
+ *
+ * sinh(NaN +- I Inf) = d(NaN) + I d(NaN).
+ * Optionally raises the invalid floating-point exception.
+ * Choice = raise.
+ *
+ * sinh(NaN + I y) = d(NaN) + I d(NaN).
+ * Optionally raises the invalid floating-point exception for finite
+ * nonzero y. Choice = don't raise (except for signaling NaNs).
+ */
+ return cpack((x * x) * (y - y), (x + x) * (y - y));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_csinhf.c */
+/*-
+ * Copyright (c) 2005 Bruce D. Evans and Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Hyperbolic sine of a complex argument z. See s_csinh.c for details.
+ */
+
+#include "libm.h"
+
+static const float huge = 0x1p127;
+
+float complex csinhf(float complex z)
+{
+ float x, y, h;
+ int32_t hx, hy, ix, iy;
+
+ x = crealf(z);
+ y = cimagf(z);
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hy, y);
+
+ ix = 0x7fffffff & hx;
+ iy = 0x7fffffff & hy;
+
+ if (ix < 0x7f800000 && iy < 0x7f800000) {
+ if (iy == 0)
+ return cpackf(sinhf(x), y);
+ if (ix < 0x41100000) /* small x: normal case */
+ return cpackf(sinhf(x) * cosf(y), coshf(x) * sinf(y));
+
+ /* |x| >= 9, so cosh(x) ~= exp(|x|) */
+ if (ix < 0x42b17218) {
+ /* x < 88.7: expf(|x|) won't overflow */
+ h = expf(fabsf(x)) * 0.5f;
+ return cpackf(copysignf(h, x) * cosf(y), h * sinf(y));
+ } else if (ix < 0x4340b1e7) {
+ /* x < 192.7: scale to avoid overflow */
+ z = __ldexp_cexpf(cpackf(fabsf(x), y), -1);
+ return cpackf(crealf(z) * copysignf(1, x), cimagf(z));
+ } else {
+ /* x >= 192.7: the result always overflows */
+ h = huge * x;
+ return cpackf(h * cosf(y), h * h * sinf(y));
+ }
+ }
+
+ if (ix == 0 && iy >= 0x7f800000)
+ return cpackf(copysignf(0, x * (y - y)), y - y);
+
+ if (iy == 0 && ix >= 0x7f800000) {
+ if ((hx & 0x7fffff) == 0)
+ return cpackf(x, y);
+ return cpackf(x, copysignf(0, y));
+ }
+
+ if (ix < 0x7f800000 && iy >= 0x7f800000)
+ return cpackf(y - y, x * (y - y));
+
+ if (ix >= 0x7f800000 && (hx & 0x7fffff) == 0) {
+ if (iy >= 0x7f800000)
+ return cpackf(x * x, x * (y - y));
+ return cpackf(x * cosf(y), INFINITY * sinf(y));
+ }
+
+ return cpackf((x * x) * (y - y), (x + x) * (y - y));
+}
--- /dev/null
+#include "libm.h"
+
+//FIXME
+long double complex csinhl(long double complex z)
+{
+ return csinh(z);
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex csinl(long double complex z)
+{
+ return csin(z);
+}
+#else
+long double complex csinl(long double complex z)
+{
+ z = csinhl(cpackl(-cimagl(z), creall(z)));
+ return cpackl(cimagl(z), -creall(z));
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_csqrt.c */
+/*-
+ * Copyright (c) 2007 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+/*
+ * gcc doesn't implement complex multiplication or division correctly,
+ * so we need to handle infinities specially. We turn on this pragma to
+ * notify conforming c99 compilers that the fast-but-incorrect code that
+ * gcc generates is acceptable, since the special cases have already been
+ * handled.
+ */
+#pragma STDC CX_LIMITED_RANGE ON
+
+/* We risk spurious overflow for components >= DBL_MAX / (1 + sqrt(2)). */
+#define THRESH 0x1.a827999fcef32p+1022
+
+double complex csqrt(double complex z)
+{
+ double complex result;
+ double a, b;
+ double t;
+ int scale;
+
+ a = creal(z);
+ b = cimag(z);
+
+ /* Handle special cases. */
+ if (z == 0)
+ return cpack(0, b);
+ if (isinf(b))
+ return cpack(INFINITY, b);
+ if (isnan(a)) {
+ t = (b - b) / (b - b); /* raise invalid if b is not a NaN */
+ return cpack(a, t); /* return NaN + NaN i */
+ }
+ if (isinf(a)) {
+ /*
+ * csqrt(inf + NaN i) = inf + NaN i
+ * csqrt(inf + y i) = inf + 0 i
+ * csqrt(-inf + NaN i) = NaN +- inf i
+ * csqrt(-inf + y i) = 0 + inf i
+ */
+ if (signbit(a))
+ return cpack(fabs(b - b), copysign(a, b));
+ else
+ return cpack(a, copysign(b - b, b));
+ }
+ /*
+ * The remaining special case (b is NaN) is handled just fine by
+ * the normal code path below.
+ */
+
+ /* Scale to avoid overflow. */
+ if (fabs(a) >= THRESH || fabs(b) >= THRESH) {
+ a *= 0.25;
+ b *= 0.25;
+ scale = 1;
+ } else {
+ scale = 0;
+ }
+
+ /* Algorithm 312, CACM vol 10, Oct 1967. */
+ if (a >= 0) {
+ t = sqrt((a + hypot(a, b)) * 0.5);
+ result = cpack(t, b / (2 * t));
+ } else {
+ t = sqrt((-a + hypot(a, b)) * 0.5);
+ result = cpack(fabs(b) / (2 * t), copysign(t, b));
+ }
+
+ /* Rescale. */
+ if (scale)
+ result *= 2;
+ return result;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_csqrtf.c */
+/*-
+ * Copyright (c) 2007 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+/*
+ * gcc doesn't implement complex multiplication or division correctly,
+ * so we need to handle infinities specially. We turn on this pragma to
+ * notify conforming c99 compilers that the fast-but-incorrect code that
+ * gcc generates is acceptable, since the special cases have already been
+ * handled.
+ */
+#pragma STDC CX_LIMITED_RANGE ON
+
+float complex csqrtf(float complex z)
+{
+ float a = crealf(z), b = cimagf(z);
+ double t;
+
+ /* Handle special cases. */
+ if (z == 0)
+ return cpackf(0, b);
+ if (isinf(b))
+ return cpackf(INFINITY, b);
+ if (isnan(a)) {
+ t = (b - b) / (b - b); /* raise invalid if b is not a NaN */
+ return cpackf(a, t); /* return NaN + NaN i */
+ }
+ if (isinf(a)) {
+ /*
+ * csqrtf(inf + NaN i) = inf + NaN i
+ * csqrtf(inf + y i) = inf + 0 i
+ * csqrtf(-inf + NaN i) = NaN +- inf i
+ * csqrtf(-inf + y i) = 0 + inf i
+ */
+ if (signbit(a))
+ return cpackf(fabsf(b - b), copysignf(a, b));
+ else
+ return cpackf(a, copysignf(b - b, b));
+ }
+ /*
+ * The remaining special case (b is NaN) is handled just fine by
+ * the normal code path below.
+ */
+
+ /*
+ * We compute t in double precision to avoid overflow and to
+ * provide correct rounding in nearly all cases.
+ * This is Algorithm 312, CACM vol 10, Oct 1967.
+ */
+ if (a >= 0) {
+ t = sqrt((a + hypot(a, b)) * 0.5);
+ return cpackf(t, b / (2.0 * t));
+ } else {
+ t = sqrt((-a + hypot(a, b)) * 0.5);
+ return cpackf(fabsf(b) / (2.0 * t), copysignf(t, b));
+ }
+}
--- /dev/null
+#include "libm.h"
+
+//FIXME
+long double complex csqrtl(long double complex z)
+{
+ return csqrt(z);
+}
--- /dev/null
+#include "libm.h"
+
+/* tan(z) = -i tanh(i z) */
+
+double complex ctan(double complex z)
+{
+ z = ctanh(cpack(-cimag(z), creal(z)));
+ return cpack(cimag(z), -creal(z));
+}
--- /dev/null
+#include "libm.h"
+
+float complex ctanf(float complex z)
+{
+ z = ctanhf(cpackf(-cimagf(z), crealf(z)));
+ return cpackf(cimagf(z), -crealf(z));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ctanh.c */
+/*-
+ * Copyright (c) 2011 David Schultz
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Hyperbolic tangent of a complex argument z = x + i y.
+ *
+ * The algorithm is from:
+ *
+ * W. Kahan. Branch Cuts for Complex Elementary Functions or Much
+ * Ado About Nothing's Sign Bit. In The State of the Art in
+ * Numerical Analysis, pp. 165 ff. Iserles and Powell, eds., 1987.
+ *
+ * Method:
+ *
+ * Let t = tan(x)
+ * beta = 1/cos^2(y)
+ * s = sinh(x)
+ * rho = cosh(x)
+ *
+ * We have:
+ *
+ * tanh(z) = sinh(z) / cosh(z)
+ *
+ * sinh(x) cos(y) + i cosh(x) sin(y)
+ * = ---------------------------------
+ * cosh(x) cos(y) + i sinh(x) sin(y)
+ *
+ * cosh(x) sinh(x) / cos^2(y) + i tan(y)
+ * = -------------------------------------
+ * 1 + sinh^2(x) / cos^2(y)
+ *
+ * beta rho s + i t
+ * = ----------------
+ * 1 + beta s^2
+ *
+ * Modifications:
+ *
+ * I omitted the original algorithm's handling of overflow in tan(x) after
+ * verifying with nearpi.c that this can't happen in IEEE single or double
+ * precision. I also handle large x differently.
+ */
+
+#include "libm.h"
+
+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 cpack(x, (y == 0 ? y : x * y));
+ SET_HIGH_WORD(x, hx - 0x40000000); /* x = copysign(1, x) */
+ return cpack(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 cpack(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 cpack(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 cpack((beta * rho * s) / denom, t / denom);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ctanhf.c */
+/*-
+ * Copyright (c) 2011 David Schultz
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Hyperbolic tangent of a complex argument z. See s_ctanh.c for details.
+ */
+
+#include "libm.h"
+
+float complex ctanhf(float complex z)
+{
+ float x, y;
+ float t, beta, s, rho, denom;
+ uint32_t hx, ix;
+
+ x = crealf(z);
+ y = cimagf(z);
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+
+ if (ix >= 0x7f800000) {
+ if (ix & 0x7fffff)
+ return cpackf(x, (y == 0 ? y : x * y));
+ SET_FLOAT_WORD(x, hx - 0x40000000);
+ return cpackf(x, copysignf(0, isinf(y) ? y : sinf(y) * cosf(y)));
+ }
+
+ if (!isfinite(y))
+ return cpackf(y - y, y - y);
+
+ if (ix >= 0x41300000) { /* x >= 11 */
+ float exp_mx = expf(-fabsf(x));
+ return cpackf(copysignf(1, x), 4 * sinf(y) * cosf(y) * exp_mx * exp_mx);
+ }
+
+ t = tanf(y);
+ beta = 1.0 + t * t;
+ s = sinhf(x);
+ rho = sqrtf(1 + s * s);
+ denom = 1 + beta * s * s;
+ return cpackf((beta * rho * s) / denom, t / denom);
+}
--- /dev/null
+#include "libm.h"
+
+//FIXME
+long double complex ctanhl(long double complex z)
+{
+ return ctanh(z);
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double complex ctanl(long double complex z)
+{
+ return ctan(z);
+}
+#else
+long double complex ctanl(long double complex z)
+{
+ z = ctanhl(cpackl(-cimagl(z), creall(z)));
+ return cpackl(cimagl(z), -creall(z));
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/math_private.h */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#ifndef _LIBM_H
+#define _LIBM_H
+
+#include <stdint.h>
+#include <float.h>
+#include <math.h>
+#include <complex.h>
+
+#include "longdbl.h"
+
+union fshape {
+ float value;
+ uint32_t bits;
+};
+
+union dshape {
+ double value;
+ uint64_t bits;
+};
+
+/* Get two 32 bit ints from a double. */
+#define EXTRACT_WORDS(hi,lo,d) \
+do { \
+ union dshape __u; \
+ __u.value = (d); \
+ (hi) = __u.bits >> 32; \
+ (lo) = (uint32_t)__u.bits; \
+} while (0)
+
+/* Get a 64 bit int from a double. */
+#define EXTRACT_WORD64(i,d) \
+do { \
+ union dshape __u; \
+ __u.value = (d); \
+ (i) = __u.bits; \
+} while (0)
+
+/* Get the more significant 32 bit int from a double. */
+#define GET_HIGH_WORD(i,d) \
+do { \
+ union dshape __u; \
+ __u.value = (d); \
+ (i) = __u.bits >> 32; \
+} while (0)
+
+/* Get the less significant 32 bit int from a double. */
+#define GET_LOW_WORD(i,d) \
+do { \
+ union dshape __u; \
+ __u.value = (d); \
+ (i) = (uint32_t)__u.bits; \
+} while (0)
+
+/* Set a double from two 32 bit ints. */
+#define INSERT_WORDS(d,hi,lo) \
+do { \
+ union dshape __u; \
+ __u.bits = ((uint64_t)(hi) << 32) | (uint32_t)(lo); \
+ (d) = __u.value; \
+} while (0)
+
+/* Set a double from a 64 bit int. */
+#define INSERT_WORD64(d,i) \
+do { \
+ union dshape __u; \
+ __u.bits = (i); \
+ (d) = __u.value; \
+} while (0)
+
+/* Set the more significant 32 bits of a double from an int. */
+#define SET_HIGH_WORD(d,hi) \
+do { \
+ union dshape __u; \
+ __u.value = (d); \
+ __u.bits &= 0xffffffff; \
+ __u.bits |= (uint64_t)(hi) << 32; \
+ (d) = __u.value; \
+} while (0)
+
+/* Set the less significant 32 bits of a double from an int. */
+#define SET_LOW_WORD(d,lo) \
+do { \
+ union dshape __u; \
+ __u.value = (d); \
+ __u.bits &= 0xffffffff00000000ull; \
+ __u.bits |= (uint32_t)(lo); \
+ (d) = __u.value; \
+} while (0)
+
+/* Get a 32 bit int from a float. */
+#define GET_FLOAT_WORD(i,d) \
+do { \
+ union fshape __u; \
+ __u.value = (d); \
+ (i) = __u.bits; \
+} while (0)
+
+/* Set a float from a 32 bit int. */
+#define SET_FLOAT_WORD(d,i) \
+do { \
+ union fshape __u; \
+ __u.bits = (i); \
+ (d) = __u.value; \
+} while (0)
+
+/* fdlibm kernel functions */
+
+int __rem_pio2_large(double*,double*,int,int,int);
+
+int __rem_pio2(double,double*);
+double __sin(double,double,int);
+double __cos(double,double);
+double __tan(double,double,int);
+double __expo2(double);
+double complex __ldexp_cexp(double complex,int);
+
+int __rem_pio2f(float,double*);
+float __sindf(double);
+float __cosdf(double);
+float __tandf(double,int);
+float __expo2f(float);
+float complex __ldexp_cexpf(float complex,int);
+
+long double __sinl(long double, long double, int);
+long double __cosl(long double, long double);
+long double __tanl(long double, long double, int);
+
+/* polynomial evaluation */
+long double __polevll(long double, long double *, int);
+long double __p1evll(long double, long double *, int);
+
+// FIXME: not needed when -fexcess-precision=standard is supported (>=gcc4.5)
+/*
+ * Attempt to get strict C99 semantics for assignment with non-C99 compilers.
+ */
+#if 1
+#define STRICT_ASSIGN(type, lval, rval) do { \
+ volatile type __v = (rval); \
+ (lval) = __v; \
+} while (0)
+#else
+#define STRICT_ASSIGN(type, lval, rval) ((lval) = (type)(rval))
+#endif
+
+
+/* complex */
+
+union dcomplex {
+ double complex z;
+ double a[2];
+};
+union fcomplex {
+ float complex z;
+ float a[2];
+};
+union lcomplex {
+ long double complex z;
+ long double a[2];
+};
+
+// FIXME: move to complex.h ?
+#define creal(z) ((double)(z))
+#define crealf(z) ((float)(z))
+#define creall(z) ((long double)(z))
+#define cimag(z) ((union dcomplex){(z)}.a[1])
+#define cimagf(z) ((union fcomplex){(z)}.a[1])
+#define cimagl(z) ((union lcomplex){(z)}.a[1])
+
+/* x + y*I is not supported properly by gcc */
+#define cpack(x,y) ((union dcomplex){.a={(x),(y)}}.z)
+#define cpackf(x,y) ((union fcomplex){.a={(x),(y)}}.z)
+#define cpackl(x,y) ((union lcomplex){.a={(x),(y)}}.z)
+
+#endif
--- /dev/null
+#ifndef _LDHACK_H
+#define _LDHACK_H
+
+#include <float.h>
+#include <stdint.h>
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+union ldshape {
+ long double value;
+ struct {
+ uint64_t m;
+ uint16_t exp:15;
+ uint16_t sign:1;
+ uint16_t pad;
+ } bits;
+};
+#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
+union ldshape {
+ long double value;
+ struct {
+ uint64_t mlo;
+ uint64_t mhi:48;
+ uint16_t exp:15;
+ uint16_t sign:1;
+ } bits;
+};
+#else
+#error Unsupported long double representation
+#endif
+
+
+// FIXME: hacks to make freebsd+openbsd long double code happy
+
+// union and macros for freebsd
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+
+union IEEEl2bits {
+ long double e;
+ struct {
+ uint32_t manl:32;
+ uint32_t manh:32;
+ uint32_t exp:15;
+ uint32_t sign:1;
+ uint32_t pad:16;
+ } bits;
+ struct {
+ uint64_t man:64;
+ uint32_t expsign:16;
+ uint32_t pad:16;
+ } xbits;
+};
+
+#define LDBL_MANL_SIZE 32
+#define LDBL_MANH_SIZE 32
+#define LDBL_NBIT (1ull << LDBL_MANH_SIZE-1)
+#undef LDBL_IMPLICIT_NBIT
+#define mask_nbit_l(u) ((u).bits.manh &= ~LDBL_NBIT)
+
+#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
+/*
+// ld128 float.h
+//#define LDBL_MAX 1.189731495357231765085759326628007016E+4932L
+#define LDBL_MAX 0x1.ffffffffffffffffffffffffffffp+16383
+#define LDBL_MAX_EXP 16384
+#define LDBL_HAS_INFINITY 1
+//#define LDBL_MIN 3.362103143112093506262677817321752603E-4932L
+#define LDBL_MIN 0x1p-16382
+#define LDBL_HAS_QUIET_NAN 1
+#define LDBL_HAS_DENORM 1
+//#define LDBL_EPSILON 1.925929944387235853055977942584927319E-34L
+#define LDBL_EPSILON 0x1p-112
+#define LDBL_MANT_DIG 113
+#define LDBL_MIN_EXP (-16381)
+#define LDBL_MAX_10_EXP 4932
+#define LDBL_DENORM_MIN 0x0.0000000000000000000000000001p-16381
+#define LDBL_MIN_10_EXP (-4931)
+#define LDBL_DIG 33
+*/
+
+union IEEEl2bits {
+ long double e;
+ struct {
+ uint64_t manl:64;
+ uint64_t manh:48;
+ uint32_t exp:15;
+ uint32_t sign:1;
+ } bits;
+ struct {
+ uint64_t unused0:64;
+ uint64_t unused1:48;
+ uint32_t expsign:16;
+ } xbits;
+};
+
+#define LDBL_MANL_SIZE 64
+#define LDBL_MANH_SIZE 48
+#define LDBL_NBIT (1ull << LDBL_MANH_SIZE)
+#define LDBL_IMPLICIT_NBIT 1
+#define mask_nbit_l(u)
+
+#endif
+
+
+// macros for openbsd
+
+#define GET_LDOUBLE_WORDS(se,mh,ml, f) do{ \
+ union IEEEl2bits u; \
+ u.e = (f); \
+ (se) = u.xbits.expsign; \
+ (mh) = u.bits.manh; \
+ (ml) = u.bits.manl; \
+}while(0)
+
+#define SET_LDOUBLE_WORDS(f, se,mh,ml) do{ \
+ union IEEEl2bits u; \
+ u.xbits.expsign = (se); \
+ u.bits.manh = (mh); \
+ u.bits.manl = (ml); \
+ (f) = u.e; \
+}while(0)
+
+#define GET_LDOUBLE_EXP(se, f) do{ \
+ union IEEEl2bits u; \
+ u.e = (f); \
+ (se) = u.xbits.expsign; \
+}while(0)
+
+#define SET_LDOUBLE_EXP(f, se) do{ \
+ union IEEEl2bits u; \
+ u.e = (f); \
+ u.xbits.expsign = (se); \
+ (f) = u.e; \
+}while(0)
+
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_cos.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * __cos( x, y )
+ * kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ *
+ * Algorithm
+ * 1. Since cos(-x) = cos(x), we need only to consider positive x.
+ * 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0.
+ * 3. cos(x) is approximated by a polynomial of degree 14 on
+ * [0,pi/4]
+ * 4 14
+ * cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x
+ * where the remez error is
+ *
+ * | 2 4 6 8 10 12 14 | -58
+ * |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2
+ * | |
+ *
+ * 4 6 8 10 12 14
+ * 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then
+ * cos(x) ~ 1 - x*x/2 + r
+ * since cos(x+y) ~ cos(x) - sin(x)*y
+ * ~ cos(x) - x*y,
+ * a correction term is necessary in cos(x) and hence
+ * cos(x+y) = 1 - (x*x/2 - (r - x*y))
+ * For better accuracy, rearrange to
+ * cos(x+y) ~ w + (tmp + (r-x*y))
+ * where w = 1 - x*x/2 and tmp is a tiny correction term
+ * (1 - x*x/2 == w + tmp exactly in infinite precision).
+ * The exactness of w + tmp in infinite precision depends on w
+ * and tmp having the same precision as x. If they have extra
+ * precision due to compiler bugs, then the extra precision is
+ * only good provided it is retained in all terms of the final
+ * expression for cos(). Retention happens in all cases tested
+ * under FreeBSD, so don't pessimize things by forcibly clipping
+ * any extra precision in w.
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */
+C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */
+C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */
+C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */
+C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */
+C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */
+
+double __cos(double x, double y)
+{
+ double hz,z,r,w;
+
+ z = x*x;
+ w = z*z;
+ r = z*(C1+z*(C2+z*C3)) + w*w*(C4+z*(C5+z*C6));
+ hz = 0.5*z;
+ w = one-hz;
+ return w + (((one-w)-hz) + (z*r-x*y));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_cosf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Debugged and optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+/* |cos(x) - c(x)| < 2**-34.1 (~[-5.37e-11, 5.295e-11]). */
+static const double
+one = 1.0,
+C0 = -0x1ffffffd0c5e81.0p-54, /* -0.499999997251031003120 */
+C1 = 0x155553e1053a42.0p-57, /* 0.0416666233237390631894 */
+C2 = -0x16c087e80f1e27.0p-62, /* -0.00138867637746099294692 */
+C3 = 0x199342e0ee5069.0p-68; /* 0.0000243904487962774090654 */
+
+float __cosdf(double x)
+{
+ double r, w, z;
+
+ /* Try to optimize for parallel evaluation as in __tandf.c. */
+ z = x*x;
+ w = z*z;
+ r = C2+z*C3;
+ return ((one+z*C0) + w*C1) + (w*z)*r;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/ld80/k_cosl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/*
+ * ld80 version of __cos.c. See __cos.c for most comments.
+ */
+/*
+ * Domain [-0.7854, 0.7854], range ~[-2.43e-23, 2.425e-23]:
+ * |cos(x) - c(x)| < 2**-75.1
+ *
+ * The coefficients of c(x) were generated by a pari-gp script using
+ * a Remez algorithm that searches for the best higher coefficients
+ * after rounding leading coefficients to a specified precision.
+ *
+ * Simpler methods like Chebyshev or basic Remez barely suffice for
+ * cos() in 64-bit precision, because we want the coefficient of x^2
+ * to be precisely -0.5 so that multiplying by it is exact, and plain
+ * rounding of the coefficients of a good polynomial approximation only
+ * gives this up to about 64-bit precision. Plain rounding also gives
+ * a mediocre approximation for the coefficient of x^4, but a rounding
+ * error of 0.5 ulps for this coefficient would only contribute ~0.01
+ * ulps to the final error, so this is unimportant. Rounding errors in
+ * higher coefficients are even less important.
+ *
+ * In fact, coefficients above the x^4 one only need to have 53-bit
+ * precision, and this is more efficient. We get this optimization
+ * almost for free from the complications needed to search for the best
+ * higher coefficients.
+ */
+static const double one = 1.0;
+
+// FIXME
+/* Long double constants are slow on these arches, and broken on i386. */
+static const volatile double
+C1hi = 0.041666666666666664, /* 0x15555555555555.0p-57 */
+C1lo = 2.2598839032744733e-18; /* 0x14d80000000000.0p-111 */
+#define C1 ((long double)C1hi + C1lo)
+
+#if 0
+static const long double
+C1 = 0.0416666666666666666136L; /* 0xaaaaaaaaaaaaaa9b.0p-68 */
+#endif
+
+static const double
+C2 = -0.0013888888888888874, /* -0x16c16c16c16c10.0p-62 */
+C3 = 0.000024801587301571716, /* 0x1a01a01a018e22.0p-68 */
+C4 = -0.00000027557319215507120, /* -0x127e4fb7602f22.0p-74 */
+C5 = 0.0000000020876754400407278, /* 0x11eed8caaeccf1.0p-81 */
+C6 = -1.1470297442401303e-11, /* -0x19393412bd1529.0p-89 */
+C7 = 4.7383039476436467e-14; /* 0x1aac9d9af5c43e.0p-97 */
+
+long double __cosl(long double x, long double y)
+{
+ long double hz,z,r,w;
+
+ z = x*x;
+ r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*(C6+z*C7))))));
+ hz = 0.5*z;
+ w = one-hz;
+ return w + (((one-w)-hz) + (z*r-x*y));
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_exp.c */
+/*-
+ * Copyright (c) 2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+/*
+ * We use exp(x) = exp(x - kln2) * 2**k,
+ * k is carefully chosen to minimize |exp(kln2) - 2**k|
+ */
+static const uint32_t k = 1799;
+static const double kln2 = 1246.97177782734161156;
+
+/* exp(x)/2 when x is huge */
+double __expo2(double x)
+{
+ double scale;
+ int n;
+
+ /*
+ * efficient scalbn(y, k-1):
+ * 2**(k-1) cannot be represented
+ * so we use that k-1 is even and scale in two steps
+ */
+ n = (k - 1)/2;
+ INSERT_WORDS(scale, (0x3ff + n) << 20, 0);
+ return exp(x - kln2) * scale * scale;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_expf.c */
+/*-
+ * Copyright (c) 2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+/*
+ * We use exp(x) = exp(x - kln2) * 2**k,
+ * k is carefully chosen to minimize |exp(kln2) - 2**k|
+ */
+static const uint32_t k = 235;
+static const float kln2 = 162.88958740f;
+
+/* expf(x)/2 when x is huge */
+float __expo2f(float x)
+{
+ float scale;
+ int n;
+
+ /*
+ * efficient scalbnf(y, k-1):
+ * 2**(k-1) cannot be represented
+ * so we use that k-1 is even and scale in two steps
+ */
+ n = (k - 1)/2;
+ SET_FLOAT_WORD(scale, (0x7f + n) << 23);
+ return expf(x - kln2) * scale * scale;
+}
-#include <stdint.h>
-#include <math.h>
+#include "libm.h"
-int __fpclassify(double __x)
+int __fpclassify(double x)
{
- union {
- double __d;
- __uint64_t __i;
- } __y = { __x };
- int __ee = __y.__i>>52 & 0x7ff;
- if (!__ee) return __y.__i<<1 ? FP_SUBNORMAL : FP_ZERO;
- if (__ee==0x7ff) return __y.__i<<12 ? FP_NAN : FP_INFINITE;
+ union dshape u = { x };
+ int e = u.bits>>52 & 0x7ff;
+ if (!e) return u.bits<<1 ? FP_SUBNORMAL : FP_ZERO;
+ if (e==0x7ff) return u.bits<<12 ? FP_NAN : FP_INFINITE;
return FP_NORMAL;
}
-#include <stdint.h>
-#include <math.h>
+#include "libm.h"
-int __fpclassifyf(float __x)
+int __fpclassifyf(float x)
{
- union {
- float __f;
- __uint32_t __i;
- } __y = { __x };
- int __ee = __y.__i>>23 & 0xff;
- if (!__ee) return __y.__i<<1 ? FP_SUBNORMAL : FP_ZERO;
- if (__ee==0xff) return __y.__i<<9 ? FP_NAN : FP_INFINITE;
+ union fshape u = { x };
+ int e = u.bits>>23 & 0xff;
+ if (!e) return u.bits<<1 ? FP_SUBNORMAL : FP_ZERO;
+ if (e==0xff) return u.bits<<9 ? FP_NAN : FP_INFINITE;
return FP_NORMAL;
}
-#include <stdint.h>
-#include <math.h>
+#include "libm.h"
-/* FIXME: move this to arch-specific file */
-int __fpclassifyl(long double __x)
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+int __fpclassifyl(long double x)
+{
+ union ldshape u = { x };
+ int e = u.bits.exp;
+ if (!e)
+ return u.bits.m ? FP_SUBNORMAL : FP_ZERO;
+ if (e == 0x7fff)
+ return u.bits.m & (uint64_t)-1>>1 ? FP_NAN : FP_INFINITE;
+ return u.bits.m & (uint64_t)1<<63 ? FP_NORMAL : FP_NAN;
+}
+#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
+int __fpclassifyl(long double x)
{
- union {
- long double __ld;
- __uint16_t __hw[5];
- int64_t __m;
- } __y = { __x };
- int __ee = __y.__hw[4]&0x7fff;
- if (!__ee) return __y.__m ? FP_SUBNORMAL : FP_ZERO;
- if (__ee==0x7fff) return __y.__m ? FP_NAN : FP_INFINITE;
- return __y.__m < 0 ? FP_NORMAL : FP_NAN;
+ union ldshape u = { x };
+ int e = u.bits.exp;
+ if (!e)
+ return u.bits.mlo | u.bits.mhi ? FP_SUBNORMAL : FP_ZERO;
+ if (e == 0x7fff)
+ return u.bits.mlo | u.bits.mhi ? FP_NAN : FP_INFINITE;
+ return FP_NORMAL;
}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/ld80/invtrig.c */
+/*-
+ * Copyright (c) 2008 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "__invtrigl.h"
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/*
+ * asinl() and acosl()
+ */
+const long double
+pS0 = 1.66666666666666666631e-01L,
+pS1 = -4.16313987993683104320e-01L,
+pS2 = 3.69068046323246813704e-01L,
+pS3 = -1.36213932016738603108e-01L,
+pS4 = 1.78324189708471965733e-02L,
+pS5 = -2.19216428382605211588e-04L,
+pS6 = -7.10526623669075243183e-06L,
+qS1 = -2.94788392796209867269e+00L,
+qS2 = 3.27309890266528636716e+00L,
+qS3 = -1.68285799854822427013e+00L,
+qS4 = 3.90699412641738801874e-01L,
+qS5 = -3.14365703596053263322e-02L;
+
+/*
+ * atanl()
+ */
+const long double atanhi[] = {
+ 4.63647609000806116202e-01L,
+ 7.85398163397448309628e-01L,
+ 9.82793723247329067960e-01L,
+ 1.57079632679489661926e+00L,
+};
+
+const long double atanlo[] = {
+ 1.18469937025062860669e-20L,
+ -1.25413940316708300586e-20L,
+ 2.55232234165405176172e-20L,
+ -2.50827880633416601173e-20L,
+};
+
+const long double aT[] = {
+ 3.33333333333333333017e-01L,
+ -1.99999999999999632011e-01L,
+ 1.42857142857046531280e-01L,
+ -1.11111111100562372733e-01L,
+ 9.09090902935647302252e-02L,
+ -7.69230552476207730353e-02L,
+ 6.66661718042406260546e-02L,
+ -5.88158892835030888692e-02L,
+ 5.25499891539726639379e-02L,
+ -4.70119845393155721494e-02L,
+ 4.03539201366454414072e-02L,
+ -2.91303858419364158725e-02L,
+ 1.24822046299269234080e-02L,
+};
+
+const long double pi_lo = -5.01655761266833202345e-20L;
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/ld80/invtrig.h */
+/*-
+ * Copyright (c) 2008 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+
+#define BIAS (LDBL_MAX_EXP - 1)
+#define MANH_SIZE LDBL_MANH_SIZE
+
+/* Approximation thresholds. */
+#define ASIN_LINEAR (BIAS - 32) /* 2**-32 */
+#define ACOS_CONST (BIAS - 65) /* 2**-65 */
+#define ATAN_CONST (BIAS + 65) /* 2**65 */
+#define ATAN_LINEAR (BIAS - 32) /* 2**-32 */
+
+/* 0.95 */
+#define THRESH ((0xe666666666666666ULL>>(64-(MANH_SIZE-1)))|LDBL_NBIT)
+
+/* Constants shared by the long double inverse trig functions. */
+#define pS0 __pS0
+#define pS1 __pS1
+#define pS2 __pS2
+#define pS3 __pS3
+#define pS4 __pS4
+#define pS5 __pS5
+#define pS6 __pS6
+#define qS1 __qS1
+#define qS2 __qS2
+#define qS3 __qS3
+#define qS4 __qS4
+#define qS5 __qS5
+#define atanhi __atanhi
+#define atanlo __atanlo
+#define aT __aT
+#define pi_lo __pi_lo
+
+#define pio2_hi atanhi[3]
+#define pio2_lo atanlo[3]
+#define pio4_hi atanhi[1]
+
+#ifdef STRUCT_DECLS
+typedef struct longdouble {
+ uint64_t mant;
+ uint16_t expsign;
+} LONGDOUBLE;
+#else
+typedef long double LONGDOUBLE;
+#endif
+
+extern const LONGDOUBLE pS0, pS1, pS2, pS3, pS4, pS5, pS6;
+extern const LONGDOUBLE qS1, qS2, qS3, qS4, qS5;
+extern const LONGDOUBLE atanhi[], atanlo[], aT[];
+extern const LONGDOUBLE pi_lo;
+
+#ifndef STRUCT_DECLS
+static inline long double
+P(long double x)
+{
+ return (x * (pS0 + x * (pS1 + x * (pS2 + x * (pS3 + x * \
+ (pS4 + x * (pS5 + x * pS6)))))));
+}
+
+static inline long double
+Q(long double x)
+{
+ return (1.0 + x * (qS1 + x * (qS2 + x * (qS3 + x * (qS4 + x * qS5)))));
+}
+
+static inline long double
+T_even(long double x)
+{
+ return (aT[0] + x * (aT[2] + x * (aT[4] + x * (aT[6] + x * \
+ (aT[8] + x * (aT[10] + x * aT[12]))))));
+}
+
+static inline long double
+T_odd(long double x)
+{
+ return (aT[1] + x * (aT[3] + x * (aT[5] + x * (aT[7] + x * \
+ (aT[9] + x * aT[11])))));
+}
+#endif
+
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_log.h */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * __log1p(f):
+ * Return log(1+f) - f for 1+f in ~[sqrt(2)/2, sqrt(2)].
+ *
+ * The following describes the overall strategy for computing
+ * logarithms in base e. The argument reduction and adding the final
+ * term of the polynomial are done by the caller for increased accuracy
+ * when different bases are used.
+ *
+ * Method :
+ * 1. Argument Reduction: find k and f such that
+ * x = 2^k * (1+f),
+ * where sqrt(2)/2 < 1+f < sqrt(2) .
+ *
+ * 2. Approximation of log(1+f).
+ * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
+ * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
+ * = 2s + s*R
+ * We use a special Reme algorithm on [0,0.1716] to generate
+ * a polynomial of degree 14 to approximate R The maximum error
+ * of this polynomial approximation is bounded by 2**-58.45. In
+ * other words,
+ * 2 4 6 8 10 12 14
+ * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s
+ * (the values of Lg1 to Lg7 are listed in the program)
+ * and
+ * | 2 14 | -58.45
+ * | Lg1*s +...+Lg7*s - R(z) | <= 2
+ * | |
+ * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
+ * In order to guarantee error in log below 1ulp, we compute log
+ * by
+ * log(1+f) = f - s*(f - R) (if f is not too large)
+ * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy)
+ *
+ * 3. Finally, log(x) = k*ln2 + log(1+f).
+ * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
+ * Here ln2 is split into two floating point number:
+ * ln2_hi + ln2_lo,
+ * where n*ln2_hi is always exact for |n| < 2000.
+ *
+ * Special cases:
+ * log(x) is NaN with signal if x < 0 (including -INF) ;
+ * log(+INF) is +INF; log(0) is -INF with signal;
+ * log(NaN) is that NaN with no signal.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+static const double
+Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
+Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
+Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
+Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
+Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
+Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
+Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
+
+/*
+ * We always inline __log1p(), since doing so produces a
+ * substantial performance improvement (~40% on amd64).
+ */
+static inline double __log1p(double f)
+{
+ double hfsq,s,z,R,w,t1,t2;
+
+ s = f/(2.0+f);
+ z = s*s;
+ w = z*z;
+ t1= w*(Lg2+w*(Lg4+w*Lg6));
+ t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7)));
+ R = t2+t1;
+ hfsq = 0.5*f*f;
+ return s*(hfsq+R);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_logf.h */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * See comments in __log1p.h.
+ */
+
+/* |(log(1+s)-log(1-s))/s - Lg(s)| < 2**-34.24 (~[-4.95e-11, 4.97e-11]). */
+static const float
+Lg1 = 0xaaaaaa.0p-24, /* 0.66666662693 */
+Lg2 = 0xccce13.0p-25, /* 0.40000972152 */
+Lg3 = 0x91e9ee.0p-25, /* 0.28498786688 */
+Lg4 = 0xf89e26.0p-26; /* 0.24279078841 */
+
+static inline float __log1pf(float f)
+{
+ float hfsq,s,z,R,w,t1,t2;
+
+ s = f/((float)2.0+f);
+ z = s*s;
+ w = z*z;
+ t1 = w*(Lg2+w*Lg4);
+ t2 = z*(Lg1+w*Lg3);
+ R = t2+t1;
+ hfsq = (float)0.5*f*f;
+ return s*(hfsq+R);
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/polevll.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Evaluate polynomial
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * long double x, y, coef[N+1], polevl[];
+ *
+ * y = polevll( x, coef, N );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Evaluates polynomial of degree N:
+ *
+ * 2 N
+ * y = C + C x + C x +...+ C x
+ * 0 1 2 N
+ *
+ * Coefficients are stored in reverse order:
+ *
+ * coef[0] = C , ..., coef[N] = C .
+ * N 0
+ *
+ * The function p1evll() assumes that coef[N] = 1.0 and is
+ * omitted from the array. Its calling arguments are
+ * otherwise the same as polevll().
+ *
+ *
+ * SPEED:
+ *
+ * In the interest of speed, there are no checks for out
+ * of bounds arithmetic. This routine is used by most of
+ * the functions in the library. Depending on available
+ * equipment features, the user may wish to rewrite the
+ * program in microcode or assembly language.
+ *
+ */
+
+#include "libm.h"
+
+/*
+ * Polynomial evaluator:
+ * P[0] x^n + P[1] x^(n-1) + ... + P[n]
+ */
+long double __polevll(long double x, long double *P, int n)
+{
+ long double y;
+
+ y = *P++;
+ do {
+ y = y * x + *P++;
+ } while (--n);
+
+ return y;
+}
+
+/*
+ * Polynomial evaluator:
+ * x^n + P[0] x^(n-1) + P[1] x^(n-2) + ... + P[n]
+ */
+long double __p1evll(long double x, long double *P, int n)
+{
+ long double y;
+
+ n -= 1;
+ y = x + *P++;
+ do {
+ y = y * x + *P++;
+ } while (--n);
+
+ return y;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_rem_pio2.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ * Optimized by Bruce D. Evans.
+ */
+/* __rem_pio2(x,y)
+ *
+ * return the remainder of x rem pi/2 in y[0]+y[1]
+ * use __rem_pio2_large() for large x
+ */
+
+#include "libm.h"
+
+/*
+ * invpio2: 53 bits of 2/pi
+ * pio2_1: first 33 bit of pi/2
+ * pio2_1t: pi/2 - pio2_1
+ * pio2_2: second 33 bit of pi/2
+ * pio2_2t: pi/2 - (pio2_1+pio2_2)
+ * pio2_3: third 33 bit of pi/2
+ * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
+ */
+static const double
+zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
+invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+pio2_1 = 1.57079632673412561417e+00, /* 0x3FF921FB, 0x54400000 */
+pio2_1t = 6.07710050650619224932e-11, /* 0x3DD0B461, 0x1A626331 */
+pio2_2 = 6.07710050630396597660e-11, /* 0x3DD0B461, 0x1A600000 */
+pio2_2t = 2.02226624879595063154e-21, /* 0x3BA3198A, 0x2E037073 */
+pio2_3 = 2.02226624871116645580e-21, /* 0x3BA3198A, 0x2E000000 */
+pio2_3t = 8.47842766036889956997e-32; /* 0x397B839A, 0x252049C1 */
+
+/* caller must handle the case when reduction is not needed: |x| ~<= pi/4 */
+int __rem_pio2(double x, double *y)
+{
+ double z,w,t,r,fn;
+ double tx[3],ty[2];
+ int32_t e0,i,j,nx,n,ix,hx;
+ uint32_t low;
+
+ GET_HIGH_WORD(hx,x);
+ ix = hx & 0x7fffffff;
+ if (ix <= 0x400f6a7a) { /* |x| ~<= 5pi/4 */
+ if ((ix & 0xfffff) == 0x921fb) /* |x| ~= pi/2 or 2pi/2 */
+ goto medium; /* cancellation -- use medium case */
+ if (ix <= 0x4002d97c) { /* |x| ~<= 3pi/4 */
+ if (hx > 0) {
+ z = x - pio2_1; /* one round good to 85 bits */
+ y[0] = z - pio2_1t;
+ y[1] = (z-y[0]) - pio2_1t;
+ return 1;
+ } else {
+ z = x + pio2_1;
+ y[0] = z + pio2_1t;
+ y[1] = (z-y[0]) + pio2_1t;
+ return -1;
+ }
+ } else {
+ if (hx > 0) {
+ z = x - 2*pio2_1;
+ y[0] = z - 2*pio2_1t;
+ y[1] = (z-y[0]) - 2*pio2_1t;
+ return 2;
+ } else {
+ z = x + 2*pio2_1;
+ y[0] = z + 2*pio2_1t;
+ y[1] = (z-y[0]) + 2*pio2_1t;
+ return -2;
+ }
+ }
+ }
+ if (ix <= 0x401c463b) { /* |x| ~<= 9pi/4 */
+ if (ix <= 0x4015fdbc) { /* |x| ~<= 7pi/4 */
+ if (ix == 0x4012d97c) /* |x| ~= 3pi/2 */
+ goto medium;
+ if (hx > 0) {
+ z = x - 3*pio2_1;
+ y[0] = z - 3*pio2_1t;
+ y[1] = (z-y[0]) - 3*pio2_1t;
+ return 3;
+ } else {
+ z = x + 3*pio2_1;
+ y[0] = z + 3*pio2_1t;
+ y[1] = (z-y[0]) + 3*pio2_1t;
+ return -3;
+ }
+ } else {
+ if (ix == 0x401921fb) /* |x| ~= 4pi/2 */
+ goto medium;
+ if (hx > 0) {
+ z = x - 4*pio2_1;
+ y[0] = z - 4*pio2_1t;
+ y[1] = (z-y[0]) - 4*pio2_1t;
+ return 4;
+ } else {
+ z = x + 4*pio2_1;
+ y[0] = z + 4*pio2_1t;
+ y[1] = (z-y[0]) + 4*pio2_1t;
+ return -4;
+ }
+ }
+ }
+ if (ix < 0x413921fb) { /* |x| ~< 2^20*(pi/2), medium size */
+ uint32_t high;
+medium:
+ /* Use a specialized rint() to get fn. Assume round-to-nearest. */
+ STRICT_ASSIGN(double, fn, x*invpio2 + 0x1.8p52);
+ fn = fn - 0x1.8p52;
+// FIXME
+#ifdef HAVE_EFFICIENT_IRINT
+ n = irint(fn);
+#else
+ n = (int32_t)fn;
+#endif
+ r = x - fn*pio2_1;
+ w = fn*pio2_1t; /* 1st round, good to 85 bits */
+ j = ix>>20;
+ y[0] = r - w;
+ GET_HIGH_WORD(high,y[0]);
+ i = j - ((high>>20)&0x7ff);
+ if (i > 16) { /* 2nd round, good to 118 bits */
+ t = r;
+ w = fn*pio2_2;
+ r = t - w;
+ w = fn*pio2_2t - ((t-r)-w);
+ y[0] = r - w;
+ GET_HIGH_WORD(high,y[0]);
+ i = j - ((high>>20)&0x7ff);
+ if (i > 49) { /* 3rd round, good to 151 bits, covers all cases */
+ t = r;
+ w = fn*pio2_3;
+ r = t - w;
+ w = fn*pio2_3t - ((t-r)-w);
+ y[0] = r - w;
+ }
+ }
+ y[1] = (r-y[0]) - w;
+ return n;
+ }
+ /*
+ * all other (large) arguments
+ */
+ if (ix >= 0x7ff00000) { /* x is inf or NaN */
+ y[0] = y[1] = x - x;
+ return 0;
+ }
+ /* set z = scalbn(|x|,ilogb(x)-23) */
+ GET_LOW_WORD(low,x);
+ e0 = (ix>>20) - 1046; /* e0 = ilogb(z)-23; */
+ INSERT_WORDS(z, ix - ((int32_t)(e0<<20)), low);
+ for (i=0; i<2; i++) {
+ tx[i] = (double)((int32_t)(z));
+ z = (z-tx[i])*two24;
+ }
+ tx[2] = z;
+ nx = 3;
+ while (tx[nx-1] == zero) nx--; /* skip zero term */
+ n = __rem_pio2_large(tx,ty,e0,nx,1);
+ if (hx < 0) {
+ y[0] = -ty[0];
+ y[1] = -ty[1];
+ return -n;
+ }
+ y[0] = ty[0];
+ y[1] = ty[1];
+ return n;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_rem_pio2.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * __rem_pio2_large(x,y,e0,nx,prec)
+ * double x[],y[]; int e0,nx,prec;
+ *
+ * __rem_pio2_large return the last three digits of N with
+ * y = x - N*pi/2
+ * so that |y| < pi/2.
+ *
+ * The method is to compute the integer (mod 8) and fraction parts of
+ * (2/pi)*x without doing the full multiplication. In general we
+ * skip the part of the product that are known to be a huge integer (
+ * more accurately, = 0 mod 8 ). Thus the number of operations are
+ * independent of the exponent of the input.
+ *
+ * (2/pi) is represented by an array of 24-bit integers in ipio2[].
+ *
+ * Input parameters:
+ * x[] The input value (must be positive) is broken into nx
+ * pieces of 24-bit integers in double precision format.
+ * x[i] will be the i-th 24 bit of x. The scaled exponent
+ * of x[0] is given in input parameter e0 (i.e., x[0]*2^e0
+ * match x's up to 24 bits.
+ *
+ * Example of breaking a double positive z into x[0]+x[1]+x[2]:
+ * e0 = ilogb(z)-23
+ * z = scalbn(z,-e0)
+ * for i = 0,1,2
+ * x[i] = floor(z)
+ * z = (z-x[i])*2**24
+ *
+ *
+ * y[] ouput result in an array of double precision numbers.
+ * The dimension of y[] is:
+ * 24-bit precision 1
+ * 53-bit precision 2
+ * 64-bit precision 2
+ * 113-bit precision 3
+ * The actual value is the sum of them. Thus for 113-bit
+ * precison, one may have to do something like:
+ *
+ * long double t,w,r_head, r_tail;
+ * t = (long double)y[2] + (long double)y[1];
+ * w = (long double)y[0];
+ * r_head = t+w;
+ * r_tail = w - (r_head - t);
+ *
+ * e0 The exponent of x[0]. Must be <= 16360 or you need to
+ * expand the ipio2 table.
+ *
+ * nx dimension of x[]
+ *
+ * prec an integer indicating the precision:
+ * 0 24 bits (single)
+ * 1 53 bits (double)
+ * 2 64 bits (extended)
+ * 3 113 bits (quad)
+ *
+ * External function:
+ * double scalbn(), floor();
+ *
+ *
+ * Here is the description of some local variables:
+ *
+ * jk jk+1 is the initial number of terms of ipio2[] needed
+ * in the computation. The minimum and recommended value
+ * for jk is 3,4,4,6 for single, double, extended, and quad.
+ * jk+1 must be 2 larger than you might expect so that our
+ * recomputation test works. (Up to 24 bits in the integer
+ * part (the 24 bits of it that we compute) and 23 bits in
+ * the fraction part may be lost to cancelation before we
+ * recompute.)
+ *
+ * jz local integer variable indicating the number of
+ * terms of ipio2[] used.
+ *
+ * jx nx - 1
+ *
+ * jv index for pointing to the suitable ipio2[] for the
+ * computation. In general, we want
+ * ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8
+ * is an integer. Thus
+ * e0-3-24*jv >= 0 or (e0-3)/24 >= jv
+ * Hence jv = max(0,(e0-3)/24).
+ *
+ * jp jp+1 is the number of terms in PIo2[] needed, jp = jk.
+ *
+ * q[] double array with integral value, representing the
+ * 24-bits chunk of the product of x and 2/pi.
+ *
+ * q0 the corresponding exponent of q[0]. Note that the
+ * exponent for q[i] would be q0-24*i.
+ *
+ * PIo2[] double precision array, obtained by cutting pi/2
+ * into 24 bits chunks.
+ *
+ * f[] ipio2[] in floating point
+ *
+ * iq[] integer array by breaking up q[] in 24-bits chunk.
+ *
+ * fq[] final product of x*(2/pi) in fq[0],..,fq[jk]
+ *
+ * ih integer. If >0 it indicates q[] is >= 0.5, hence
+ * it also indicates the *sign* of the result.
+ *
+ */
+/*
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "libm.h"
+
+static const int init_jk[] = {3,4,4,6}; /* initial value for jk */
+
+/*
+ * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi
+ *
+ * integer array, contains the (24*i)-th to (24*i+23)-th
+ * bit of 2/pi after binary point. The corresponding
+ * floating value is
+ *
+ * ipio2[i] * 2^(-24(i+1)).
+ *
+ * NB: This table must have at least (e0-3)/24 + jk terms.
+ * For quad precision (e0 <= 16360, jk = 6), this is 686.
+ */
+static const int32_t ipio2[] = {
+0xA2F983, 0x6E4E44, 0x1529FC, 0x2757D1, 0xF534DD, 0xC0DB62,
+0x95993C, 0x439041, 0xFE5163, 0xABDEBB, 0xC561B7, 0x246E3A,
+0x424DD2, 0xE00649, 0x2EEA09, 0xD1921C, 0xFE1DEB, 0x1CB129,
+0xA73EE8, 0x8235F5, 0x2EBB44, 0x84E99C, 0x7026B4, 0x5F7E41,
+0x3991D6, 0x398353, 0x39F49C, 0x845F8B, 0xBDF928, 0x3B1FF8,
+0x97FFDE, 0x05980F, 0xEF2F11, 0x8B5A0A, 0x6D1F6D, 0x367ECF,
+0x27CB09, 0xB74F46, 0x3F669E, 0x5FEA2D, 0x7527BA, 0xC7EBE5,
+0xF17B3D, 0x0739F7, 0x8A5292, 0xEA6BFB, 0x5FB11F, 0x8D5D08,
+0x560330, 0x46FC7B, 0x6BABF0, 0xCFBC20, 0x9AF436, 0x1DA9E3,
+0x91615E, 0xE61B08, 0x659985, 0x5F14A0, 0x68408D, 0xFFD880,
+0x4D7327, 0x310606, 0x1556CA, 0x73A8C9, 0x60E27B, 0xC08C6B,
+
+#if LDBL_MAX_EXP > 1024
+0x47C419, 0xC367CD, 0xDCE809, 0x2A8359, 0xC4768B, 0x961CA6,
+0xDDAF44, 0xD15719, 0x053EA5, 0xFF0705, 0x3F7E33, 0xE832C2,
+0xDE4F98, 0x327DBB, 0xC33D26, 0xEF6B1E, 0x5EF89F, 0x3A1F35,
+0xCAF27F, 0x1D87F1, 0x21907C, 0x7C246A, 0xFA6ED5, 0x772D30,
+0x433B15, 0xC614B5, 0x9D19C3, 0xC2C4AD, 0x414D2C, 0x5D000C,
+0x467D86, 0x2D71E3, 0x9AC69B, 0x006233, 0x7CD2B4, 0x97A7B4,
+0xD55537, 0xF63ED7, 0x1810A3, 0xFC764D, 0x2A9D64, 0xABD770,
+0xF87C63, 0x57B07A, 0xE71517, 0x5649C0, 0xD9D63B, 0x3884A7,
+0xCB2324, 0x778AD6, 0x23545A, 0xB91F00, 0x1B0AF1, 0xDFCE19,
+0xFF319F, 0x6A1E66, 0x615799, 0x47FBAC, 0xD87F7E, 0xB76522,
+0x89E832, 0x60BFE6, 0xCDC4EF, 0x09366C, 0xD43F5D, 0xD7DE16,
+0xDE3B58, 0x929BDE, 0x2822D2, 0xE88628, 0x4D58E2, 0x32CAC6,
+0x16E308, 0xCB7DE0, 0x50C017, 0xA71DF3, 0x5BE018, 0x34132E,
+0x621283, 0x014883, 0x5B8EF5, 0x7FB0AD, 0xF2E91E, 0x434A48,
+0xD36710, 0xD8DDAA, 0x425FAE, 0xCE616A, 0xA4280A, 0xB499D3,
+0xF2A606, 0x7F775C, 0x83C2A3, 0x883C61, 0x78738A, 0x5A8CAF,
+0xBDD76F, 0x63A62D, 0xCBBFF4, 0xEF818D, 0x67C126, 0x45CA55,
+0x36D9CA, 0xD2A828, 0x8D61C2, 0x77C912, 0x142604, 0x9B4612,
+0xC459C4, 0x44C5C8, 0x91B24D, 0xF31700, 0xAD43D4, 0xE54929,
+0x10D5FD, 0xFCBE00, 0xCC941E, 0xEECE70, 0xF53E13, 0x80F1EC,
+0xC3E7B3, 0x28F8C7, 0x940593, 0x3E71C1, 0xB3092E, 0xF3450B,
+0x9C1288, 0x7B20AB, 0x9FB52E, 0xC29247, 0x2F327B, 0x6D550C,
+0x90A772, 0x1FE76B, 0x96CB31, 0x4A1679, 0xE27941, 0x89DFF4,
+0x9794E8, 0x84E6E2, 0x973199, 0x6BED88, 0x365F5F, 0x0EFDBB,
+0xB49A48, 0x6CA467, 0x427271, 0x325D8D, 0xB8159F, 0x09E5BC,
+0x25318D, 0x3974F7, 0x1C0530, 0x010C0D, 0x68084B, 0x58EE2C,
+0x90AA47, 0x02E774, 0x24D6BD, 0xA67DF7, 0x72486E, 0xEF169F,
+0xA6948E, 0xF691B4, 0x5153D1, 0xF20ACF, 0x339820, 0x7E4BF5,
+0x6863B2, 0x5F3EDD, 0x035D40, 0x7F8985, 0x295255, 0xC06437,
+0x10D86D, 0x324832, 0x754C5B, 0xD4714E, 0x6E5445, 0xC1090B,
+0x69F52A, 0xD56614, 0x9D0727, 0x50045D, 0xDB3BB4, 0xC576EA,
+0x17F987, 0x7D6B49, 0xBA271D, 0x296996, 0xACCCC6, 0x5414AD,
+0x6AE290, 0x89D988, 0x50722C, 0xBEA404, 0x940777, 0x7030F3,
+0x27FC00, 0xA871EA, 0x49C266, 0x3DE064, 0x83DD97, 0x973FA3,
+0xFD9443, 0x8C860D, 0xDE4131, 0x9D3992, 0x8C70DD, 0xE7B717,
+0x3BDF08, 0x2B3715, 0xA0805C, 0x93805A, 0x921110, 0xD8E80F,
+0xAF806C, 0x4BFFDB, 0x0F9038, 0x761859, 0x15A562, 0xBBCB61,
+0xB989C7, 0xBD4010, 0x04F2D2, 0x277549, 0xF6B6EB, 0xBB22DB,
+0xAA140A, 0x2F2689, 0x768364, 0x333B09, 0x1A940E, 0xAA3A51,
+0xC2A31D, 0xAEEDAF, 0x12265C, 0x4DC26D, 0x9C7A2D, 0x9756C0,
+0x833F03, 0xF6F009, 0x8C402B, 0x99316D, 0x07B439, 0x15200C,
+0x5BC3D8, 0xC492F5, 0x4BADC6, 0xA5CA4E, 0xCD37A7, 0x36A9E6,
+0x9492AB, 0x6842DD, 0xDE6319, 0xEF8C76, 0x528B68, 0x37DBFC,
+0xABA1AE, 0x3115DF, 0xA1AE00, 0xDAFB0C, 0x664D64, 0xB705ED,
+0x306529, 0xBF5657, 0x3AFF47, 0xB9F96A, 0xF3BE75, 0xDF9328,
+0x3080AB, 0xF68C66, 0x15CB04, 0x0622FA, 0x1DE4D9, 0xA4B33D,
+0x8F1B57, 0x09CD36, 0xE9424E, 0xA4BE13, 0xB52333, 0x1AAAF0,
+0xA8654F, 0xA5C1D2, 0x0F3F0B, 0xCD785B, 0x76F923, 0x048B7B,
+0x721789, 0x53A6C6, 0xE26E6F, 0x00EBEF, 0x584A9B, 0xB7DAC4,
+0xBA66AA, 0xCFCF76, 0x1D02D1, 0x2DF1B1, 0xC1998C, 0x77ADC3,
+0xDA4886, 0xA05DF7, 0xF480C6, 0x2FF0AC, 0x9AECDD, 0xBC5C3F,
+0x6DDED0, 0x1FC790, 0xB6DB2A, 0x3A25A3, 0x9AAF00, 0x9353AD,
+0x0457B6, 0xB42D29, 0x7E804B, 0xA707DA, 0x0EAA76, 0xA1597B,
+0x2A1216, 0x2DB7DC, 0xFDE5FA, 0xFEDB89, 0xFDBE89, 0x6C76E4,
+0xFCA906, 0x70803E, 0x156E85, 0xFF87FD, 0x073E28, 0x336761,
+0x86182A, 0xEABD4D, 0xAFE7B3, 0x6E6D8F, 0x396795, 0x5BBF31,
+0x48D784, 0x16DF30, 0x432DC7, 0x356125, 0xCE70C9, 0xB8CB30,
+0xFD6CBF, 0xA200A4, 0xE46C05, 0xA0DD5A, 0x476F21, 0xD21262,
+0x845CB9, 0x496170, 0xE0566B, 0x015299, 0x375550, 0xB7D51E,
+0xC4F133, 0x5F6E13, 0xE4305D, 0xA92E85, 0xC3B21D, 0x3632A1,
+0xA4B708, 0xD4B1EA, 0x21F716, 0xE4698F, 0x77FF27, 0x80030C,
+0x2D408D, 0xA0CD4F, 0x99A520, 0xD3A2B3, 0x0A5D2F, 0x42F9B4,
+0xCBDA11, 0xD0BE7D, 0xC1DB9B, 0xBD17AB, 0x81A2CA, 0x5C6A08,
+0x17552E, 0x550027, 0xF0147F, 0x8607E1, 0x640B14, 0x8D4196,
+0xDEBE87, 0x2AFDDA, 0xB6256B, 0x34897B, 0xFEF305, 0x9EBFB9,
+0x4F6A68, 0xA82A4A, 0x5AC44F, 0xBCF82D, 0x985AD7, 0x95C7F4,
+0x8D4D0D, 0xA63A20, 0x5F57A4, 0xB13F14, 0x953880, 0x0120CC,
+0x86DD71, 0xB6DEC9, 0xF560BF, 0x11654D, 0x6B0701, 0xACB08C,
+0xD0C0B2, 0x485551, 0x0EFB1E, 0xC37295, 0x3B06A3, 0x3540C0,
+0x7BDC06, 0xCC45E0, 0xFA294E, 0xC8CAD6, 0x41F3E8, 0xDE647C,
+0xD8649B, 0x31BED9, 0xC397A4, 0xD45877, 0xC5E369, 0x13DAF0,
+0x3C3ABA, 0x461846, 0x5F7555, 0xF5BDD2, 0xC6926E, 0x5D2EAC,
+0xED440E, 0x423E1C, 0x87C461, 0xE9FD29, 0xF3D6E7, 0xCA7C22,
+0x35916F, 0xC5E008, 0x8DD7FF, 0xE26A6E, 0xC6FDB0, 0xC10893,
+0x745D7C, 0xB2AD6B, 0x9D6ECD, 0x7B723E, 0x6A11C6, 0xA9CFF7,
+0xDF7329, 0xBAC9B5, 0x5100B7, 0x0DB2E2, 0x24BA74, 0x607DE5,
+0x8AD874, 0x2C150D, 0x0C1881, 0x94667E, 0x162901, 0x767A9F,
+0xBEFDFD, 0xEF4556, 0x367ED9, 0x13D9EC, 0xB9BA8B, 0xFC97C4,
+0x27A831, 0xC36EF1, 0x36C594, 0x56A8D8, 0xB5A8B4, 0x0ECCCF,
+0x2D8912, 0x34576F, 0x89562C, 0xE3CE99, 0xB920D6, 0xAA5E6B,
+0x9C2A3E, 0xCC5F11, 0x4A0BFD, 0xFBF4E1, 0x6D3B8E, 0x2C86E2,
+0x84D4E9, 0xA9B4FC, 0xD1EEEF, 0xC9352E, 0x61392F, 0x442138,
+0xC8D91B, 0x0AFC81, 0x6A4AFB, 0xD81C2F, 0x84B453, 0x8C994E,
+0xCC2254, 0xDC552A, 0xD6C6C0, 0x96190B, 0xB8701A, 0x649569,
+0x605A26, 0xEE523F, 0x0F117F, 0x11B5F4, 0xF5CBFC, 0x2DBC34,
+0xEEBC34, 0xCC5DE8, 0x605EDD, 0x9B8E67, 0xEF3392, 0xB817C9,
+0x9B5861, 0xBC57E1, 0xC68351, 0x103ED8, 0x4871DD, 0xDD1C2D,
+0xA118AF, 0x462C21, 0xD7F359, 0x987AD9, 0xC0549E, 0xFA864F,
+0xFC0656, 0xAE79E5, 0x362289, 0x22AD38, 0xDC9367, 0xAAE855,
+0x382682, 0x9BE7CA, 0xA40D51, 0xB13399, 0x0ED7A9, 0x480569,
+0xF0B265, 0xA7887F, 0x974C88, 0x36D1F9, 0xB39221, 0x4A827B,
+0x21CF98, 0xDC9F40, 0x5547DC, 0x3A74E1, 0x42EB67, 0xDF9DFE,
+0x5FD45E, 0xA4677B, 0x7AACBA, 0xA2F655, 0x23882B, 0x55BA41,
+0x086E59, 0x862A21, 0x834739, 0xE6E389, 0xD49EE5, 0x40FB49,
+0xE956FF, 0xCA0F1C, 0x8A59C5, 0x2BFA94, 0xC5C1D3, 0xCFC50F,
+0xAE5ADB, 0x86C547, 0x624385, 0x3B8621, 0x94792C, 0x876110,
+0x7B4C2A, 0x1A2C80, 0x12BF43, 0x902688, 0x893C78, 0xE4C4A8,
+0x7BDBE5, 0xC23AC4, 0xEAF426, 0x8A67F7, 0xBF920D, 0x2BA365,
+0xB1933D, 0x0B7CBD, 0xDC51A4, 0x63DD27, 0xDDE169, 0x19949A,
+0x9529A8, 0x28CE68, 0xB4ED09, 0x209F44, 0xCA984E, 0x638270,
+0x237C7E, 0x32B90F, 0x8EF5A7, 0xE75614, 0x08F121, 0x2A9DB5,
+0x4D7E6F, 0x5119A5, 0xABF9B5, 0xD6DF82, 0x61DD96, 0x023616,
+0x9F3AC4, 0xA1A283, 0x6DED72, 0x7A8D39, 0xA9B882, 0x5C326B,
+0x5B2746, 0xED3400, 0x7700D2, 0x55F4FC, 0x4D5901, 0x8071E0,
+#endif
+};
+
+static const double PIo2[] = {
+ 1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */
+ 7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */
+ 5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */
+ 3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */
+ 1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */
+ 1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */
+ 2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */
+ 2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */
+};
+
+static const double
+zero = 0.0,
+one = 1.0,
+two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
+twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */
+
+int __rem_pio2_large(double *x, double *y, int e0, int nx, int prec)
+{
+ int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih;
+ double z,fw,f[20],fq[20],q[20];
+
+ /* initialize jk*/
+ jk = init_jk[prec];
+ jp = jk;
+
+ /* determine jx,jv,q0, note that 3>q0 */
+ jx = nx-1;
+ jv = (e0-3)/24; if(jv<0) jv=0;
+ q0 = e0-24*(jv+1);
+
+ /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
+ j = jv-jx; m = jx+jk;
+ for (i=0; i<=m; i++,j++)
+ f[i] = j<0 ? zero : (double)ipio2[j];
+
+ /* compute q[0],q[1],...q[jk] */
+ for (i=0; i<=jk; i++) {
+ for (j=0,fw=0.0; j<=jx; j++)
+ fw += x[j]*f[jx+i-j];
+ q[i] = fw;
+ }
+
+ jz = jk;
+recompute:
+ /* distill q[] into iq[] reversingly */
+ for (i=0,j=jz,z=q[jz]; j>0; i++,j--) {
+ fw = (double)((int32_t)(twon24* z));
+ iq[i] = (int32_t)(z-two24*fw);
+ z = q[j-1]+fw;
+ }
+
+ /* compute n */
+ z = scalbn(z,q0); /* actual value of z */
+ z -= 8.0*floor(z*0.125); /* trim off integer >= 8 */
+ n = (int32_t)z;
+ z -= (double)n;
+ ih = 0;
+ if (q0 > 0) { /* need iq[jz-1] to determine n */
+ i = iq[jz-1]>>(24-q0); n += i;
+ iq[jz-1] -= i<<(24-q0);
+ ih = iq[jz-1]>>(23-q0);
+ }
+ else if (q0 == 0) ih = iq[jz-1]>>23;
+ else if (z >= 0.5) ih = 2;
+
+ if (ih > 0) { /* q > 0.5 */
+ n += 1; carry = 0;
+ for (i=0; i<jz; i++) { /* compute 1-q */
+ j = iq[i];
+ if (carry == 0) {
+ if (j != 0) {
+ carry = 1;
+ iq[i] = 0x1000000- j;
+ }
+ } else
+ iq[i] = 0xffffff - j;
+ }
+ if (q0 > 0) { /* rare case: chance is 1 in 12 */
+ switch(q0) {
+ case 1:
+ iq[jz-1] &= 0x7fffff; break;
+ case 2:
+ iq[jz-1] &= 0x3fffff; break;
+ }
+ }
+ if (ih == 2) {
+ z = one - z;
+ if (carry != 0)
+ z -= scalbn(one,q0);
+ }
+ }
+
+ /* check if recomputation is needed */
+ if (z == zero) {
+ j = 0;
+ for (i=jz-1; i>=jk; i--) j |= iq[i];
+ if (j == 0) { /* need recomputation */
+ for (k=1; iq[jk-k]==0; k++); /* k = no. of terms needed */
+
+ for (i=jz+1; i<=jz+k; i++) { /* add q[jz+1] to q[jz+k] */
+ f[jx+i] = (double)ipio2[jv+i];
+ for (j=0,fw=0.0; j<=jx; j++)
+ fw += x[j]*f[jx+i-j];
+ q[i] = fw;
+ }
+ jz += k;
+ goto recompute;
+ }
+ }
+
+ /* chop off zero terms */
+ if (z == 0.0) {
+ jz -= 1;
+ q0 -= 24;
+ while (iq[jz] == 0) {
+ jz--;
+ q0 -= 24;
+ }
+ } else { /* break z into 24-bit if necessary */
+ z = scalbn(z,-q0);
+ if (z >= two24) {
+ fw = (double)((int32_t)(twon24*z));
+ iq[jz] = (int32_t)(z-two24*fw);
+ jz += 1;
+ q0 += 24;
+ iq[jz] = (int32_t)fw;
+ } else
+ iq[jz] = (int32_t)z;
+ }
+
+ /* convert integer "bit" chunk to floating-point value */
+ fw = scalbn(one,q0);
+ for (i=jz; i>=0; i--) {
+ q[i] = fw*(double)iq[i];
+ fw *= twon24;
+ }
+
+ /* compute PIo2[0,...,jp]*q[jz,...,0] */
+ for(i=jz; i>=0; i--) {
+ for (fw=0.0,k=0; k<=jp && k<=jz-i; k++)
+ fw += PIo2[k]*q[i+k];
+ fq[jz-i] = fw;
+ }
+
+ /* compress fq[] into y[] */
+ switch(prec) {
+ case 0:
+ fw = 0.0;
+ for (i=jz; i>=0; i--)
+ fw += fq[i];
+ y[0] = ih==0 ? fw : -fw;
+ break;
+ case 1:
+ case 2:
+ fw = 0.0;
+ for (i=jz; i>=0; i--)
+ fw += fq[i];
+ STRICT_ASSIGN(double,fw,fw);
+ y[0] = ih==0 ? fw : -fw;
+ fw = fq[0]-fw;
+ for (i=1; i<=jz; i++)
+ fw += fq[i];
+ y[1] = ih==0 ? fw : -fw;
+ break;
+ case 3: /* painful */
+ for (i=jz; i>0; i--) {
+ fw = fq[i-1]+fq[i];
+ fq[i] += fq[i-1]-fw;
+ fq[i-1] = fw;
+ }
+ for (i=jz; i>1; i--) {
+ fw = fq[i-1]+fq[i];
+ fq[i] += fq[i-1]-fw;
+ fq[i-1] = fw;
+ }
+ for (fw=0.0,i=jz; i>=2; i--)
+ fw += fq[i];
+ if (ih==0) {
+ y[0] = fq[0]; y[1] = fq[1]; y[2] = fw;
+ } else {
+ y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw;
+ }
+ }
+ return n&7;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_rem_pio2f.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Debugged and optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* __rem_pio2f(x,y)
+ *
+ * return the remainder of x rem pi/2 in *y
+ * use double precision for everything except passing x
+ * use __rem_pio2_large() for large x
+ */
+
+#include "libm.h"
+
+/*
+ * invpio2: 53 bits of 2/pi
+ * pio2_1: first 33 bit of pi/2
+ * pio2_1t: pi/2 - pio2_1
+ */
+static const double
+invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+pio2_1 = 1.57079631090164184570e+00, /* 0x3FF921FB, 0x50000000 */
+pio2_1t = 1.58932547735281966916e-08; /* 0x3E5110b4, 0x611A6263 */
+
+int __rem_pio2f(float x, double *y)
+{
+ double w,r,fn;
+ double tx[1],ty[1];
+ float z;
+ int32_t e0,n,ix,hx;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ /* 33+53 bit pi is good enough for medium size */
+ if (ix < 0x4dc90fdb) { /* |x| ~< 2^28*(pi/2), medium size */
+ /* Use a specialized rint() to get fn. Assume round-to-nearest. */
+ STRICT_ASSIGN(double, fn, x*invpio2 + 0x1.8p52);
+ fn = fn - 0x1.8p52;
+// FIXME
+#ifdef HAVE_EFFICIENT_IRINT
+ n = irint(fn);
+#else
+ n = (int32_t)fn;
+#endif
+ r = x - fn*pio2_1;
+ w = fn*pio2_1t;
+ *y = r - w;
+ return n;
+ }
+ /*
+ * all other (large) arguments
+ */
+ if(ix>=0x7f800000) { /* x is inf or NaN */
+ *y = x-x;
+ return 0;
+ }
+ /* set z = scalbn(|x|,ilogb(|x|)-23) */
+ e0 = (ix>>23) - 150; /* e0 = ilogb(|x|)-23; */
+ SET_FLOAT_WORD(z, ix - ((int32_t)(e0<<23)));
+ tx[0] = z;
+ n = __rem_pio2_large(tx,ty,e0,1,0);
+ if (hx < 0) {
+ *y = -ty[0];
+ return -n;
+ }
+ *y = ty[0];
+ return n;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/ld80/e_rem_pio2.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ * Optimized by Bruce D. Evans.
+ */
+#include "libm.h"
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/* ld80 version of __rem_pio2(x,y)
+ *
+ * return the remainder of x rem pi/2 in y[0]+y[1]
+ * use __rem_pio2_large() for large x
+ */
+
+#define BIAS (LDBL_MAX_EXP - 1)
+
+/*
+ * invpio2: 64 bits of 2/pi
+ * pio2_1: first 39 bits of pi/2
+ * pio2_1t: pi/2 - pio2_1
+ * pio2_2: second 39 bits of pi/2
+ * pio2_2t: pi/2 - (pio2_1+pio2_2)
+ * pio2_3: third 39 bits of pi/2
+ * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
+ */
+static const double
+zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
+pio2_1 = 1.57079632679597125389e+00, /* 0x3FF921FB, 0x54444000 */
+pio2_2 = -1.07463465549783099519e-12, /* -0x12e7b967674000.0p-92 */
+pio2_3 = 6.36831716351370313614e-25; /* 0x18a2e037074000.0p-133 */
+
+// FIXME: this should be verified (maybe old gcc specific hack)
+//#if defined(__amd64__) || defined(__i386__)
+/* Long double constants are slow on these arches, and broken on i386. */
+static const volatile double
+invpio2hi = 6.3661977236758138e-01, /* 0x145f306dc9c883.0p-53 */
+invpio2lo = -3.9356538861223811e-17, /* -0x16b00000000000.0p-107 */
+pio2_1thi = -1.0746346554971943e-12, /* -0x12e7b9676733af.0p-92 */
+pio2_1tlo = 8.8451028997905949e-29, /* 0x1c080000000000.0p-146 */
+pio2_2thi = 6.3683171635109499e-25, /* 0x18a2e03707344a.0p-133 */
+pio2_2tlo = 2.3183081793789774e-41, /* 0x10280000000000.0p-187 */
+pio2_3thi = -2.7529965190440717e-37, /* -0x176b7ed8fbbacc.0p-174 */
+pio2_3tlo = -4.2006647512740502e-54; /* -0x19c00000000000.0p-230 */
+#define invpio2 ((long double)invpio2hi + invpio2lo)
+#define pio2_1t ((long double)pio2_1thi + pio2_1tlo)
+#define pio2_2t ((long double)pio2_2thi + pio2_2tlo)
+#define pio2_3t ((long double)pio2_3thi + pio2_3tlo)
+//#else
+#if 0
+static const long double
+invpio2 = 6.36619772367581343076e-01L, /* 0xa2f9836e4e44152a.0p-64 */
+pio2_1t = -1.07463465549719416346e-12L, /* -0x973dcb3b399d747f.0p-103 */
+pio2_2t = 6.36831716351095013979e-25L, /* 0xc51701b839a25205.0p-144 */
+pio2_3t = -2.75299651904407171810e-37L; /* -0xbb5bf6c7ddd660ce.0p-185 */
+#endif
+
+static inline int __rem_pio2l(long double x, long double *y)
+{
+ union IEEEl2bits u,u1;
+ long double z,w,t,r,fn;
+ double tx[3],ty[2];
+ int e0,ex,i,j,nx,n;
+ int16_t expsign;
+
+ u.e = x;
+ expsign = u.xbits.expsign;
+ ex = expsign & 0x7fff;
+ if (ex < BIAS + 25 || (ex == BIAS + 25 && u.bits.manh < 0xc90fdaa2)) {
+ union IEEEl2bits u2;
+ int ex1;
+
+ /* |x| ~< 2^25*(pi/2), medium size */
+ /* Use a specialized rint() to get fn. Assume round-to-nearest. */
+ fn = x*invpio2 + 0x1.8p63;
+ fn = fn - 0x1.8p63;
+// FIXME
+//#ifdef HAVE_EFFICIENT_IRINT
+// n = irint(fn);
+//#else
+ n = fn;
+//#endif
+ r = x-fn*pio2_1;
+ w = fn*pio2_1t; /* 1st round good to 102 bit */
+ j = ex;
+ y[0] = r-w;
+ u2.e = y[0];
+ ex1 = u2.xbits.expsign & 0x7fff;
+ i = j-ex1;
+ if (i > 22) { /* 2nd iteration needed, good to 141 */
+ t = r;
+ w = fn*pio2_2;
+ r = t-w;
+ w = fn*pio2_2t-((t-r)-w);
+ y[0] = r-w;
+ u2.e = y[0];
+ ex1 = u2.xbits.expsign & 0x7fff;
+ i = j-ex1;
+ if (i > 61) { /* 3rd iteration need, 180 bits acc */
+ t = r; /* will cover all possible cases */
+ w = fn*pio2_3;
+ r = t-w;
+ w = fn*pio2_3t-((t-r)-w);
+ y[0] = r-w;
+ }
+ }
+ y[1] = (r - y[0]) - w;
+ return n;
+ }
+ /*
+ * all other (large) arguments
+ */
+ if (ex == 0x7fff) { /* x is inf or NaN */
+ y[0] = y[1] = x - x;
+ return 0;
+ }
+ /* set z = scalbn(|x|,ilogb(x)-23) */
+ u1.e = x;
+ e0 = ex - BIAS - 23; /* e0 = ilogb(|x|)-23; */
+ u1.xbits.expsign = ex - e0;
+ z = u1.e;
+ for (i=0; i<2; i++) {
+ tx[i] = (double)(int32_t)z;
+ z = (z-tx[i])*two24;
+ }
+ tx[2] = z;
+ nx = 3;
+ while (tx[nx-1] == zero)
+ nx--; /* skip zero term */
+ n = __rem_pio2_large(tx,ty,e0,nx,2);
+ r = (long double)ty[0] + ty[1];
+ w = ty[1] - (r - ty[0]);
+ if (expsign < 0) {
+ y[0] = -r;
+ y[1] = -w;
+ return -n;
+ }
+ y[0] = r;
+ y[1] = w;
+ return n;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+// FIXME: macro
+int __signbit(double x)
+{
+ union {
+ double d;
+ uint64_t i;
+ } y = { x };
+ return y.i>>63;
+}
+
+
--- /dev/null
+#include "libm.h"
+
+// FIXME
+int __signbitf(float x)
+{
+ union {
+ float f;
+ uint32_t i;
+ } y = { x };
+ return y.i>>31;
+}
--- /dev/null
+#include "libm.h"
+
+// FIXME: should be a macro
+#if (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+int __signbitl(long double x)
+{
+ union ldshape u = {x};
+
+ return u.bits.sign;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_sin.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* __sin( x, y, iy)
+ * kernel sin function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ * Input iy indicates whether y is 0. (if iy=0, y assume to be 0).
+ *
+ * Algorithm
+ * 1. Since sin(-x) = -sin(x), we need only to consider positive x.
+ * 2. Callers must return sin(-0) = -0 without calling here since our
+ * odd polynomial is not evaluated in a way that preserves -0.
+ * Callers may do the optimization sin(x) ~ x for tiny x.
+ * 3. sin(x) is approximated by a polynomial of degree 13 on
+ * [0,pi/4]
+ * 3 13
+ * sin(x) ~ x + S1*x + ... + S6*x
+ * where
+ *
+ * |sin(x) 2 4 6 8 10 12 | -58
+ * |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2
+ * | x |
+ *
+ * 4. sin(x+y) = sin(x) + sin'(x')*y
+ * ~ sin(x) + (1-x*x/2)*y
+ * For better accuracy, let
+ * 3 2 2 2 2
+ * r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6))))
+ * then 3 2
+ * sin(x) = x + (S1*x + (x *(r-y/2)+y))
+ */
+
+#include "libm.h"
+
+static const double
+half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */
+S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */
+S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */
+S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */
+S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */
+S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */
+
+double __sin(double x, double y, int iy)
+{
+ double z,r,v,w;
+
+ z = x*x;
+ w = z*z;
+ r = S2 + z*(S3 + z*S4) + z*w*(S5 + z*S6);
+ v = z*x;
+ if (iy == 0)
+ return x + v*(S1 + z*r);
+ else
+ return x - ((z*(half*y - v*r) - y) - v*S1);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_sinf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+/* |sin(x)/x - s(x)| < 2**-37.5 (~[-4.89e-12, 4.824e-12]). */
+static const double
+S1 = -0x15555554cbac77.0p-55, /* -0.166666666416265235595 */
+S2 = 0x111110896efbb2.0p-59, /* 0.0083333293858894631756 */
+S3 = -0x1a00f9e2cae774.0p-65, /* -0.000198393348360966317347 */
+S4 = 0x16cd878c3b46a7.0p-71; /* 0.0000027183114939898219064 */
+
+float __sindf(double x)
+{
+ double r, s, w, z;
+
+ /* Try to optimize for parallel evaluation as in __tandf.c. */
+ z = x*x;
+ w = z*z;
+ r = S3 + z*S4;
+ s = z*x;
+ return (x + s*(S1 + z*S2)) + s*w*r;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/ld80/k_sinl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/*
+ * ld80 version of __sin.c. See __sin.c for most comments.
+ */
+/*
+ * Domain [-0.7854, 0.7854], range ~[-1.89e-22, 1.915e-22]
+ * |sin(x)/x - s(x)| < 2**-72.1
+ *
+ * See __cosl.c for more details about the polynomial.
+ */
+
+static const double half = 0.5;
+
+// FIXME
+/* Long double constants are slow on these arches, and broken on i386. */
+static const volatile double
+S1hi = -0.16666666666666666, /* -0x15555555555555.0p-55 */
+S1lo = -9.2563760475949941e-18; /* -0x15580000000000.0p-109 */
+#define S1 ((long double)S1hi + S1lo)
+
+#if 0
+static const long double
+S1 = -0.166666666666666666671L; /* -0xaaaaaaaaaaaaaaab.0p-66 */
+#endif
+
+static const double
+S2 = 0.0083333333333333332, /* 0x11111111111111.0p-59 */
+S3 = -0.00019841269841269427, /* -0x1a01a01a019f81.0p-65 */
+S4 = 0.0000027557319223597490, /* 0x171de3a55560f7.0p-71 */
+S5 = -0.000000025052108218074604, /* -0x1ae64564f16cad.0p-78 */
+S6 = 1.6059006598854211e-10, /* 0x161242b90243b5.0p-85 */
+S7 = -7.6429779983024564e-13, /* -0x1ae42ebd1b2e00.0p-93 */
+S8 = 2.6174587166648325e-15; /* 0x179372ea0b3f64.0p-101 */
+
+long double __sinl(long double x, long double y, int iy)
+{
+ long double z,r,v;
+
+ z = x*x;
+ v = z*x;
+ r = S2+z*(S3+z*(S4+z*(S5+z*(S6+z*(S7+z*S8)))));
+ if (iy == 0)
+ return x+v*(S1+z*r);
+ return x-((z*(half*y-v*r)-y)-v*S1);
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_tan.c */
+/*
+ * ====================================================
+ * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved.
+ *
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* __tan( x, y, k )
+ * kernel tan function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ * Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned.
+ *
+ * Algorithm
+ * 1. Since tan(-x) = -tan(x), we need only to consider positive x.
+ * 2. Callers must return tan(-0) = -0 without calling here since our
+ * odd polynomial is not evaluated in a way that preserves -0.
+ * Callers may do the optimization tan(x) ~ x for tiny x.
+ * 3. tan(x) is approximated by a odd polynomial of degree 27 on
+ * [0,0.67434]
+ * 3 27
+ * tan(x) ~ x + T1*x + ... + T13*x
+ * where
+ *
+ * |tan(x) 2 4 26 | -59.2
+ * |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2
+ * | x |
+ *
+ * Note: tan(x+y) = tan(x) + tan'(x)*y
+ * ~ tan(x) + (1+x*x)*y
+ * Therefore, for better accuracy in computing tan(x+y), let
+ * 3 2 2 2 2
+ * r = x *(T2+x *(T3+x *(...+x *(T12+x *T13))))
+ * then
+ * 3 2
+ * tan(x+y) = x + (T1*x + (x *(r+y)+y))
+ *
+ * 4. For x in [0.67434,pi/4], let y = pi/4 - x, then
+ * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y))
+ * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y)))
+ */
+
+#include "libm.h"
+
+static const double T[] = {
+ 3.33333333333334091986e-01, /* 3FD55555, 55555563 */
+ 1.33333333333201242699e-01, /* 3FC11111, 1110FE7A */
+ 5.39682539762260521377e-02, /* 3FABA1BA, 1BB341FE */
+ 2.18694882948595424599e-02, /* 3F9664F4, 8406D637 */
+ 8.86323982359930005737e-03, /* 3F8226E3, E96E8493 */
+ 3.59207910759131235356e-03, /* 3F6D6D22, C9560328 */
+ 1.45620945432529025516e-03, /* 3F57DBC8, FEE08315 */
+ 5.88041240820264096874e-04, /* 3F4344D8, F2F26501 */
+ 2.46463134818469906812e-04, /* 3F3026F7, 1A8D1068 */
+ 7.81794442939557092300e-05, /* 3F147E88, A03792A6 */
+ 7.14072491382608190305e-05, /* 3F12B80F, 32F0A7E9 */
+ -1.85586374855275456654e-05, /* BEF375CB, DB605373 */
+ 2.59073051863633712884e-05, /* 3EFB2A70, 74BF7AD4 */
+/* one */ 1.00000000000000000000e+00, /* 3FF00000, 00000000 */
+/* pio4 */ 7.85398163397448278999e-01, /* 3FE921FB, 54442D18 */
+/* pio4lo */ 3.06161699786838301793e-17 /* 3C81A626, 33145C07 */
+};
+#define one T[13]
+#define pio4 T[14]
+#define pio4lo T[15]
+
+double __tan(double x, double y, int iy)
+{
+ double z, r, v, w, s, sign;
+ int32_t ix, hx;
+
+ GET_HIGH_WORD(hx,x);
+ ix = hx & 0x7fffffff; /* high word of |x| */
+ if (ix >= 0x3FE59428) { /* |x| >= 0.6744 */
+ if (hx < 0) {
+ x = -x;
+ y = -y;
+ }
+ z = pio4 - x;
+ w = pio4lo - y;
+ x = z + w;
+ y = 0.0;
+ }
+ z = x * x;
+ w = z * z;
+ /*
+ * Break x^5*(T[1]+x^2*T[2]+...) into
+ * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) +
+ * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12]))
+ */
+ r = T[1] + w*(T[3] + w*(T[5] + w*(T[7] + w*(T[9] + w*T[11]))));
+ v = z*(T[2] + w*(T[4] + w*(T[6] + w*(T[8] + w*(T[10] + w*T[12])))));
+ s = z * x;
+ r = y + z * (s * (r + v) + y);
+ r += T[0] * s;
+ w = x + r;
+ if (ix >= 0x3FE59428) {
+ v = iy;
+ sign = 1 - ((hx >> 30) & 2);
+ return sign * (v - 2.0 * (x - (w * w / (w + v) - r)));
+ }
+ 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 */
+ double a, t;
+ z = w;
+ SET_LOW_WORD(z,0);
+ v = r - (z - x); /* z+v = r+x */
+ t = a = -1.0 / w; /* a = -1.0/w */
+ SET_LOW_WORD(t,0);
+ s = 1.0 + t * z;
+ return t + a * (s + t * v);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/k_tanf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved.
+ *
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+/* |tan(x)/x - t(x)| < 2**-25.5 (~[-2e-08, 2e-08]). */
+static const double T[] = {
+ 0x15554d3418c99f.0p-54, /* 0.333331395030791399758 */
+ 0x1112fd38999f72.0p-55, /* 0.133392002712976742718 */
+ 0x1b54c91d865afe.0p-57, /* 0.0533812378445670393523 */
+ 0x191df3908c33ce.0p-58, /* 0.0245283181166547278873 */
+ 0x185dadfcecf44e.0p-61, /* 0.00297435743359967304927 */
+ 0x1362b9bf971bcd.0p-59, /* 0.00946564784943673166728 */
+};
+
+float __tandf(double x, int iy)
+{
+ double z,r,w,s,t,u;
+
+ z = x*x;
+ /*
+ * Split up the polynomial into small independent terms to give
+ * opportunities for parallel evaluation. The chosen splitting is
+ * micro-optimized for Athlons (XP, X64). It costs 2 multiplications
+ * relative to Horner's method on sequential machines.
+ *
+ * We add the small terms from lowest degree up for efficiency on
+ * non-sequential machines (the lowest degree terms tend to be ready
+ * earlier). Apart from this, we don't care about order of
+ * operations, and don't need to to care since we have precision to
+ * spare. However, the chosen splitting is good for accuracy too,
+ * and would give results as accurate as Horner's method if the
+ * small terms were added from highest degree down.
+ */
+ r = T[4] + z*T[5];
+ t = T[2] + z*T[3];
+ w = z*z;
+ s = z*x;
+ u = T[0] + z*T[1];
+ r = (x + s*u) + (s*w)*(t + w*r);
+ if(iy==1) return r;
+ else return -1.0/r;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/ld80/k_tanl.c */
+/*
+ * ====================================================
+ * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved.
+ * Copyright (c) 2008 Steven G. Kargl, David Schultz, Bruce D. Evans.
+ *
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/*
+ * ld80 version of __tan.c. See __tan.c for most comments.
+ */
+/*
+ * Domain [-0.67434, 0.67434], range ~[-2.25e-22, 1.921e-22]
+ * |tan(x)/x - t(x)| < 2**-71.9
+ *
+ * See __cosl.c for more details about the polynomial.
+ */
+
+/* Long double constants are slow on these arches, and broken on i386. */
+static const volatile double
+T3hi = 0.33333333333333331, /* 0x15555555555555.0p-54 */
+T3lo = 1.8350121769317163e-17, /* 0x15280000000000.0p-108 */
+T5hi = 0.13333333333333336, /* 0x11111111111112.0p-55 */
+T5lo = 1.3051083651294260e-17, /* 0x1e180000000000.0p-109 */
+T7hi = 0.053968253968250494, /* 0x1ba1ba1ba1b827.0p-57 */
+T7lo = 3.1509625637859973e-18, /* 0x1d100000000000.0p-111 */
+pio4_hi = 0.78539816339744828, /* 0x1921fb54442d18.0p-53 */
+pio4_lo = 3.0628711372715500e-17, /* 0x11a80000000000.0p-107 */
+pio4lo_hi = -1.2541394031670831e-20, /* -0x1d9cceba3f91f2.0p-119 */
+pio4lo_lo = 6.1493048227390915e-37; /* 0x1a280000000000.0p-173 */
+#define T3 ((long double)T3hi + T3lo)
+#define T5 ((long double)T5hi + T5lo)
+#define T7 ((long double)T7hi + T7lo)
+#define pio4 ((long double)pio4_hi + pio4_lo)
+#define pio4lo ((long double)pio4lo_hi + pio4lo_lo)
+
+#if 0
+static const long double
+T3 = 0.333333333333333333180L, /* 0xaaaaaaaaaaaaaaa5.0p-65 */
+T5 = 0.133333333333333372290L, /* 0x88888888888893c3.0p-66 */
+T7 = 0.0539682539682504975744L, /* 0xdd0dd0dd0dc13ba2.0p-68 */
+pio4 = 0.785398163397448309628L, /* 0xc90fdaa22168c235.0p-64 */
+pio4lo = -1.25413940316708300586e-20L; /* -0xece675d1fc8f8cbb.0p-130 */
+#endif
+
+static const double
+T9 = 0.021869488536312216, /* 0x1664f4882cc1c2.0p-58 */
+T11 = 0.0088632355256619590, /* 0x1226e355c17612.0p-59 */
+T13 = 0.0035921281113786528, /* 0x1d6d3d185d7ff8.0p-61 */
+T15 = 0.0014558334756312418, /* 0x17da354aa3f96b.0p-62 */
+T17 = 0.00059003538700862256, /* 0x13559358685b83.0p-63 */
+T19 = 0.00023907843576635544, /* 0x1f56242026b5be.0p-65 */
+T21 = 0.000097154625656538905, /* 0x1977efc26806f4.0p-66 */
+T23 = 0.000038440165747303162, /* 0x14275a09b3ceac.0p-67 */
+T25 = 0.000018082171885432524, /* 0x12f5e563e5487e.0p-68 */
+T27 = 0.0000024196006108814377, /* 0x144c0d80cc6896.0p-71 */
+T29 = 0.0000078293456938132840, /* 0x106b59141a6cb3.0p-69 */
+T31 = -0.0000032609076735050182, /* -0x1b5abef3ba4b59.0p-71 */
+T33 = 0.0000023261313142559411; /* 0x13835436c0c87f.0p-71 */
+
+long double __tanl(long double x, long double y, int iy) {
+ long double z, r, v, w, s, a, t;
+ long double osign;
+ int i;
+
+ iy = iy == 1 ? -1 : 1; /* XXX recover original interface */
+ // FIXME: this is wrong, use copysign, signbit or union bithack
+ osign = x >= 0 ? 1.0 : -1.0; /* XXX slow, probably wrong for -0 */
+ if (fabsl(x) >= 0.67434) {
+ if (x < 0) {
+ x = -x;
+ y = -y;
+ }
+ z = pio4 - x;
+ w = pio4lo - y;
+ x = z + w;
+ y = 0.0;
+ i = 1;
+ } else
+ i = 0;
+ z = x * x;
+ w = z * z;
+ r = T5 + w * (T9 + w * (T13 + w * (T17 + w * (T21 +
+ w * (T25 + w * (T29 + w * T33))))));
+ v = z * (T7 + w * (T11 + w * (T15 + w * (T19 + w * (T23 +
+ w * (T27 + w * T31))))));
+ s = z * x;
+ r = y + z * (s * (r + v) + y);
+ r += T3 * s;
+ w = x + r;
+ if (i == 1) {
+ v = (long double)iy;
+ return osign * (v - 2.0 * (x - (w * w / (w + v) - r)));
+ }
+ if (iy == 1)
+ return w;
+
+ /*
+ * if allow error up to 2 ulp, simply return
+ * -1.0 / (x+r) here
+ */
+ /* compute -1.0 / (x+r) accurately */
+ z = w;
+ z = z + 0x1p32 - 0x1p32;
+ v = r - (z - x); /* z+v = r+x */
+ t = a = -1.0 / w; /* a = -1.0/w */
+ t = t + 0x1p32 - 0x1p32;
+ s = 1.0 + t * z;
+ return t + a * (s + t * v);
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_acos.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* acos(x)
+ * Method :
+ * acos(x) = pi/2 - asin(x)
+ * acos(-x) = pi/2 + asin(x)
+ * For |x|<=0.5
+ * acos(x) = pi/2 - (x + x*x^2*R(x^2)) (see asin.c)
+ * For x>0.5
+ * acos(x) = pi/2 - (pi/2 - 2asin(sqrt((1-x)/2)))
+ * = 2asin(sqrt((1-x)/2))
+ * = 2s + 2s*z*R(z) ...z=(1-x)/2, s=sqrt(z)
+ * = 2f + (2c + 2s*z*R(z))
+ * where f=hi part of s, and c = (z-f*f)/(s+f) is the correction term
+ * for f so that f+c ~ sqrt(z).
+ * For x<-0.5
+ * acos(x) = pi - 2asin(sqrt((1-|x|)/2))
+ * = pi - 0.5*(s+s*z*R(z)), where z=(1-|x|)/2,s=sqrt(z)
+ *
+ * Special cases:
+ * if x is NaN, return x itself;
+ * if |x|>1, return NaN with invalid signal.
+ *
+ * Function needed: sqrt
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
+pio2_hi = 1.57079632679489655800e+00; /* 0x3FF921FB, 0x54442D18 */
+static volatile double
+pio2_lo = 6.12323399573676603587e-17; /* 0x3C91A626, 0x33145C07 */
+static const double
+pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
+pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
+pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
+pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
+pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
+pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
+qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
+qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
+qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
+qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
+
+double acos(double x)
+{
+ double z,p,q,r,w,s,c,df;
+ int32_t hx,ix;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x3ff00000) { /* |x| >= 1 */
+ uint32_t lx;
+
+ GET_LOW_WORD(lx,x);
+ if ((ix-0x3ff00000 | lx) == 0) { /* |x|==1 */
+ if (hx > 0) return 0.0; /* acos(1) = 0 */
+ return pi + 2.0*pio2_lo; /* acos(-1)= pi */
+ }
+ return (x-x)/(x-x); /* acos(|x|>1) is NaN */
+ }
+ if (ix < 0x3fe00000) { /* |x| < 0.5 */
+ if (ix <= 0x3c600000) /* |x| < 2**-57 */
+ return pio2_hi + pio2_lo;
+ z = x*x;
+ p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
+ q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
+ r = p/q;
+ return pio2_hi - (x - (pio2_lo-x*r));
+ } else if (hx < 0) { /* x < -0.5 */
+ z = (one+x)*0.5;
+ p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
+ q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
+ s = sqrt(z);
+ r = p/q;
+ w = r*s-pio2_lo;
+ return pi - 2.0*(s+w);
+ } else { /* x > 0.5 */
+ z = (one-x)*0.5;
+ s = sqrt(z);
+ df = s;
+ SET_LOW_WORD(df,0);
+ c = (z-df*df)/(s+df);
+ p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
+ q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
+ r = p/q;
+ w = r*s+c;
+ return 2.0*(df+w);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_acosf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+one = 1.0000000000e+00, /* 0x3F800000 */
+pi = 3.1415925026e+00, /* 0x40490fda */
+pio2_hi = 1.5707962513e+00; /* 0x3fc90fda */
+static volatile float
+pio2_lo = 7.5497894159e-08; /* 0x33a22168 */
+static const float
+pS0 = 1.6666586697e-01,
+pS1 = -4.2743422091e-02,
+pS2 = -8.6563630030e-03,
+qS1 = -7.0662963390e-01;
+
+float acosf(float x)
+{
+ float z,p,q,r,w,s,c,df;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x3f800000) { /* |x| >= 1 */
+ if (ix == 0x3f800000) { /* |x| == 1 */
+ if(hx>0) return 0.0; /* acos(1) = 0 */
+ return pi + (float)2.0*pio2_lo; /* acos(-1)= pi */
+ }
+ return (x-x)/(x-x); /* acos(|x|>1) is NaN */
+ }
+ if (ix < 0x3f000000) { /* |x| < 0.5 */
+ if (ix <= 0x32800000) /* |x| < 2**-26 */
+ return pio2_hi + pio2_lo;
+ z = x*x;
+ p = z*(pS0+z*(pS1+z*pS2));
+ q = one+z*qS1;
+ r = p/q;
+ return pio2_hi - (x - (pio2_lo-x*r));
+ } else if (hx < 0) { /* x < -0.5 */
+ z = (one+x)*(float)0.5;
+ p = z*(pS0+z*(pS1+z*pS2));
+ q = one+z*qS1;
+ s = sqrtf(z);
+ r = p/q;
+ w = r*s-pio2_lo;
+ return pi - (float)2.0*(s+w);
+ } else { /* x > 0.5 */
+ int32_t idf;
+
+ z = (one-x)*(float)0.5;
+ s = sqrtf(z);
+ df = s;
+ GET_FLOAT_WORD(idf,df);
+ SET_FLOAT_WORD(df,idf&0xfffff000);
+ c = (z-df*df)/(s+df);
+ p = z*(pS0+z*(pS1+z*pS2));
+ q = one+z*qS1;
+ r = p/q;
+ w = r*s+c;
+ return (float)2.0*(df+w);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_acosh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+/* acosh(x)
+ * Method :
+ * Based on
+ * acosh(x) = log [ x + sqrt(x*x-1) ]
+ * we have
+ * acosh(x) := log(x)+ln2, if x is large; else
+ * acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else
+ * acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1.
+ *
+ * Special cases:
+ * acosh(x) is NaN with signal if x<1.
+ * acosh(NaN) is NaN without signal.
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.0,
+ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */
+
+double acosh(double x)
+{
+ double t;
+ int32_t hx;
+ uint32_t lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+ if (hx < 0x3ff00000) { /* x < 1 */
+ return (x-x)/(x-x);
+ } else if (hx >= 0x41b00000) { /* x > 2**28 */
+ if (hx >= 0x7ff00000) /* x is inf of NaN */
+ return x+x;
+ return log(x) + ln2; /* acosh(huge) = log(2x) */
+ } else if ((hx-0x3ff00000 | lx) == 0) {
+ return 0.0; /* acosh(1) = 0 */
+ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */
+ t = x*x;
+ return log(2.0*x - one/(x+sqrt(t-one)));
+ } else { /* 1 < x < 2 */
+ t = x-one;
+ return log1p(t + sqrt(2.0*t+t*t));
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_acoshf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+one = 1.0,
+ln2 = 6.9314718246e-01; /* 0x3f317218 */
+
+float acoshf(float x)
+{
+ float t;
+ int32_t hx;
+
+ GET_FLOAT_WORD(hx, x);
+ if (hx < 0x3f800000) { /* x < 1 */
+ return (x-x)/(x-x);
+ } else if (hx >= 0x4d800000) { /* x > 2**28 */
+ if (hx >= 0x7f800000) /* x is inf of NaN */
+ return x + x;
+ return logf(x) + ln2; /* acosh(huge)=log(2x) */
+ } else if (hx == 0x3f800000) {
+ return 0.0; /* acosh(1) = 0 */
+ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */
+ t = x*x;
+ return logf((float)2.0*x - one/(x+sqrtf(t-one)));
+ } else { /* 1 < x < 2 */
+ t = x-one;
+ return log1pf(t + sqrtf((float)2.0*t+t*t));
+ }
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_acoshl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* acoshl(x)
+ * Method :
+ * Based on
+ * acoshl(x) = logl [ x + sqrtl(x*x-1) ]
+ * we have
+ * acoshl(x) := logl(x)+ln2, if x is large; else
+ * acoshl(x) := logl(2x-1/(sqrtl(x*x-1)+x)) if x>2; else
+ * acoshl(x) := log1pl(t+sqrtl(2.0*t+t*t)); where t=x-1.
+ *
+ * Special cases:
+ * acoshl(x) is NaN with signal if x<1.
+ * acoshl(NaN) is NaN without signal.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double acoshl(long double x)
+{
+ return acosh(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double
+one = 1.0,
+ln2 = 6.931471805599453094287e-01L; /* 0x3FFE, 0xB17217F7, 0xD1CF79AC */
+
+long double acoshl(long double x)
+{
+ long double t;
+ uint32_t se,i0,i1;
+
+ GET_LDOUBLE_WORDS(se, i0, i1, x);
+ if (se < 0x3fff || se & 0x8000) { /* x < 1 */
+ return (x-x)/(x-x);
+ } else if (se >= 0x401d) { /* x > 2**30 */
+ if (se >= 0x7fff) /* x is inf or NaN */
+ return x+x;
+ return logl(x) + ln2; /* acoshl(huge) = logl(2x) */
+ } else if (((se-0x3fff)|i0|i1) == 0) {
+ return 0.0; /* acosh(1) = 0 */
+ } else if (se > 0x4000) { /* x > 2 */
+ t = x*x;
+ return logl(2.0*x - one/(x + sqrtl(t - one)));
+ }
+ /* 1 < x <= 2 */
+ t = x - one;
+ return log1pl(t + sqrtl(2.0*t + t*t));
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_acosl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * See comments in acos.c.
+ * Converted to long double by David Schultz <das@FreeBSD.ORG>.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double acosl(long double x)
+{
+ return acos(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__invtrigl.h"
+
+static const long double
+one = 1.00000000000000000000e+00;
+
+// FIXME
+//#ifdef __i386__
+/* XXX Work around the fact that gcc truncates long double constants on i386 */
+static volatile double
+pi1 = 3.14159265358979311600e+00, /* 0x1.921fb54442d18p+1 */
+pi2 = 1.22514845490862001043e-16; /* 0x1.1a80000000000p-53 */
+#define pi ((long double)pi1 + pi2)
+//#else
+#if 0
+static const long double
+pi = 3.14159265358979323846264338327950280e+00L;
+#endif
+
+long double acosl(long double x)
+{
+ union IEEEl2bits u;
+ long double z, p, q, r, w, s, c, df;
+ int16_t expsign, expt;
+ u.e = x;
+ expsign = u.xbits.expsign;
+ expt = expsign & 0x7fff;
+ if (expt >= BIAS) { /* |x| >= 1 */
+ if (expt == BIAS &&
+ ((u.bits.manh & ~LDBL_NBIT) | u.bits.manl) == 0) {
+ if (expsign > 0)
+ return 0.0; /* acos(1) = 0 */
+ else
+ return pi + 2.0 * pio2_lo; /* acos(-1)= pi */
+ }
+ return (x - x) / (x - x); /* acos(|x|>1) is NaN */
+ }
+ if (expt < BIAS - 1) { /* |x| < 0.5 */
+ if (expt < ACOS_CONST)
+ return pio2_hi + pio2_lo; /* x tiny: acosl=pi/2 */
+ z = x * x;
+ p = P(z);
+ q = Q(z);
+ r = p / q;
+ return pio2_hi - (x - (pio2_lo - x * r));
+ } else if (expsign < 0) { /* x < -0.5 */
+ z = (one + x) * 0.5;
+ p = P(z);
+ q = Q(z);
+ s = sqrtl(z);
+ r = p / q;
+ w = r * s - pio2_lo;
+ return pi - 2.0 * (s + w);
+ } else { /* x > 0.5 */
+ z = (one - x) * 0.5;
+ s = sqrtl(z);
+ u.e = s;
+ u.bits.manl = 0;
+ df = u.e;
+ c = (z - df * df) / (s + df);
+ p = P(z);
+ q = Q(z);
+ r = p / q;
+ w = r * s + c;
+ return 2.0 * (df + w);
+ }
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_asin.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* asin(x)
+ * Method :
+ * Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ...
+ * we approximate asin(x) on [0,0.5] by
+ * asin(x) = x + x*x^2*R(x^2)
+ * where
+ * R(x^2) is a rational approximation of (asin(x)-x)/x^3
+ * and its remez error is bounded by
+ * |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75)
+ *
+ * For x in [0.5,1]
+ * asin(x) = pi/2-2*asin(sqrt((1-x)/2))
+ * Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2;
+ * then for x>0.98
+ * asin(x) = pi/2 - 2*(s+s*z*R(z))
+ * = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo)
+ * For x<=0.98, let pio4_hi = pio2_hi/2, then
+ * f = hi part of s;
+ * c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z)
+ * and
+ * asin(x) = pi/2 - 2*(s+s*z*R(z))
+ * = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo)
+ * = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c))
+ *
+ * Special cases:
+ * if x is NaN, return x itself;
+ * if |x|>1, return NaN with invalid signal.
+ *
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+huge = 1.000e+300,
+pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
+pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
+pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */
+/* coefficients for R(x^2) */
+pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
+pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
+pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
+pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
+pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
+pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
+qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
+qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
+qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
+qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
+
+double asin(double x)
+{
+ double t=0.0,w,p,q,c,r,s;
+ int32_t hx,ix;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x3ff00000) { /* |x|>= 1 */
+ uint32_t lx;
+
+ GET_LOW_WORD(lx, x);
+ if ((ix-0x3ff00000 | lx) == 0)
+ /* asin(1) = +-pi/2 with inexact */
+ return x*pio2_hi + x*pio2_lo;
+ return (x-x)/(x-x); /* asin(|x|>1) is NaN */
+ } else if (ix < 0x3fe00000) { /* |x|<0.5 */
+ if (ix < 0x3e500000) { /* if |x| < 2**-26 */
+ if (huge+x > one)
+ return x; /* return x with inexact if x!=0*/
+ }
+ t = x*x;
+ p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
+ q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
+ w = p/q;
+ return x + x*w;
+ }
+ /* 1 > |x| >= 0.5 */
+ w = one - fabs(x);
+ t = w*0.5;
+ p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
+ q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
+ s = sqrt(t);
+ if (ix >= 0x3FEF3333) { /* if |x| > 0.975 */
+ w = p/q;
+ t = pio2_hi-(2.0*(s+s*w)-pio2_lo);
+ } else {
+ w = s;
+ SET_LOW_WORD(w,0);
+ c = (t-w*w)/(s+w);
+ r = p/q;
+ p = 2.0*s*r-(pio2_lo-2.0*c);
+ q = pio4_hi - 2.0*w;
+ t = pio4_hi - (p-q);
+ }
+ if (hx > 0)
+ return t;
+ return -t;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_asinf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+one = 1.0000000000e+00, /* 0x3F800000 */
+huge = 1.000e+30,
+/* coefficients for R(x^2) */
+pS0 = 1.6666586697e-01,
+pS1 = -4.2743422091e-02,
+pS2 = -8.6563630030e-03,
+qS1 = -7.0662963390e-01;
+
+static const double
+pio2 = 1.570796326794896558e+00;
+
+float asinf(float x)
+{
+ double s;
+ float t,w,p,q;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x3f800000) { /* |x| >= 1 */
+ if (ix == 0x3f800000) /* |x| == 1 */
+ return x*pio2; /* asin(+-1) = +-pi/2 with inexact */
+ return (x-x)/(x-x); /* asin(|x|>1) is NaN */
+ } else if (ix < 0x3f000000) { /* |x|<0.5 */
+ if (ix < 0x39800000) { /* |x| < 2**-12 */
+ if (huge+x > one)
+ return x; /* return x with inexact if x!=0 */
+ }
+ t = x*x;
+ p = t*(pS0+t*(pS1+t*pS2));
+ q = one+t*qS1;
+ w = p/q;
+ return x + x*w;
+ }
+ /* 1 > |x| >= 0.5 */
+ w = one - fabsf(x);
+ t = w*(float)0.5;
+ p = t*(pS0+t*(pS1+t*pS2));
+ q = one+t*qS1;
+ s = sqrt(t);
+ w = p/q;
+ t = pio2-2.0*(s+s*w);
+ if (hx > 0)
+ return t;
+ return -t;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_asinh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* asinh(x)
+ * Method :
+ * Based on
+ * asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ]
+ * we have
+ * asinh(x) := x if 1+x*x=1,
+ * := sign(x)*(log(x)+ln2)) for large |x|, else
+ * := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else
+ * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2)))
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
+huge= 1.00000000000000000000e+300;
+
+double asinh(double x)
+{
+ double t,w;
+ int32_t hx,ix;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7ff00000) /* x is inf or NaN */
+ return x+x;
+ if (ix < 0x3e300000) { /* |x| < 2**-28 */
+ /* return x inexact except 0 */
+ if (huge+x > one)
+ return x;
+ }
+ if (ix > 0x41b00000) { /* |x| > 2**28 */
+ w = log(fabs(x)) + ln2;
+ } else if (ix > 0x40000000) { /* 2**28 > |x| > 2.0 */
+ t = fabs(x);
+ w = log(2.0*t + one/(sqrt(x*x+one)+t));
+ } else { /* 2.0 > |x| > 2**-28 */
+ t = x*x;
+ w =log1p(fabs(x) + t/(one+sqrt(one+t)));
+ }
+ if (hx > 0)
+ return w;
+ return -w;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_asinhf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+one = 1.0000000000e+00, /* 0x3F800000 */
+ln2 = 6.9314718246e-01, /* 0x3f317218 */
+huge= 1.0000000000e+30;
+
+float asinhf(float x)
+{
+ float t,w;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7f800000) /* x is inf or NaN */
+ return x+x;
+ if (ix < 0x31800000) { /* |x| < 2**-28 */
+ /* return x inexact except 0 */
+ if (huge+x > one)
+ return x;
+ }
+ if (ix > 0x4d800000) { /* |x| > 2**28 */
+ w = logf(fabsf(x)) + ln2;
+ } else if (ix > 0x40000000) { /* 2**28 > |x| > 2.0 */
+ t = fabsf(x);
+ w = logf((float)2.0*t + one/(sqrtf(x*x+one)+t));
+ } else { /* 2.0 > |x| > 2**-28 */
+ t = x*x;
+ w =log1pf(fabsf(x) + t/(one+sqrtf(one+t)));
+ }
+ if (hx > 0)
+ return w;
+ return -w;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/s_asinhl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* asinhl(x)
+ * Method :
+ * Based on
+ * asinhl(x) = signl(x) * logl [ |x| + sqrtl(x*x+1) ]
+ * we have
+ * asinhl(x) := x if 1+x*x=1,
+ * := signl(x)*(logl(x)+ln2)) for large |x|, else
+ * := signl(x)*logl(2|x|+1/(|x|+sqrtl(x*x+1))) if|x|>2, else
+ * := signl(x)*log1pl(|x| + x^2/(1 + sqrtl(1+x^2)))
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double asinhl(long double x)
+{
+ return asinh(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double
+one = 1.000000000000000000000e+00L, /* 0x3FFF, 0x00000000, 0x00000000 */
+ln2 = 6.931471805599453094287e-01L, /* 0x3FFE, 0xB17217F7, 0xD1CF79AC */
+huge = 1.000000000000000000e+4900L;
+
+long double asinhl(long double x)
+{
+ long double t,w;
+ int32_t hx,ix;
+
+ GET_LDOUBLE_EXP(hx, x);
+ ix = hx & 0x7fff;
+ if (ix == 0x7fff)
+ return x + x; /* x is inf or NaN */
+ if (ix < 0x3fde) { /* |x| < 2**-34 */
+ /* return x, raise inexact if x != 0 */
+ if (huge+x > one)
+ return x;
+ }
+ if (ix > 0x4020) { /* |x| > 2**34 */
+ w = logl(fabsl(x)) + ln2;
+ } else if (ix > 0x4000) { /* 2**34 > |x| > 2.0 */
+ t = fabsl(x);
+ w = logl(2.0*t + one/(sqrtl(x*x + one) + t));
+ } else { /* 2.0 > |x| > 2**-28 */
+ t = x*x;
+ w =log1pl(fabsl(x) + t/(one + sqrtl(one + t)));
+ }
+ if (hx & 0x8000)
+ return -w;
+ return w;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_asinl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * See comments in asin.c.
+ * Converted to long double by David Schultz <das@FreeBSD.ORG>.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double asinl(long double x)
+{
+ return asin(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__invtrigl.h"
+static const long double
+one = 1.00000000000000000000e+00,
+huge = 1.000e+300;
+
+long double asinl(long double x)
+{
+ union IEEEl2bits u;
+ long double t=0.0,w,p,q,c,r,s;
+ int16_t expsign, expt;
+
+ u.e = x;
+ expsign = u.xbits.expsign;
+ expt = expsign & 0x7fff;
+ if (expt >= BIAS) { /* |x|>= 1 */
+ if (expt == BIAS &&
+ ((u.bits.manh&~LDBL_NBIT)|u.bits.manl) == 0)
+ /* asin(1)=+-pi/2 with inexact */
+ return x*pio2_hi + x*pio2_lo;
+ return (x-x)/(x-x); /* asin(|x|>1) is NaN */
+ } else if (expt < BIAS-1) { /* |x|<0.5 */
+ if (expt < ASIN_LINEAR) { /* if |x| is small, asinl(x)=x */
+ /* return x with inexact if x!=0 */
+ if (huge+x > one)
+ return x;
+ }
+ t = x*x;
+ p = P(t);
+ q = Q(t);
+ w = p/q;
+ return x + x*w;
+ }
+ /* 1 > |x| >= 0.5 */
+ w = one - fabsl(x);
+ t = w*0.5;
+ p = P(t);
+ q = Q(t);
+ s = sqrtl(t);
+ if (u.bits.manh >= THRESH) { /* if |x| is close to 1 */
+ w = p/q;
+ t = pio2_hi-(2.0*(s+s*w)-pio2_lo);
+ } else {
+ u.e = s;
+ u.bits.manl = 0;
+ w = u.e;
+ c = (t-w*w)/(s+w);
+ r = p/q;
+ p = 2.0*s*r-(pio2_lo-2.0*c);
+ q = pio4_hi-2.0*w;
+ t = pio4_hi-(p-q);
+ }
+ if (expsign > 0)
+ return t;
+ return -t;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_atan.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* atan(x)
+ * Method
+ * 1. Reduce x to positive by atan(x) = -atan(-x).
+ * 2. According to the integer k=4t+0.25 chopped, t=x, the argument
+ * is further reduced to one of the following intervals and the
+ * arctangent of t is evaluated by the corresponding formula:
+ *
+ * [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
+ * [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) )
+ * [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) )
+ * [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) )
+ * [39/16,INF] atan(x) = atan(INF) + atan( -1/t )
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+
+#include "libm.h"
+
+static const double atanhi[] = {
+ 4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */
+ 7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */
+ 9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */
+ 1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */
+};
+
+static const double atanlo[] = {
+ 2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */
+ 3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */
+ 1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */
+ 6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */
+};
+
+static const double aT[] = {
+ 3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */
+ -1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */
+ 1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */
+ -1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */
+ 9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */
+ -7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */
+ 6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */
+ -5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */
+ 4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */
+ -3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */
+ 1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */
+};
+
+static const double
+one = 1.0,
+huge = 1.0e300;
+
+double atan(double x)
+{
+ double w,s1,s2,z;
+ int32_t ix,hx,id;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x44100000) { /* if |x| >= 2^66 */
+ uint32_t low;
+
+ GET_LOW_WORD(low, x);
+ if (ix > 0x7ff00000 ||
+ (ix == 0x7ff00000 && low != 0)) /* NaN */
+ return x+x;
+ if (hx > 0)
+ return atanhi[3] + *(volatile double *)&atanlo[3];
+ else
+ return -atanhi[3] - *(volatile double *)&atanlo[3];
+ }
+ if (ix < 0x3fdc0000) { /* |x| < 0.4375 */
+ if (ix < 0x3e400000) { /* |x| < 2^-27 */
+ /* raise inexact */
+ if (huge+x > one)
+ return x;
+ }
+ id = -1;
+ } else {
+ x = fabs(x);
+ if (ix < 0x3ff30000) { /* |x| < 1.1875 */
+ if (ix < 0x3fe60000) { /* 7/16 <= |x| < 11/16 */
+ id = 0;
+ x = (2.0*x-one)/(2.0+x);
+ } else { /* 11/16 <= |x| < 19/16 */
+ id = 1;
+ x = (x-one)/(x+one);
+ }
+ } else {
+ if (ix < 0x40038000) { /* |x| < 2.4375 */
+ id = 2;
+ x = (x-1.5)/(one+1.5*x);
+ } else { /* 2.4375 <= |x| < 2^66 */
+ id = 3;
+ x = -1.0/x;
+ }
+ }
+ }
+ /* end of argument reduction */
+ z = x*x;
+ w = z*z;
+ /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */
+ s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10])))));
+ s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9]))));
+ if (id < 0)
+ return x - x*(s1+s2);
+ z = atanhi[id] - (x*(s1+s2) - atanlo[id] - x);
+ return hx < 0 ? -z : z;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_atan2.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+/* atan2(y,x)
+ * Method :
+ * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
+ * 2. Reduce x to positive by (if x and y are unexceptional):
+ * ARG (x+iy) = arctan(y/x) ... if x > 0,
+ * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
+ *
+ * Special cases:
+ *
+ * ATAN2((anything), NaN ) is NaN;
+ * ATAN2(NAN , (anything) ) is NaN;
+ * ATAN2(+-0, +(anything but NaN)) is +-0 ;
+ * ATAN2(+-0, -(anything but NaN)) is +-pi ;
+ * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2;
+ * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ;
+ * ATAN2(+-(anything but INF and NaN), -INF) is +-pi;
+ * ATAN2(+-INF,+INF ) is +-pi/4 ;
+ * ATAN2(+-INF,-INF ) is +-3pi/4;
+ * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2;
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "libm.h"
+
+static volatile double
+tiny = 1.0e-300;
+static const double
+zero = 0.0,
+pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */
+pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */
+pi = 3.1415926535897931160E+00; /* 0x400921FB, 0x54442D18 */
+static volatile double
+pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */
+
+double atan2(double y, double x)
+{
+ double z;
+ int32_t k,m,hx,hy,ix,iy;
+ uint32_t lx,ly;
+
+ EXTRACT_WORDS(hx, lx, x);
+ ix = hx & 0x7fffffff;
+ EXTRACT_WORDS(hy, ly, y);
+ iy = hy & 0x7fffffff;
+ if ((ix|((lx|-lx)>>31)) > 0x7ff00000 ||
+ (iy|((ly|-ly)>>31)) > 0x7ff00000) /* x or y is NaN */
+ return x+y;
+ if ((hx-0x3ff00000 | lx) == 0) /* x = 1.0 */
+ return atan(y);
+ m = ((hy>>31)&1) | ((hx>>30)&2); /* 2*sign(x)+sign(y) */
+
+ /* when y = 0 */
+ if ((iy|ly) == 0) {
+ switch(m) {
+ case 0:
+ case 1: return y; /* atan(+-0,+anything)=+-0 */
+ case 2: return pi+tiny; /* atan(+0,-anything) = pi */
+ case 3: return -pi-tiny; /* atan(-0,-anything) =-pi */
+ }
+ }
+ /* when x = 0 */
+ if ((ix|lx) == 0)
+ return hy < 0 ? -pi_o_2-tiny : pi_o_2+tiny;
+ /* when x is INF */
+ if (ix == 0x7ff00000) {
+ if (iy == 0x7ff00000) {
+ switch(m) {
+ case 0: return pi_o_4+tiny; /* atan(+INF,+INF) */
+ case 1: return -pi_o_4-tiny; /* atan(-INF,+INF) */
+ case 2: return 3.0*pi_o_4+tiny; /* atan(+INF,-INF) */
+ case 3: return -3.0*pi_o_4-tiny; /* atan(-INF,-INF) */
+ }
+ } else {
+ switch(m) {
+ case 0: return zero; /* atan(+...,+INF) */
+ case 1: return -zero; /* atan(-...,+INF) */
+ case 2: return pi+tiny; /* atan(+...,-INF) */
+ case 3: return -pi-tiny; /* atan(-...,-INF) */
+ }
+ }
+ }
+ /* when y is INF */
+ if (iy == 0x7ff00000)
+ return hy < 0 ? -pi_o_2-tiny : pi_o_2+tiny;
+
+ /* compute y/x */
+ k = (iy-ix)>>20;
+ if (k > 60) { /* |y/x| > 2**60 */
+ z = pi_o_2+0.5*pi_lo;
+ m &= 1;
+ } else if (hx < 0 && k < -60) /* 0 > |y|/x > -2**-60 */
+ z = 0.0;
+ else /* safe to do y/x */
+ z = atan(fabs(y/x));
+ switch (m) {
+ case 0: return z; /* atan(+,+) */
+ case 1: return -z; /* atan(-,+) */
+ case 2: return pi - (z-pi_lo); /* atan(+,-) */
+ default: /* case 3 */
+ return (z-pi_lo) - pi; /* atan(-,-) */
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_atan2f.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static volatile float
+tiny = 1.0e-30;
+static const float
+zero = 0.0,
+pi_o_4 = 7.8539818525e-01, /* 0x3f490fdb */
+pi_o_2 = 1.5707963705e+00, /* 0x3fc90fdb */
+pi = 3.1415927410e+00; /* 0x40490fdb */
+static volatile float
+pi_lo = -8.7422776573e-08; /* 0xb3bbbd2e */
+
+float atan2f(float y, float x)
+{
+ float z;
+ int32_t k,m,hx,hy,ix,iy;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ GET_FLOAT_WORD(hy, y);
+ iy = hy & 0x7fffffff;
+ if (ix > 0x7f800000 || iy > 0x7f800000) /* x or y is NaN */
+ return x+y;
+ if (hx == 0x3f800000) /* x=1.0 */
+ return atanf(y);
+ m = ((hy>>31)&1) | ((hx>>30)&2); /* 2*sign(x)+sign(y) */
+
+ /* when y = 0 */
+ if (iy == 0) {
+ switch (m) {
+ case 0:
+ case 1: return y; /* atan(+-0,+anything)=+-0 */
+ case 2: return pi+tiny; /* atan(+0,-anything) = pi */
+ case 3: return -pi-tiny; /* atan(-0,-anything) =-pi */
+ }
+ }
+ /* when x = 0 */
+ if (ix == 0)
+ return hy < 0 ? -pi_o_2-tiny : pi_o_2+tiny;
+ /* when x is INF */
+ if (ix == 0x7f800000) {
+ if (iy == 0x7f800000) {
+ switch (m) {
+ case 0: return pi_o_4+tiny; /* atan(+INF,+INF) */
+ case 1: return -pi_o_4-tiny; /* atan(-INF,+INF) */
+ case 2: return (float)3.0*pi_o_4+tiny; /*atan(+INF,-INF)*/
+ case 3: return (float)-3.0*pi_o_4-tiny; /*atan(-INF,-INF)*/
+ }
+ } else {
+ switch (m) {
+ case 0: return zero; /* atan(+...,+INF) */
+ case 1: return -zero; /* atan(-...,+INF) */
+ case 2: return pi+tiny; /* atan(+...,-INF) */
+ case 3: return -pi-tiny; /* atan(-...,-INF) */
+ }
+ }
+ }
+ /* when y is INF */
+ if (iy == 0x7f800000)
+ return hy < 0 ? -pi_o_2-tiny : pi_o_2+tiny;
+
+ /* compute y/x */
+ k = (iy-ix)>>23;
+ if (k > 26) { /* |y/x| > 2**26 */
+ z = pi_o_2+(float)0.5*pi_lo;
+ m &= 1;
+ } else if (k < -26 && hx < 0) /* 0 > |y|/x > -2**-26 */
+ z = 0.0;
+ else /* safe to do y/x */
+ z = atanf(fabsf(y/x));
+ switch (m) {
+ case 0: return z; /* atan(+,+) */
+ case 1: return -z; /* atan(-,+) */
+ case 2: return pi - (z-pi_lo); /* atan(+,-) */
+ default: /* case 3 */
+ return (z-pi_lo) - pi; /* atan(-,-) */
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_atan2l.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+/*
+ * See comments in atan2.c.
+ * Converted to long double by David Schultz <das@FreeBSD.ORG>.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double atan2l(long double y, long double x)
+{
+ return atan2(y, x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__invtrigl.h"
+static volatile long double
+tiny = 1.0e-300;
+static const long double
+zero = 0.0;
+/* XXX Work around the fact that gcc truncates long double constants on i386 */
+static volatile double
+pi1 = 3.14159265358979311600e+00, /* 0x1.921fb54442d18p+1 */
+pi2 = 1.22514845490862001043e-16; /* 0x1.1a80000000000p-53 */
+#define pi ((long double)pi1 + pi2)
+#if 0
+static const long double
+pi = 3.14159265358979323846264338327950280e+00L;
+#endif
+
+long double atan2l(long double y, long double x)
+{
+ union IEEEl2bits ux, uy;
+ long double z;
+ int32_t k,m;
+ int16_t exptx, expsignx, expty, expsigny;
+
+ uy.e = y;
+ expsigny = uy.xbits.expsign;
+ expty = expsigny & 0x7fff;
+ ux.e = x;
+ expsignx = ux.xbits.expsign;
+ exptx = expsignx & 0x7fff;
+ if ((exptx==BIAS+LDBL_MAX_EXP &&
+ ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl)!=0) || /* x is NaN */
+ (expty==BIAS+LDBL_MAX_EXP &&
+ ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)!=0)) /* y is NaN */
+ return x+y;
+ if (expsignx==BIAS && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl)==0) /* x=1.0 */
+ return atanl(y);
+ m = ((expsigny>>15)&1) | ((expsignx>>14)&2); /* 2*sign(x)+sign(y) */
+
+ /* when y = 0 */
+ if (expty==0 && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)==0) {
+ switch(m) {
+ case 0:
+ case 1: return y; /* atan(+-0,+anything)=+-0 */
+ case 2: return pi+tiny; /* atan(+0,-anything) = pi */
+ case 3: return -pi-tiny; /* atan(-0,-anything) =-pi */
+ }
+ }
+ /* when x = 0 */
+ if (exptx==0 && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl)==0)
+ return expsigny < 0 ? -pio2_hi-tiny : pio2_hi+tiny;
+ /* when x is INF */
+ if (exptx == BIAS+LDBL_MAX_EXP) {
+ if (expty == BIAS+LDBL_MAX_EXP) {
+ switch(m) {
+ case 0: return pio2_hi*0.5+tiny; /* atan(+INF,+INF) */
+ case 1: return -pio2_hi*0.5-tiny; /* atan(-INF,+INF) */
+ case 2: return 1.5*pio2_hi+tiny; /*atan(+INF,-INF)*/
+ case 3: return -1.5*pio2_hi-tiny; /*atan(-INF,-INF)*/
+ }
+ } else {
+ switch(m) {
+ case 0: return zero; /* atan(+...,+INF) */
+ case 1: return -zero; /* atan(-...,+INF) */
+ case 2: return pi+tiny; /* atan(+...,-INF) */
+ case 3: return -pi-tiny; /* atan(-...,-INF) */
+ }
+ }
+ }
+ /* when y is INF */
+ if (expty == BIAS+LDBL_MAX_EXP)
+ return expsigny < 0 ? -pio2_hi-tiny : pio2_hi+tiny;
+
+ /* compute y/x */
+ k = expty-exptx;
+ if(k > LDBL_MANT_DIG+2) { /* |y/x| huge */
+ z = pio2_hi+pio2_lo;
+ m &= 1;
+ } else if (expsignx < 0 && k < -LDBL_MANT_DIG-2) /* |y/x| tiny, x<0 */
+ z = 0.0;
+ else /* safe to do y/x */
+ z = atanl(fabsl(y/x));
+ switch (m) {
+ case 0: return z; /* atan(+,+) */
+ case 1: return -z; /* atan(-,+) */
+ case 2: return pi - (z-pi_lo); /* atan(+,-) */
+ default: /* case 3 */
+ return (z-pi_lo) - pi; /* atan(-,-) */
+ }
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_atanf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+
+#include "libm.h"
+
+static const float atanhi[] = {
+ 4.6364760399e-01, /* atan(0.5)hi 0x3eed6338 */
+ 7.8539812565e-01, /* atan(1.0)hi 0x3f490fda */
+ 9.8279368877e-01, /* atan(1.5)hi 0x3f7b985e */
+ 1.5707962513e+00, /* atan(inf)hi 0x3fc90fda */
+};
+
+static const float atanlo[] = {
+ 5.0121582440e-09, /* atan(0.5)lo 0x31ac3769 */
+ 3.7748947079e-08, /* atan(1.0)lo 0x33222168 */
+ 3.4473217170e-08, /* atan(1.5)lo 0x33140fb4 */
+ 7.5497894159e-08, /* atan(inf)lo 0x33a22168 */
+};
+
+static const float aT[] = {
+ 3.3333328366e-01,
+ -1.9999158382e-01,
+ 1.4253635705e-01,
+ -1.0648017377e-01,
+ 6.1687607318e-02,
+};
+
+static const float
+one = 1.0,
+huge = 1.0e30;
+
+float atanf(float x)
+{
+ float w,s1,s2,z;
+ int32_t ix,hx,id;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x4c800000) { /* if |x| >= 2**26 */
+ if (ix > 0x7f800000) /* NaN */
+ return x+x;
+ if (hx > 0)
+ return atanhi[3] + *(volatile float *)&atanlo[3];
+ else
+ return -atanhi[3] - *(volatile float *)&atanlo[3];
+ }
+ if (ix < 0x3ee00000) { /* |x| < 0.4375 */
+ if (ix < 0x39800000) { /* |x| < 2**-12 */
+ /* raise inexact */
+ if(huge+x>one)
+ return x;
+ }
+ id = -1;
+ } else {
+ x = fabsf(x);
+ if (ix < 0x3f980000) { /* |x| < 1.1875 */
+ if (ix < 0x3f300000) { /* 7/16 <= |x| < 11/16 */
+ id = 0;
+ x = ((float)2.0*x-one)/((float)2.0+x);
+ } else { /* 11/16 <= |x| < 19/16 */
+ id = 1;
+ x = (x-one)/(x+one);
+ }
+ } else {
+ if (ix < 0x401c0000) { /* |x| < 2.4375 */
+ id = 2;
+ x = (x-(float)1.5)/(one+(float)1.5*x);
+ } else { /* 2.4375 <= |x| < 2**26 */
+ id = 3;
+ x = -(float)1.0/x;
+ }
+ }
+ }
+ /* end of argument reduction */
+ z = x*x;
+ w = z*z;
+ /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */
+ s1 = z*(aT[0]+w*(aT[2]+w*aT[4]));
+ s2 = w*(aT[1]+w*aT[3]);
+ if (id < 0)
+ return x - x*(s1+s2);
+ z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x);
+ return hx < 0 ? -z : z;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_atanh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+/* atanh(x)
+ * Method :
+ * 1.Reduced x to positive by atanh(-x) = -atanh(x)
+ * 2.For x>=0.5
+ * 1 2x x
+ * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
+ * 2 1 - x 1 - x
+ *
+ * For x<0.5
+ * atanh(x) = 0.5*log1p(2x+2x*x/(1-x))
+ *
+ * Special cases:
+ * atanh(x) is NaN if |x| > 1 with signal;
+ * atanh(NaN) is that NaN with no signal;
+ * atanh(+-1) is +-INF with signal.
+ *
+ */
+
+#include "libm.h"
+
+static const double one = 1.0, huge = 1e300;
+static const double zero = 0.0;
+
+double atanh(double x)
+{
+ double t;
+ int32_t hx,ix;
+ uint32_t lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+ ix = hx & 0x7fffffff;
+ if ((ix | ((lx|-lx)>>31)) > 0x3ff00000) /* |x| > 1 */
+ return (x-x)/(x-x);
+ if (ix == 0x3ff00000)
+ return x/zero;
+ if (ix < 0x3e300000 && (huge+x) > zero) /* x < 2**-28 */
+ return x;
+ SET_HIGH_WORD(x, ix);
+ if (ix < 0x3fe00000) { /* x < 0.5 */
+ t = x+x;
+ t = 0.5*log1p(t + t*x/(one-x));
+ } else
+ t = 0.5*log1p((x+x)/(one-x));
+ if (hx >= 0)
+ return t;
+ return -t;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_atanhf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float one = 1.0, huge = 1e30;
+static const float zero = 0.0;
+
+float atanhf(float x)
+{
+ float t;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix > 0x3f800000) /* |x| > 1 */
+ return (x-x)/(x-x);
+ if (ix == 0x3f800000)
+ return x/zero;
+ if (ix < 0x31800000 && huge+x > zero) /* x < 2**-28 */
+ return x;
+ SET_FLOAT_WORD(x, ix);
+ if (ix < 0x3f000000) { /* x < 0.5 */
+ t = x+x;
+ t = (float)0.5*log1pf(t + t*x/(one-x));
+ } else
+ t = (float)0.5*log1pf((x+x)/(one-x));
+ if (hx >= 0)
+ return t;
+ return -t;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_atanh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* atanhl(x)
+ * Method :
+ * 1.Reduced x to positive by atanh(-x) = -atanh(x)
+ * 2.For x>=0.5
+ * 1 2x x
+ * atanhl(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
+ * 2 1 - x 1 - x
+ *
+ * For x<0.5
+ * atanhl(x) = 0.5*log1pl(2x+2x*x/(1-x))
+ *
+ * Special cases:
+ * atanhl(x) is NaN if |x| > 1 with signal;
+ * atanhl(NaN) is that NaN with no signal;
+ * atanhl(+-1) is +-INF with signal.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double atanhl(long double x)
+{
+ return atanh(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double zero = 0.0, one = 1.0, huge = 1e4900L;
+
+long double atanhl(long double x)
+{
+ long double t;
+ int32_t ix;
+ uint32_t se,i0,i1;
+
+ GET_LDOUBLE_WORDS(se, i0, i1, x);
+ ix = se & 0x7fff;
+ if ((ix+((((i0&0x7fffffff)|i1)|(-((i0&0x7fffffff)|i1)))>>31)) > 0x3fff)
+ /* |x| > 1 */
+ return (x-x)/(x-x);
+ if (ix == 0x3fff)
+ return x/zero;
+ if (ix < 0x3fe3 && huge+x > zero) /* x < 2**-28 */
+ return x;
+ SET_LDOUBLE_EXP(x, ix);
+ if (ix < 0x3ffe) { /* x < 0.5 */
+ t = x + x;
+ t = 0.5*log1pl(t + t*x/(one-x));
+ } else
+ t = 0.5*log1pl((x + x)/(one - x));
+ if (se <= 0x7fff)
+ return t;
+ return -t;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_atanl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * See comments in atan.c.
+ * Converted to long double by David Schultz <das@FreeBSD.ORG>.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double atanl(long double x)
+{
+ return atan(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__invtrigl.h"
+static const long double
+one = 1.0,
+huge = 1.0e300;
+
+long double atanl(long double x)
+{
+ union IEEEl2bits u;
+ long double w,s1,s2,z;
+ int id;
+ int16_t expsign, expt;
+ int32_t expman;
+
+ u.e = x;
+ expsign = u.xbits.expsign;
+ expt = expsign & 0x7fff;
+ if (expt >= ATAN_CONST) { /* if |x| is large, atan(x)~=pi/2 */
+ if (expt == BIAS + LDBL_MAX_EXP &&
+ ((u.bits.manh&~LDBL_NBIT)|u.bits.manl)!=0) /* NaN */
+ return x+x;
+ if (expsign > 0)
+ return atanhi[3]+atanlo[3];
+ else
+ return -atanhi[3]-atanlo[3];
+ }
+ /* Extract the exponent and the first few bits of the mantissa. */
+ /* XXX There should be a more convenient way to do this. */
+ expman = (expt << 8) | ((u.bits.manh >> (MANH_SIZE - 9)) & 0xff);
+ if (expman < ((BIAS - 2) << 8) + 0xc0) { /* |x| < 0.4375 */
+ if (expt < ATAN_LINEAR) { /* if |x| is small, atanl(x)~=x */
+ /* raise inexact */
+ if (huge+x > one)
+ return x;
+ }
+ id = -1;
+ } else {
+ x = fabsl(x);
+ if (expman < (BIAS << 8) + 0x30) { /* |x| < 1.1875 */
+ if (expman < ((BIAS - 1) << 8) + 0x60) { /* 7/16 <= |x| < 11/16 */
+ id = 0;
+ x = (2.0*x-one)/(2.0+x);
+ } else { /* 11/16 <= |x| < 19/16 */
+ id = 1;
+ x = (x-one)/(x+one);
+ }
+ } else {
+ if (expman < ((BIAS + 1) << 8) + 0x38) { /* |x| < 2.4375 */
+ id = 2;
+ x = (x-1.5)/(one+1.5*x);
+ } else { /* 2.4375 <= |x| < 2^ATAN_CONST */
+ id = 3;
+ x = -1.0/x;
+ }
+ }
+ }
+ /* end of argument reduction */
+ z = x*x;
+ w = z*z;
+ /* break sum aT[i]z**(i+1) into odd and even poly */
+ s1 = z*T_even(w);
+ s2 = w*T_odd(w);
+ if (id < 0)
+ return x - x*(s1+s2);
+ z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x);
+ return expsign < 0 ? -z : z;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cbrt.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ * Optimized by Bruce D. Evans.
+ */
+/* cbrt(x)
+ * Return cube root of x
+ */
+
+#include "libm.h"
+
+static const uint32_t
+B1 = 715094163, /* B1 = (1023-1023/3-0.03306235651)*2**20 */
+B2 = 696219795; /* B2 = (1023-1023/3-54/3-0.03306235651)*2**20 */
+
+/* |1/cbrt(x) - p(x)| < 2**-23.5 (~[-7.93e-8, 7.929e-8]). */
+static const double
+P0 = 1.87595182427177009643, /* 0x3ffe03e6, 0x0f61e692 */
+P1 = -1.88497979543377169875, /* 0xbffe28e0, 0x92f02420 */
+P2 = 1.621429720105354466140, /* 0x3ff9f160, 0x4a49d6c2 */
+P3 = -0.758397934778766047437, /* 0xbfe844cb, 0xbee751d9 */
+P4 = 0.145996192886612446982; /* 0x3fc2b000, 0xd4e4edd7 */
+
+double cbrt(double x)
+{
+ int32_t hx;
+ union dshape u;
+ double r,s,t=0.0,w;
+ uint32_t sign;
+ uint32_t high,low;
+
+ EXTRACT_WORDS(hx, low, x);
+ sign = hx & 0x80000000;
+ hx ^= sign;
+ if (hx >= 0x7ff00000) /* cbrt(NaN,INF) is itself */
+ return x+x;
+
+ /*
+ * Rough cbrt to 5 bits:
+ * cbrt(2**e*(1+m) ~= 2**(e/3)*(1+(e%3+m)/3)
+ * where e is integral and >= 0, m is real and in [0, 1), and "/" and
+ * "%" are integer division and modulus with rounding towards minus
+ * infinity. The RHS is always >= the LHS and has a maximum relative
+ * error of about 1 in 16. Adding a bias of -0.03306235651 to the
+ * (e%3+m)/3 term reduces the error to about 1 in 32. With the IEEE
+ * floating point representation, for finite positive normal values,
+ * ordinary integer divison of the value in bits magically gives
+ * almost exactly the RHS of the above provided we first subtract the
+ * exponent bias (1023 for doubles) and later add it back. We do the
+ * subtraction virtually to keep e >= 0 so that ordinary integer
+ * division rounds towards minus infinity; this is also efficient.
+ */
+ if (hx < 0x00100000) { /* zero or subnormal? */
+ if ((hx|low) == 0)
+ return x; /* cbrt(0) is itself */
+ SET_HIGH_WORD(t, 0x43500000); /* set t = 2**54 */
+ t *= x;
+ GET_HIGH_WORD(high, t);
+ INSERT_WORDS(t, sign|((high&0x7fffffff)/3+B2), 0);
+ } else
+ INSERT_WORDS(t, sign|(hx/3+B1), 0);
+
+ /*
+ * New cbrt to 23 bits:
+ * cbrt(x) = t*cbrt(x/t**3) ~= t*P(t**3/x)
+ * where P(r) is a polynomial of degree 4 that approximates 1/cbrt(r)
+ * to within 2**-23.5 when |r - 1| < 1/10. The rough approximation
+ * has produced t such than |t/cbrt(x) - 1| ~< 1/32, and cubing this
+ * gives us bounds for r = t**3/x.
+ *
+ * Try to optimize for parallel evaluation as in k_tanf.c.
+ */
+ r = (t*t)*(t/x);
+ t = t*((P0+r*(P1+r*P2))+((r*r)*r)*(P3+r*P4));
+
+ /*
+ * Round t away from zero to 23 bits (sloppily except for ensuring that
+ * the result is larger in magnitude than cbrt(x) but not much more than
+ * 2 23-bit ulps larger). With rounding towards zero, the error bound
+ * would be ~5/6 instead of ~4/6. With a maximum error of 2 23-bit ulps
+ * in the rounded t, the infinite-precision error in the Newton
+ * approximation barely affects third digit in the final error
+ * 0.667; the error in the rounded t can be up to about 3 23-bit ulps
+ * before the final error is larger than 0.667 ulps.
+ */
+ u.value = t;
+ u.bits = (u.bits + 0x80000000) & 0xffffffffc0000000ULL;
+ t = u.value;
+
+ /* one step Newton iteration to 53 bits with error < 0.667 ulps */
+ s = t*t; /* t*t is exact */
+ r = x/s; /* error <= 0.5 ulps; |r| < |t| */
+ w = t+t; /* t+t is exact */
+ r = (r-t)/(w+r); /* r-t is exact; w+r ~= 3*t */
+ t = t+t*r; /* error <= 0.5 + 0.5/3 + epsilon */
+ return t;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cbrtf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Debugged and optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* cbrtf(x)
+ * Return cube root of x
+ */
+
+#include "libm.h"
+
+static const unsigned
+B1 = 709958130, /* B1 = (127-127.0/3-0.03306235651)*2**23 */
+B2 = 642849266; /* B2 = (127-127.0/3-24/3-0.03306235651)*2**23 */
+
+float cbrtf(float x)
+{
+ double r,T;
+ float t;
+ int32_t hx;
+ uint32_t sign;
+ uint32_t high;
+
+ GET_FLOAT_WORD(hx, x);
+ sign = hx & 0x80000000;
+ hx ^= sign;
+ if (hx >= 0x7f800000) /* cbrt(NaN,INF) is itself */
+ return x + x;
+
+ /* rough cbrt to 5 bits */
+ if (hx < 0x00800000) { /* zero or subnormal? */
+ if (hx == 0)
+ return x; /* cbrt(+-0) is itself */
+ SET_FLOAT_WORD(t, 0x4b800000); /* set t = 2**24 */
+ t *= x;
+ GET_FLOAT_WORD(high, t);
+ SET_FLOAT_WORD(t, sign|((high&0x7fffffff)/3+B2));
+ } else
+ SET_FLOAT_WORD(t, sign|(hx/3+B1));
+
+ /*
+ * First step Newton iteration (solving t*t-x/t == 0) to 16 bits. In
+ * double precision so that its terms can be arranged for efficiency
+ * without causing overflow or underflow.
+ */
+ T = t;
+ r = T*T*T;
+ T = T*((double)x+x+r)/(x+r+r);
+
+ /*
+ * Second step Newton iteration to 47 bits. In double precision for
+ * efficiency and accuracy.
+ */
+ r = T*T*T;
+ T = T*((double)x+x+r)/(x+r+r);
+
+ /* rounding to 24 bits is perfect in round-to-nearest mode */
+ return T;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cbrtl.c */
+/*-
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ * Copyright (c) 2009-2011, Bruce D. Evans, Steven G. Kargl, David Schultz.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ * The argument reduction and testing for exceptional cases was
+ * written by Steven G. Kargl with input from Bruce D. Evans
+ * and David A. Schultz.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double cbrtl(long double x)
+{
+ return cbrt(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#define BIAS (LDBL_MAX_EXP - 1)
+static const unsigned
+B1 = 709958130; /* B1 = (127-127.0/3-0.03306235651)*2**23 */
+
+long double cbrtl(long double x)
+{
+ union IEEEl2bits u, v;
+ long double r, s, t, w;
+ double dr, dt, dx;
+ float ft, fx;
+ uint32_t hx;
+ uint16_t expsign;
+ int k;
+
+ u.e = x;
+ expsign = u.xbits.expsign;
+ k = expsign & 0x7fff;
+
+ /*
+ * If x = +-Inf, then cbrt(x) = +-Inf.
+ * If x = NaN, then cbrt(x) = NaN.
+ */
+ if (k == BIAS + LDBL_MAX_EXP)
+ return x + x;
+
+// FIXME: extended precision is default on linux..
+#undef __i386__
+#ifdef __i386__
+ fp_prec_t oprec;
+
+ oprec = fpgetprec();
+ if (oprec != FP_PE)
+ fpsetprec(FP_PE);
+#endif
+
+ if (k == 0) {
+ /* If x = +-0, then cbrt(x) = +-0. */
+ if ((u.bits.manh | u.bits.manl) == 0) {
+#ifdef __i386__
+ if (oprec != FP_PE)
+ fpsetprec(oprec);
+#endif
+ return (x);
+ }
+ /* Adjust subnormal numbers. */
+ u.e *= 0x1.0p514;
+ k = u.bits.exp;
+ k -= BIAS + 514;
+ } else
+ k -= BIAS;
+ u.xbits.expsign = BIAS;
+ v.e = 1;
+
+ x = u.e;
+ switch (k % 3) {
+ case 1:
+ case -2:
+ x = 2*x;
+ k--;
+ break;
+ case 2:
+ case -1:
+ x = 4*x;
+ k -= 2;
+ break;
+ }
+ v.xbits.expsign = (expsign & 0x8000) | (BIAS + k / 3);
+
+ /*
+ * The following is the guts of s_cbrtf, with the handling of
+ * special values removed and extra care for accuracy not taken,
+ * but with most of the extra accuracy not discarded.
+ */
+
+ /* ~5-bit estimate: */
+ fx = x;
+ GET_FLOAT_WORD(hx, fx);
+ SET_FLOAT_WORD(ft, ((hx & 0x7fffffff) / 3 + B1));
+
+ /* ~16-bit estimate: */
+ dx = x;
+ dt = ft;
+ dr = dt * dt * dt;
+ dt = dt * (dx + dx + dr) / (dx + dr + dr);
+
+ /* ~47-bit estimate: */
+ dr = dt * dt * dt;
+ dt = dt * (dx + dx + dr) / (dx + dr + dr);
+
+#if LDBL_MANT_DIG == 64
+ /*
+ * dt is cbrtl(x) to ~47 bits (after x has been reduced to 1 <= x < 8).
+ * Round it away from zero to 32 bits (32 so that t*t is exact, and
+ * away from zero for technical reasons).
+ */
+ volatile double vd2 = 0x1.0p32;
+ volatile double vd1 = 0x1.0p-31;
+ #define vd ((long double)vd2 + vd1)
+
+ t = dt + vd - 0x1.0p32;
+#elif LDBL_MANT_DIG == 113
+ /*
+ * Round dt away from zero to 47 bits. Since we don't trust the 47,
+ * add 2 47-bit ulps instead of 1 to round up. Rounding is slow and
+ * might be avoidable in this case, since on most machines dt will
+ * have been evaluated in 53-bit precision and the technical reasons
+ * for rounding up might not apply to either case in cbrtl() since
+ * dt is much more accurate than needed.
+ */
+ t = dt + 0x2.0p-46 + 0x1.0p60L - 0x1.0p60;
+#else
+#error "Unsupported long double format"
+#endif
+
+ /*
+ * Final step Newton iteration to 64 or 113 bits with
+ * error < 0.667 ulps
+ */
+ s = t*t; /* t*t is exact */
+ r = x/s; /* error <= 0.5 ulps; |r| < |t| */
+ w = t+t; /* t+t is exact */
+ r = (r-t)/(w+r); /* r-t is exact; w+r ~= 3*t */
+ t = t+t*r; /* error <= 0.5 + 0.5/3 + epsilon */
+
+ t *= v.e;
+#ifdef __i386__
+ if (oprec != FP_PE)
+ fpsetprec(oprec);
+#endif
+ return t;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ceil.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * ceil(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to ceil(x).
+ */
+
+#include "libm.h"
+
+static const double huge = 1.0e300;
+
+double ceil(double x)
+{
+ int32_t i0,i1,j0;
+ uint32_t i,j;
+
+ EXTRACT_WORDS(i0, i1, x);
+ // FIXME signed shift
+ j0 = ((i0>>20)&0x7ff) - 0x3ff;
+ if (j0 < 20) {
+ if (j0 < 0) {
+ /* raise inexact if x != 0 */
+ if (huge+x > 0.0) {
+ /* return 0*sign(x) if |x|<1 */
+ if (i0 < 0) {
+ i0 = 0x80000000;
+ i1=0;
+ } else if ((i0|i1) != 0) {
+ i0=0x3ff00000;
+ i1=0;
+ }
+ }
+ } else {
+ i = (0x000fffff)>>j0;
+ if (((i0&i)|i1) == 0) /* x is integral */
+ return x;
+ /* raise inexact flag */
+ if (huge+x > 0.0) {
+ if (i0 > 0)
+ i0 += 0x00100000>>j0;
+ i0 &= ~i;
+ i1 = 0;
+ }
+ }
+ } else if (j0 > 51) {
+ if (j0 == 0x400) /* inf or NaN */
+ return x+x;
+ return x; /* x is integral */
+ } else {
+ i = (uint32_t)0xffffffff>>(j0-20);
+ if ((i1&i) == 0)
+ return x; /* x is integral */
+ /* raise inexact flag */
+ if (huge+x > 0.0) {
+ if (i0 > 0) {
+ if (j0 == 20)
+ i0 += 1;
+ else {
+ j = i1 + (1<<(52-j0));
+ if (j < i1) /* got a carry */
+ i0 += 1;
+ i1 = j;
+ }
+ }
+ i1 &= ~i;
+ }
+ }
+ INSERT_WORDS(x, i0, i1);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ceilf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float huge = 1.0e30;
+
+float ceilf(float x)
+{
+ int32_t i0,j0;
+ uint32_t i;
+
+ GET_FLOAT_WORD(i0, x);
+ j0 = ((i0>>23)&0xff) - 0x7f;
+ if (j0 < 23) {
+ if (j0 < 0) {
+ /* raise inexact if x != 0 */
+ if (huge+x > (float)0.0) {
+ /* return 0*sign(x) if |x|<1 */
+ if (i0 < 0)
+ i0 = 0x80000000;
+ else if(i0 != 0)
+ i0 = 0x3f800000;
+ }
+ } else {
+ i = 0x007fffff>>j0;
+ if ((i0&i) == 0)
+ return x; /* x is integral */
+ /* raise inexact flag */
+ if (huge+x > (float)0.0) {
+ if (i0 > 0)
+ i0 += 0x00800000>>j0;
+ i0 &= ~i;
+ }
+ }
+ } else {
+ if (j0 == 0x80) /* inf or NaN */
+ return x+x;
+ return x; /* x is integral */
+ }
+ SET_FLOAT_WORD(x, i0);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_ceill.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * ceill(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to ceill(x).
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double ceill(long double x)
+{
+ return ceil(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#ifdef LDBL_IMPLICIT_NBIT
+#define MANH_SIZE (LDBL_MANH_SIZE + 1)
+#define INC_MANH(u, c) do { \
+ uint64_t o = u.bits.manh; \
+ u.bits.manh += (c); \
+ if (u.bits.manh < o) \
+ u.bits.exp++; \
+} while (0)
+#else
+#define MANH_SIZE LDBL_MANH_SIZE
+#define INC_MANH(u, c) do { \
+ uint64_t o = u.bits.manh; \
+ u.bits.manh += (c); \
+ if (u.bits.manh < o) { \
+ u.bits.exp++; \
+ u.bits.manh |= 1llu << (LDBL_MANH_SIZE - 1); \
+ } \
+} while (0)
+#endif
+
+static const long double huge = 1.0e300;
+
+long double
+ceill(long double x)
+{
+ union IEEEl2bits u = { .e = x };
+ int e = u.bits.exp - LDBL_MAX_EXP + 1;
+
+ if (e < MANH_SIZE - 1) {
+ if (e < 0) {
+ /* raise inexact if x != 0 */
+ if (huge + x > 0.0)
+ if (u.bits.exp > 0 ||
+ (u.bits.manh | u.bits.manl) != 0)
+ u.e = u.bits.sign ? -0.0 : 1.0;
+ } else {
+ uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1);
+ if (((u.bits.manh & m) | u.bits.manl) == 0)
+ return x; /* x is integral */
+ if (!u.bits.sign) {
+#ifdef LDBL_IMPLICIT_NBIT
+ if (e == 0)
+ u.bits.exp++;
+ else
+#endif
+ INC_MANH(u, 1llu << (MANH_SIZE - e - 1));
+ }
+ /* raise inexact flag */
+ if (huge + x > 0.0) {
+ u.bits.manh &= ~m;
+ u.bits.manl = 0;
+ }
+ }
+ } else if (e < LDBL_MANT_DIG - 1) {
+ uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1);
+ if ((u.bits.manl & m) == 0)
+ return x; /* x is integral */
+ if (!u.bits.sign) {
+ if (e == MANH_SIZE - 1)
+ INC_MANH(u, 1);
+ else {
+ uint64_t o = u.bits.manl;
+ u.bits.manl += 1llu << (LDBL_MANT_DIG - e - 1);
+ if (u.bits.manl < o) /* got a carry */
+ INC_MANH(u, 1);
+ }
+ }
+ /* raise inexact flag */
+ if (huge + x > 0.0)
+ u.bits.manl &= ~m;
+ }
+ return u.e;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double copysign(double x, double y) {
+ union dshape ux, uy;
+
+ ux.value = x;
+ uy.value = y;
+ ux.bits &= (uint64_t)-1>>1;
+ ux.bits |= uy.bits & (uint64_t)1<<63;
+ return ux.value;
+}
--- /dev/null
+#include "libm.h"
+
+float copysignf(float x, float y) {
+ union fshape ux, uy;
+
+ ux.value = x;
+ uy.value = y;
+ ux.bits &= (uint32_t)-1>>1;
+ ux.bits |= uy.bits & (uint32_t)1<<31;
+ return ux.value;
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double copysignl(long double x, long double y)
+{
+ return copysign(x, y);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+long double copysignl(long double x, long double y)
+{
+ union ldshape ux = {x}, uy = {y};
+
+ ux.bits.sign = uy.bits.sign;
+ return ux.value;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cos.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* cos(x)
+ * Return cosine function of x.
+ *
+ * kernel function:
+ * __sin ... sine function on [-pi/4,pi/4]
+ * __cos ... cosine function on [-pi/4,pi/4]
+ * __rem_pio2 ... argument reduction routine
+ *
+ * Method.
+ * Let S,C and T denote the sin, cos and tan respectively on
+ * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
+ * in [-pi/4 , +pi/4], and let n = k mod 4.
+ * We have
+ *
+ * n sin(x) cos(x) tan(x)
+ * ----------------------------------------------------------
+ * 0 S C T
+ * 1 C -S -1/T
+ * 2 -S -C T
+ * 3 -C S -1/T
+ * ----------------------------------------------------------
+ *
+ * Special cases:
+ * Let trig be any of sin, cos, or tan.
+ * trig(+-INF) is NaN, with signals;
+ * trig(NaN) is that NaN;
+ *
+ * Accuracy:
+ * TRIG(x) returns trig(x) nearly rounded
+ */
+
+#include "libm.h"
+
+double cos(double x)
+{
+ double y[2],z=0.0;
+ int32_t n, ix;
+
+ GET_HIGH_WORD(ix, x);
+
+ /* |x| ~< pi/4 */
+ ix &= 0x7fffffff;
+ if (ix <= 0x3fe921fb) {
+ if (ix < 0x3e46a09e) /* if x < 2**-27 * sqrt(2) */
+ /* raise inexact if x != 0 */
+ if ((int)x == 0)
+ return 1.0;
+ return __cos(x, z);
+ }
+
+ /* cos(Inf or NaN) is NaN */
+ if (ix >= 0x7ff00000)
+ return x-x;
+
+ /* argument reduction needed */
+ n = __rem_pio2(x, y);
+ switch (n&3) {
+ case 0: return __cos(y[0], y[1]);
+ case 1: return -__sin(y[0], y[1], 1);
+ case 2: return -__cos(y[0], y[1]);
+ default:
+ return __sin(y[0], y[1], 1);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cosf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+/* Small multiples of pi/2 rounded to double precision. */
+static const double
+c1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */
+c2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */
+c3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */
+c4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */
+
+float cosf(float x)
+{
+ double y;
+ int32_t n, hx, ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix <= 0x3f490fda) { /* |x| ~<= pi/4 */
+ if (ix < 0x39800000) /* |x| < 2**-12 */
+ if ((int)x == 0) /* raise inexact if x != 0 */
+ return 1.0;
+ return __cosdf(x);
+ }
+ if (ix <= 0x407b53d1) { /* |x| ~<= 5*pi/4 */
+ if (ix > 0x4016cbe3) /* |x| ~> 3*pi/4 */
+ return -__cosdf(hx > 0 ? x-c2pio2 : x+c2pio2);
+ else {
+ if (hx > 0)
+ return __sindf(c1pio2 - x);
+ else
+ return __sindf(x + c1pio2);
+ }
+ }
+ if (ix <= 0x40e231d5) { /* |x| ~<= 9*pi/4 */
+ if (ix > 0x40afeddf) /* |x| ~> 7*pi/4 */
+ return __cosdf(hx > 0 ? x-c4pio2 : x+c4pio2);
+ else {
+ if (hx > 0)
+ return __sindf(x - c3pio2);
+ else
+ return __sindf(-c3pio2 - x);
+ }
+ }
+
+ /* cos(Inf or NaN) is NaN */
+ if (ix >= 0x7f800000)
+ return x-x;
+
+ /* general argument reduction needed */
+ n = __rem_pio2f(x,&y);
+ switch (n&3) {
+ case 0: return __cosdf(y);
+ case 1: return __sindf(-y);
+ case 2: return -__cosdf(y);
+ default:
+ return __sindf(y);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_cosh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* cosh(x)
+ * Method :
+ * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2
+ * 1. Replace x by |x| (cosh(x) = cosh(-x)).
+ * 2.
+ * [ exp(x) - 1 ]^2
+ * 0 <= x <= ln2/2 : cosh(x) := 1 + -------------------
+ * 2*exp(x)
+ *
+ * exp(x) + 1/exp(x)
+ * ln2/2 <= x <= 22 : cosh(x) := -------------------
+ * 2
+ * 22 <= x <= lnovft : cosh(x) := exp(x)/2
+ * lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2)
+ * ln2ovft < x : cosh(x) := huge*huge (overflow)
+ *
+ * Special cases:
+ * cosh(x) is |x| if x is +INF, -INF, or NaN.
+ * only cosh(0)=1 is exact for finite x.
+ */
+
+#include "libm.h"
+
+static const double one = 1.0, half = 0.5, huge = 1.0e300;
+
+double cosh(double x)
+{
+ double t, w;
+ int32_t ix;
+
+ GET_HIGH_WORD(ix, x);
+ ix &= 0x7fffffff;
+
+ /* x is INF or NaN */
+ if (ix >= 0x7ff00000)
+ return x*x;
+
+ /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
+ if (ix < 0x3fd62e43) {
+ t = expm1(fabs(x));
+ w = one+t;
+ if (ix < 0x3c800000)
+ return w; /* cosh(tiny) = 1 */
+ return one + (t*t)/(w+w);
+ }
+
+ /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|))/2; */
+ if (ix < 0x40360000) {
+ t = exp(fabs(x));
+ return half*t + half/t;
+ }
+
+ /* |x| in [22, log(maxdouble)] return half*exp(|x|) */
+ if (ix < 0x40862E42)
+ return half*exp(fabs(x));
+
+ /* |x| in [log(maxdouble), overflowthresold] */
+ if (ix <= 0x408633CE)
+ return __expo2(fabs(x));
+
+ /* |x| > overflowthresold, cosh(x) overflow */
+ return huge*huge;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_coshf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float one = 1.0, half = 0.5, huge = 1.0e30;
+
+float coshf(float x)
+{
+ float t, w;
+ int32_t ix;
+
+ GET_FLOAT_WORD(ix, x);
+ ix &= 0x7fffffff;
+
+ /* x is INF or NaN */
+ if (ix >= 0x7f800000)
+ return x*x;
+
+ /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
+ if (ix < 0x3eb17218) {
+ t = expm1f(fabsf(x));
+ w = one+t;
+ if (ix<0x39800000)
+ return one; /* cosh(tiny) = 1 */
+ return one + (t*t)/(w+w);
+ }
+
+ /* |x| in [0.5*ln2,9], return (exp(|x|)+1/exp(|x|))/2; */
+ if (ix < 0x41100000) {
+ t = expf(fabsf(x));
+ return half*t + half/t;
+ }
+
+ /* |x| in [9, log(maxfloat)] return half*exp(|x|) */
+ if (ix < 0x42b17217)
+ return half*expf(fabsf(x));
+
+ /* |x| in [log(maxfloat), overflowthresold] */
+ if (ix <= 0x42b2d4fc)
+ return __expo2f(fabsf(x));
+
+ /* |x| > overflowthresold, cosh(x) overflow */
+ return huge*huge;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_coshl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* coshl(x)
+ * Method :
+ * mathematically coshl(x) if defined to be (exp(x)+exp(-x))/2
+ * 1. Replace x by |x| (coshl(x) = coshl(-x)).
+ * 2.
+ * [ exp(x) - 1 ]^2
+ * 0 <= x <= ln2/2 : coshl(x) := 1 + -------------------
+ * 2*exp(x)
+ *
+ * exp(x) + 1/exp(x)
+ * ln2/2 <= x <= 22 : coshl(x) := -------------------
+ * 2
+ * 22 <= x <= lnovft : coshl(x) := expl(x)/2
+ * lnovft <= x <= ln2ovft: coshl(x) := expl(x/2)/2 * expl(x/2)
+ * ln2ovft < x : coshl(x) := huge*huge (overflow)
+ *
+ * Special cases:
+ * coshl(x) is |x| if x is +INF, -INF, or NaN.
+ * only coshl(0)=1 is exact for finite x.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double coshl(long double x)
+{
+ return cosh(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double one = 1.0, half = 0.5, huge = 1.0e4900L;
+
+long double coshl(long double x)
+{
+ long double t,w;
+ int32_t ex;
+ uint32_t mx,lx;
+
+ /* High word of |x|. */
+ GET_LDOUBLE_WORDS(ex, mx, lx, x);
+ ex &= 0x7fff;
+
+ /* x is INF or NaN */
+ if (ex == 0x7fff) return x*x;
+
+ /* |x| in [0,0.5*ln2], return 1+expm1l(|x|)^2/(2*expl(|x|)) */
+ if (ex < 0x3ffd || (ex == 0x3ffd && mx < 0xb17217f7u)) {
+ t = expm1l(fabsl(x));
+ w = one + t;
+ if (ex < 0x3fbc) return w; /* cosh(tiny) = 1 */
+ return one+(t*t)/(w+w);
+ }
+
+ /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */
+ if (ex < 0x4003 || (ex == 0x4003 && mx < 0xb0000000u)) {
+ t = expl(fabsl(x));
+ return half*t + half/t;
+ }
+
+ /* |x| in [22, ln(maxdouble)] return half*exp(|x|) */
+ if (ex < 0x400c || (ex == 0x400c && mx < 0xb1700000u))
+ return half*expl(fabsl(x));
+
+ /* |x| in [log(maxdouble), log(2*maxdouble)) */
+ if (ex == 0x400c && (mx < 0xb174ddc0u ||
+ (mx == 0xb174ddc0u && lx < 0x31aec0ebu)))
+ {
+ w = expl(half*fabsl(x));
+ t = half*w;
+ return t*w;
+ }
+
+ /* |x| >= log(2*maxdouble), cosh(x) overflow */
+ return huge*huge;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_cosl.c */
+/*-
+ * Copyright (c) 2007 Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Limited testing on pseudorandom numbers drawn within [-2e8:4e8] shows
+ * an accuracy of <= 0.7412 ULP.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double cosl(long double x) {
+ return cos(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__rem_pio2l.h"
+
+long double cosl(long double x)
+{
+ union IEEEl2bits z;
+ int e0;
+ long double y[2];
+ long double hi, lo;
+
+ z.e = x;
+ z.bits.sign = 0;
+
+ /* If x = +-0 or x is a subnormal number, then cos(x) = 1 */
+ if (z.bits.exp == 0)
+ return 1.0;
+
+ /* If x = NaN or Inf, then cos(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)
+ return __cosl(z.e, 0);
+
+ e0 = __rem_pio2l(x, y);
+ hi = y[0];
+ lo = y[1];
+
+ switch (e0 & 3) {
+ case 0:
+ hi = __cosl(hi, lo);
+ break;
+ case 1:
+ hi = -__sinl(hi, lo, 1);
+ break;
+ case 2:
+ hi = -__cosl(hi, lo);
+ break;
+ case 3:
+ hi = __sinl(hi, lo, 1);
+ break;
+ }
+ return hi;
+}
+#endif
+++ /dev/null
-/* @(#)e_acos.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* acos(x)
- * Method :
- * acos(x) = pi/2 - asin(x)
- * acos(-x) = pi/2 + asin(x)
- * For |x|<=0.5
- * acos(x) = pi/2 - (x + x*x^2*R(x^2)) (see asin.c)
- * For x>0.5
- * acos(x) = pi/2 - (pi/2 - 2asin(sqrt((1-x)/2)))
- * = 2asin(sqrt((1-x)/2))
- * = 2s + 2s*z*R(z) ...z=(1-x)/2, s=sqrt(z)
- * = 2f + (2c + 2s*z*R(z))
- * where f=hi part of s, and c = (z-f*f)/(s+f) is the correction term
- * for f so that f+c ~ sqrt(z).
- * For x<-0.5
- * acos(x) = pi - 2asin(sqrt((1-|x|)/2))
- * = pi - 0.5*(s+s*z*R(z)), where z=(1-|x|)/2,s=sqrt(z)
- *
- * Special cases:
- * if x is NaN, return x itself;
- * if |x|>1, return NaN with invalid signal.
- *
- * Function needed: sqrt
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one= 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
-pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
-pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
-pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
-pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
-pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
-pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
-pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
-pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
-pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
-qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
-qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
-qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
-qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
-
-double
-acos(double x)
-{
- double z,p,q,r,w,s,c,df;
- int32_t hx,ix;
- GET_HIGH_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x3ff00000) { /* |x| >= 1 */
- uint32_t lx;
- GET_LOW_WORD(lx,x);
- if(((ix-0x3ff00000)|lx)==0) { /* |x|==1 */
- if(hx>0) return 0.0; /* acos(1) = 0 */
- else return pi+2.0*pio2_lo; /* acos(-1)= pi */
- }
- return (x-x)/(x-x); /* acos(|x|>1) is NaN */
- }
- if(ix<0x3fe00000) { /* |x| < 0.5 */
- if(ix<=0x3c600000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/
- z = x*x;
- p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
- q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
- r = p/q;
- return pio2_hi - (x - (pio2_lo-x*r));
- } else if (hx<0) { /* x < -0.5 */
- z = (one+x)*0.5;
- p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
- q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
- s = sqrt(z);
- r = p/q;
- w = r*s-pio2_lo;
- return pi - 2.0*(s+w);
- } else { /* x > 0.5 */
- z = (one-x)*0.5;
- s = sqrt(z);
- df = s;
- SET_LOW_WORD(df,0);
- c = (z-df*df)/(s+df);
- p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
- q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
- r = p/q;
- w = r*s+c;
- return 2.0*(df+w);
- }
-}
+++ /dev/null
-/* e_acosf.c -- float version of e_acos.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0000000000e+00, /* 0x3F800000 */
-pi = 3.1415925026e+00, /* 0x40490fda */
-pio2_hi = 1.5707962513e+00, /* 0x3fc90fda */
-pio2_lo = 7.5497894159e-08, /* 0x33a22168 */
-pS0 = 1.6666667163e-01, /* 0x3e2aaaab */
-pS1 = -3.2556581497e-01, /* 0xbea6b090 */
-pS2 = 2.0121252537e-01, /* 0x3e4e0aa8 */
-pS3 = -4.0055535734e-02, /* 0xbd241146 */
-pS4 = 7.9153501429e-04, /* 0x3a4f7f04 */
-pS5 = 3.4793309169e-05, /* 0x3811ef08 */
-qS1 = -2.4033949375e+00, /* 0xc019d139 */
-qS2 = 2.0209457874e+00, /* 0x4001572d */
-qS3 = -6.8828397989e-01, /* 0xbf303361 */
-qS4 = 7.7038154006e-02; /* 0x3d9dc62e */
-
-float
-acosf(float x)
-{
- float z,p,q,r,w,s,c,df;
- int32_t hx,ix;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix==0x3f800000) { /* |x|==1 */
- if(hx>0) return 0.0; /* acos(1) = 0 */
- else return pi+(float)2.0*pio2_lo; /* acos(-1)= pi */
- } else if(ix>0x3f800000) { /* |x| >= 1 */
- return (x-x)/(x-x); /* acos(|x|>1) is NaN */
- }
- if(ix<0x3f000000) { /* |x| < 0.5 */
- if(ix<=0x23000000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/
- z = x*x;
- p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
- q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
- r = p/q;
- return pio2_hi - (x - (pio2_lo-x*r));
- } else if (hx<0) { /* x < -0.5 */
- z = (one+x)*(float)0.5;
- p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
- q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
- s = sqrtf(z);
- r = p/q;
- w = r*s-pio2_lo;
- return pi - (float)2.0*(s+w);
- } else { /* x > 0.5 */
- int32_t idf;
- z = (one-x)*(float)0.5;
- s = sqrtf(z);
- df = s;
- GET_FLOAT_WORD(idf,df);
- SET_FLOAT_WORD(df,idf&0xfffff000);
- c = (z-df*df)/(s+df);
- p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
- q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
- r = p/q;
- w = r*s+c;
- return (float)2.0*(df+w);
- }
-}
+++ /dev/null
-
-/* @(#)e_acosh.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- *
- */
-
-/* acosh(x)
- * Method :
- * Based on
- * acosh(x) = log [ x + sqrt(x*x-1) ]
- * we have
- * acosh(x) := log(x)+ln2, if x is large; else
- * acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else
- * acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1.
- *
- * Special cases:
- * acosh(x) is NaN with signal if x<1.
- * acosh(NaN) is NaN without signal.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one = 1.0,
-ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */
-
-double
-acosh(double x)
-{
- double t;
- int32_t hx;
- uint32_t lx;
- EXTRACT_WORDS(hx,lx,x);
- if(hx<0x3ff00000) { /* x < 1 */
- return (x-x)/(x-x);
- } else if(hx >=0x41b00000) { /* x > 2**28 */
- if(hx >=0x7ff00000) { /* x is inf of NaN */
- return x+x;
- } else
- return log(x)+ln2; /* acosh(huge)=log(2x) */
- } else if(((hx-0x3ff00000)|lx)==0) {
- return 0.0; /* acosh(1) = 0 */
- } else if (hx > 0x40000000) { /* 2**28 > x > 2 */
- t=x*x;
- return log(2.0*x-one/(x+sqrt(t-one)));
- } else { /* 1<x<2 */
- t = x-one;
- return log1p(t+sqrt(2.0*t+t*t));
- }
-}
+++ /dev/null
-/* e_acoshf.c -- float version of e_acosh.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0,
-ln2 = 6.9314718246e-01; /* 0x3f317218 */
-
-float
-acoshf(float x)
-{
- float t;
- int32_t hx;
- GET_FLOAT_WORD(hx,x);
- if(hx<0x3f800000) { /* x < 1 */
- return (x-x)/(x-x);
- } else if(hx >=0x4d800000) { /* x > 2**28 */
- if(hx >=0x7f800000) { /* x is inf of NaN */
- return x+x;
- } else
- return logf(x)+ln2; /* acosh(huge)=log(2x) */
- } else if (hx==0x3f800000) {
- return 0.0; /* acosh(1) = 0 */
- } else if (hx > 0x40000000) { /* 2**28 > x > 2 */
- t=x*x;
- return logf((float)2.0*x-one/(x+sqrtf(t-one)));
- } else { /* 1<x<2 */
- t = x-one;
- return log1pf(t+sqrtf((float)2.0*t+t*t));
- }
-}
+++ /dev/null
-
-/* @(#)e_asin.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* asin(x)
- * Method :
- * Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ...
- * we approximate asin(x) on [0,0.5] by
- * asin(x) = x + x*x^2*R(x^2)
- * where
- * R(x^2) is a rational approximation of (asin(x)-x)/x^3
- * and its remez error is bounded by
- * |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75)
- *
- * For x in [0.5,1]
- * asin(x) = pi/2-2*asin(sqrt((1-x)/2))
- * Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2;
- * then for x>0.98
- * asin(x) = pi/2 - 2*(s+s*z*R(z))
- * = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo)
- * For x<=0.98, let pio4_hi = pio2_hi/2, then
- * f = hi part of s;
- * c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z)
- * and
- * asin(x) = pi/2 - 2*(s+s*z*R(z))
- * = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo)
- * = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c))
- *
- * Special cases:
- * if x is NaN, return x itself;
- * if |x|>1, return NaN with invalid signal.
- *
- */
-
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
-huge = 1.000e+300,
-pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
-pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
-pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */
- /* coefficient for R(x^2) */
-pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
-pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
-pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
-pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
-pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
-pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
-qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
-qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
-qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
-qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
-
-double
-asin(double x)
-{
- double t=0.0,w,p,q,c,r,s;
- int32_t hx,ix;
- GET_HIGH_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>= 0x3ff00000) { /* |x|>= 1 */
- uint32_t lx;
- GET_LOW_WORD(lx,x);
- if(((ix-0x3ff00000)|lx)==0)
- /* asin(1)=+-pi/2 with inexact */
- return x*pio2_hi+x*pio2_lo;
- return (x-x)/(x-x); /* asin(|x|>1) is NaN */
- } else if (ix<0x3fe00000) { /* |x|<0.5 */
- if(ix<0x3e400000) { /* if |x| < 2**-27 */
- if(huge+x>one) return x;/* return x with inexact if x!=0*/
- } else
- t = x*x;
- p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
- q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
- w = p/q;
- return x+x*w;
- }
- /* 1> |x|>= 0.5 */
- w = one-fabs(x);
- t = w*0.5;
- p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
- q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
- s = sqrt(t);
- if(ix>=0x3FEF3333) { /* if |x| > 0.975 */
- w = p/q;
- t = pio2_hi-(2.0*(s+s*w)-pio2_lo);
- } else {
- w = s;
- SET_LOW_WORD(w,0);
- c = (t-w*w)/(s+w);
- r = p/q;
- p = 2.0*s*r-(pio2_lo-2.0*c);
- q = pio4_hi-2.0*w;
- t = pio4_hi-(p-q);
- }
- if(hx>0) return t; else return -t;
-}
+++ /dev/null
-/* e_asinf.c -- float version of e_asin.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0000000000e+00, /* 0x3F800000 */
-huge = 1.000e+30,
-pio2_hi = 1.5707962513e+00, /* 0x3fc90fda */
-pio2_lo = 7.5497894159e-08, /* 0x33a22168 */
-pio4_hi = 7.8539818525e-01, /* 0x3f490fdb */
- /* coefficient for R(x^2) */
-pS0 = 1.6666667163e-01, /* 0x3e2aaaab */
-pS1 = -3.2556581497e-01, /* 0xbea6b090 */
-pS2 = 2.0121252537e-01, /* 0x3e4e0aa8 */
-pS3 = -4.0055535734e-02, /* 0xbd241146 */
-pS4 = 7.9153501429e-04, /* 0x3a4f7f04 */
-pS5 = 3.4793309169e-05, /* 0x3811ef08 */
-qS1 = -2.4033949375e+00, /* 0xc019d139 */
-qS2 = 2.0209457874e+00, /* 0x4001572d */
-qS3 = -6.8828397989e-01, /* 0xbf303361 */
-qS4 = 7.7038154006e-02; /* 0x3d9dc62e */
-
-float
-asinf(float x)
-{
- float t=0.0,w,p,q,c,r,s;
- int32_t hx,ix;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix==0x3f800000) {
- /* asin(1)=+-pi/2 with inexact */
- return x*pio2_hi+x*pio2_lo;
- } else if(ix> 0x3f800000) { /* |x|>= 1 */
- return (x-x)/(x-x); /* asin(|x|>1) is NaN */
- } else if (ix<0x3f000000) { /* |x|<0.5 */
- if(ix<0x32000000) { /* if |x| < 2**-27 */
- if(huge+x>one) return x;/* return x with inexact if x!=0*/
- } else
- t = x*x;
- p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
- q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
- w = p/q;
- return x+x*w;
- }
- /* 1> |x|>= 0.5 */
- w = one-fabsf(x);
- t = w*(float)0.5;
- p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
- q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
- s = sqrtf(t);
- if(ix>=0x3F79999A) { /* if |x| > 0.975 */
- w = p/q;
- t = pio2_hi-((float)2.0*(s+s*w)-pio2_lo);
- } else {
- int32_t iw;
- w = s;
- GET_FLOAT_WORD(iw,w);
- SET_FLOAT_WORD(w,iw&0xfffff000);
- c = (t-w*w)/(s+w);
- r = p/q;
- p = (float)2.0*s*r-(pio2_lo-(float)2.0*c);
- q = pio4_hi-(float)2.0*w;
- t = pio4_hi-(p-q);
- }
- if(hx>0) return t; else return -t;
-}
+++ /dev/null
-
-/* @(#)e_atan2.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- *
- */
-
-/* atan2(y,x)
- * Method :
- * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
- * 2. Reduce x to positive by (if x and y are unexceptional):
- * ARG (x+iy) = arctan(y/x) ... if x > 0,
- * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
- *
- * Special cases:
- *
- * ATAN2((anything), NaN ) is NaN;
- * ATAN2(NAN , (anything) ) is NaN;
- * ATAN2(+-0, +(anything but NaN)) is +-0 ;
- * ATAN2(+-0, -(anything but NaN)) is +-pi ;
- * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2;
- * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ;
- * ATAN2(+-(anything but INF and NaN), -INF) is +-pi;
- * ATAN2(+-INF,+INF ) is +-pi/4 ;
- * ATAN2(+-INF,-INF ) is +-3pi/4;
- * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2;
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-tiny = 1.0e-300,
-zero = 0.0,
-pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */
-pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */
-pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */
-pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */
-
-double
-atan2(double y, double x)
-{
- double z;
- int32_t k,m,hx,hy,ix,iy;
- uint32_t lx,ly;
-
- EXTRACT_WORDS(hx,lx,x);
- ix = hx&0x7fffffff;
- EXTRACT_WORDS(hy,ly,y);
- iy = hy&0x7fffffff;
- if(((ix|((lx|-lx)>>31))>0x7ff00000)||
- ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */
- return x+y;
- if(((hx-0x3ff00000)|lx)==0) return atan(y); /* x=1.0 */
- m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */
-
- /* when y = 0 */
- if((iy|ly)==0) {
- switch(m) {
- case 0:
- case 1: return y; /* atan(+-0,+anything)=+-0 */
- case 2: return pi+tiny;/* atan(+0,-anything) = pi */
- case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */
- }
- }
- /* when x = 0 */
- if((ix|lx)==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny;
-
- /* when x is INF */
- if(ix==0x7ff00000) {
- if(iy==0x7ff00000) {
- switch(m) {
- case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */
- case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */
- case 2: return 3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/
- case 3: return -3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/
- }
- } else {
- switch(m) {
- case 0: return zero ; /* atan(+...,+INF) */
- case 1: return -zero ; /* atan(-...,+INF) */
- case 2: return pi+tiny ; /* atan(+...,-INF) */
- case 3: return -pi-tiny ; /* atan(-...,-INF) */
- }
- }
- }
- /* when y is INF */
- if(iy==0x7ff00000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny;
-
- /* compute y/x */
- k = (iy-ix)>>20;
- if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */
- else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */
- else z=atan(fabs(y/x)); /* safe to do y/x */
- switch (m) {
- case 0: return z ; /* atan(+,+) */
- case 1: {
- uint32_t zh;
- GET_HIGH_WORD(zh,z);
- SET_HIGH_WORD(z,zh ^ 0x80000000);
- }
- return z ; /* atan(-,+) */
- case 2: return pi-(z-pi_lo);/* atan(+,-) */
- default: /* case 3 */
- return (z-pi_lo)-pi;/* atan(-,-) */
- }
-}
+++ /dev/null
-/* e_atan2f.c -- float version of e_atan2.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-tiny = 1.0e-30,
-zero = 0.0,
-pi_o_4 = 7.8539818525e-01, /* 0x3f490fdb */
-pi_o_2 = 1.5707963705e+00, /* 0x3fc90fdb */
-pi = 3.1415927410e+00, /* 0x40490fdb */
-pi_lo = -8.7422776573e-08; /* 0xb3bbbd2e */
-
-float
-atan2f(float y, float x)
-{
- float z;
- int32_t k,m,hx,hy,ix,iy;
-
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- GET_FLOAT_WORD(hy,y);
- iy = hy&0x7fffffff;
- if((ix>0x7f800000)||
- (iy>0x7f800000)) /* x or y is NaN */
- return x+y;
- if(hx==0x3f800000) return atanf(y); /* x=1.0 */
- m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */
-
- /* when y = 0 */
- if(iy==0) {
- switch(m) {
- case 0:
- case 1: return y; /* atan(+-0,+anything)=+-0 */
- case 2: return pi+tiny;/* atan(+0,-anything) = pi */
- case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */
- }
- }
- /* when x = 0 */
- if(ix==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny;
-
- /* when x is INF */
- if(ix==0x7f800000) {
- if(iy==0x7f800000) {
- switch(m) {
- case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */
- case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */
- case 2: return (float)3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/
- case 3: return (float)-3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/
- }
- } else {
- switch(m) {
- case 0: return zero ; /* atan(+...,+INF) */
- case 1: return -zero ; /* atan(-...,+INF) */
- case 2: return pi+tiny ; /* atan(+...,-INF) */
- case 3: return -pi-tiny ; /* atan(-...,-INF) */
- }
- }
- }
- /* when y is INF */
- if(iy==0x7f800000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny;
-
- /* compute y/x */
- k = (iy-ix)>>23;
- if(k > 60) z=pi_o_2+(float)0.5*pi_lo; /* |y/x| > 2**60 */
- else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */
- else z=atanf(fabsf(y/x)); /* safe to do y/x */
- switch (m) {
- case 0: return z ; /* atan(+,+) */
- case 1: {
- uint32_t zh;
- GET_FLOAT_WORD(zh,z);
- SET_FLOAT_WORD(z,zh ^ 0x80000000);
- }
- return z ; /* atan(-,+) */
- case 2: return pi-(z-pi_lo);/* atan(+,-) */
- default: /* case 3 */
- return (z-pi_lo)-pi;/* atan(-,-) */
- }
-}
+++ /dev/null
-
-/* @(#)e_atanh.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- *
- */
-
-/* atanh(x)
- * Method :
- * 1.Reduced x to positive by atanh(-x) = -atanh(x)
- * 2.For x>=0.5
- * 1 2x x
- * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
- * 2 1 - x 1 - x
- *
- * For x<0.5
- * atanh(x) = 0.5*log1p(2x+2x*x/(1-x))
- *
- * Special cases:
- * atanh(x) is NaN if |x| > 1 with signal;
- * atanh(NaN) is that NaN with no signal;
- * atanh(+-1) is +-INF with signal.
- *
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one = 1.0, huge = 1e300;
-static const double zero = 0.0;
-
-double
-atanh(double x)
-{
- double t;
- int32_t hx,ix;
- uint32_t lx;
- EXTRACT_WORDS(hx,lx,x);
- ix = hx&0x7fffffff;
- if ((ix|((lx|(-lx))>>31))>0x3ff00000) /* |x|>1 */
- return (x-x)/(x-x);
- if(ix==0x3ff00000)
- return x/zero;
- if(ix<0x3e300000&&(huge+x)>zero) return x; /* x<2**-28 */
- SET_HIGH_WORD(x,ix);
- if(ix<0x3fe00000) { /* x < 0.5 */
- t = x+x;
- t = 0.5*log1p(t+t*x/(one-x));
- } else
- t = 0.5*log1p((x+x)/(one-x));
- if(hx>=0) return t; else return -t;
-}
+++ /dev/null
-/* e_atanhf.c -- float version of e_atanh.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one = 1.0, huge = 1e30;
-
-static const float zero = 0.0;
-
-float
-atanhf(float x)
-{
- float t;
- int32_t hx,ix;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if (ix>0x3f800000) /* |x|>1 */
- return (x-x)/(x-x);
- if(ix==0x3f800000)
- return x/zero;
- if(ix<0x31800000&&(huge+x)>zero) return x; /* x<2**-28 */
- SET_FLOAT_WORD(x,ix);
- if(ix<0x3f000000) { /* x < 0.5 */
- t = x+x;
- t = (float)0.5*log1pf(t+t*x/(one-x));
- } else
- t = (float)0.5*log1pf((x+x)/(one-x));
- if(hx>=0) return t; else return -t;
-}
+++ /dev/null
-
-/* @(#)e_cosh.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* cosh(x)
- * Method :
- * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2
- * 1. Replace x by |x| (cosh(x) = cosh(-x)).
- * 2.
- * [ exp(x) - 1 ]^2
- * 0 <= x <= ln2/2 : cosh(x) := 1 + -------------------
- * 2*exp(x)
- *
- * exp(x) + 1/exp(x)
- * ln2/2 <= x <= 22 : cosh(x) := -------------------
- * 2
- * 22 <= x <= lnovft : cosh(x) := exp(x)/2
- * lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2)
- * ln2ovft < x : cosh(x) := huge*huge (overflow)
- *
- * Special cases:
- * cosh(x) is |x| if x is +INF, -INF, or NaN.
- * only cosh(0)=1 is exact for finite x.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one = 1.0, half=0.5, huge = 1.0e300;
-
-double
-cosh(double x)
-{
- double t,w;
- int32_t ix;
- uint32_t lx;
-
- /* High word of |x|. */
- GET_HIGH_WORD(ix,x);
- ix &= 0x7fffffff;
-
- /* x is INF or NaN */
- if(ix>=0x7ff00000) return x*x;
-
- /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
- if(ix<0x3fd62e43) {
- t = expm1(fabs(x));
- w = one+t;
- if (ix<0x3c800000) return w; /* cosh(tiny) = 1 */
- return one+(t*t)/(w+w);
- }
-
- /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */
- if (ix < 0x40360000) {
- t = exp(fabs(x));
- return half*t+half/t;
- }
-
- /* |x| in [22, log(maxdouble)] return half*exp(|x|) */
- if (ix < 0x40862E42) return half*exp(fabs(x));
-
- /* |x| in [log(maxdouble), overflowthresold] */
- GET_LOW_WORD(lx,x);
- if (ix<0x408633CE ||
- ((ix==0x408633ce)&&(lx<=(uint32_t)0x8fb9f87d))) {
- w = exp(half*fabs(x));
- t = half*w;
- return t*w;
- }
-
- /* |x| > overflowthresold, cosh(x) overflow */
- return huge*huge;
-}
+++ /dev/null
-/* e_coshf.c -- float version of e_cosh.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one = 1.0, half=0.5, huge = 1.0e30;
-
-float
-coshf(float x)
-{
- float t,w;
- int32_t ix;
-
- GET_FLOAT_WORD(ix,x);
- ix &= 0x7fffffff;
-
- /* x is INF or NaN */
- if(ix>=0x7f800000) return x*x;
-
- /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
- if(ix<0x3eb17218) {
- t = expm1f(fabsf(x));
- w = one+t;
- if (ix<0x24000000) return w; /* cosh(tiny) = 1 */
- return one+(t*t)/(w+w);
- }
-
- /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */
- if (ix < 0x41b00000) {
- t = expf(fabsf(x));
- return half*t+half/t;
- }
-
- /* |x| in [22, log(maxdouble)] return half*exp(|x|) */
- if (ix < 0x42b17180) return half*expf(fabsf(x));
-
- /* |x| in [log(maxdouble), overflowthresold] */
- if (ix<=0x42b2d4fc) {
- w = expf(half*fabsf(x));
- t = half*w;
- return t*w;
- }
-
- /* |x| > overflowthresold, cosh(x) overflow */
- return huge*huge;
-}
+++ /dev/null
-
-/* @(#)e_exp.c 1.6 04/04/22 */
-/*
- * ====================================================
- * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
- *
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* exp(x)
- * Returns the exponential of x.
- *
- * Method
- * 1. Argument reduction:
- * Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658.
- * Given x, find r and integer k such that
- *
- * x = k*ln2 + r, |r| <= 0.5*ln2.
- *
- * Here r will be represented as r = hi-lo for better
- * accuracy.
- *
- * 2. Approximation of exp(r) by a special rational function on
- * the interval [0,0.34658]:
- * Write
- * R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ...
- * We use a special Remes algorithm on [0,0.34658] to generate
- * a polynomial of degree 5 to approximate R. The maximum error
- * of this polynomial approximation is bounded by 2**-59. In
- * other words,
- * R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5
- * (where z=r*r, and the values of P1 to P5 are listed below)
- * and
- * | 5 | -59
- * | 2.0+P1*z+...+P5*z - R(z) | <= 2
- * | |
- * The computation of exp(r) thus becomes
- * 2*r
- * exp(r) = 1 + -------
- * R - r
- * r*R1(r)
- * = 1 + r + ----------- (for better accuracy)
- * 2 - R1(r)
- * where
- * 2 4 10
- * R1(r) = r - (P1*r + P2*r + ... + P5*r ).
- *
- * 3. Scale back to obtain exp(x):
- * From step 1, we have
- * exp(x) = 2^k * exp(r)
- *
- * Special cases:
- * exp(INF) is INF, exp(NaN) is NaN;
- * exp(-INF) is 0, and
- * for finite argument, only exp(0)=1 is exact.
- *
- * Accuracy:
- * according to an error analysis, the error is always less than
- * 1 ulp (unit in the last place).
- *
- * Misc. info.
- * For IEEE double
- * if x > 7.09782712893383973096e+02 then exp(x) overflow
- * if x < -7.45133219101941108420e+02 then exp(x) underflow
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one = 1.0,
-halF[2] = {0.5,-0.5,},
-huge = 1.0e+300,
-twom1000= 9.33263618503218878990e-302, /* 2**-1000=0x01700000,0*/
-o_threshold= 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
-u_threshold= -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */
-ln2HI[2] ={ 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */
- -6.93147180369123816490e-01,},/* 0xbfe62e42, 0xfee00000 */
-ln2LO[2] ={ 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */
- -1.90821492927058770002e-10,},/* 0xbdea39ef, 0x35793c76 */
-invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */
-P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
-P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
-P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
-P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
-P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */
-
-
-double
-exp(double x) /* default IEEE double exp */
-{
- double y,hi=0.0,lo=0.0,c,t;
- int32_t k=0,xsb;
- uint32_t hx;
-
- GET_HIGH_WORD(hx,x);
- xsb = (hx>>31)&1; /* sign bit of x */
- hx &= 0x7fffffff; /* high word of |x| */
-
- /* filter out non-finite argument */
- if(hx >= 0x40862E42) { /* if |x|>=709.78... */
- if(hx>=0x7ff00000) {
- uint32_t lx;
- GET_LOW_WORD(lx,x);
- if(((hx&0xfffff)|lx)!=0)
- return x+x; /* NaN */
- else return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */
- }
- if(x > o_threshold) return huge*huge; /* overflow */
- if(x < u_threshold) return twom1000*twom1000; /* underflow */
- }
-
- /* argument reduction */
- if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
- if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
- hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb;
- } else {
- k = (int)(invln2*x+halF[xsb]);
- t = k;
- hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */
- lo = t*ln2LO[0];
- }
- x = hi - lo;
- }
- else if(hx < 0x3e300000) { /* when |x|<2**-28 */
- if(huge+x>one) return one+x;/* trigger inexact */
- }
- else k = 0;
-
- /* x is now in primary range */
- t = x*x;
- c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
- if(k==0) return one-((x*c)/(c-2.0)-x);
- else y = one-((lo-(x*c)/(2.0-c))-hi);
- if(k >= -1021) {
- uint32_t hy;
- GET_HIGH_WORD(hy,y);
- SET_HIGH_WORD(y,hy+(k<<20)); /* add k to y's exponent */
- return y;
- } else {
- uint32_t hy;
- GET_HIGH_WORD(hy,y);
- SET_HIGH_WORD(y,hy+((k+1000)<<20)); /* add k to y's exponent */
- return y*twom1000;
- }
-}
+++ /dev/null
-/* e_expf.c -- float version of e_exp.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0,
-halF[2] = {0.5,-0.5,},
-huge = 1.0e+30,
-twom100 = 7.8886090522e-31, /* 2**-100=0x0d800000 */
-o_threshold= 8.8721679688e+01, /* 0x42b17180 */
-u_threshold= -1.0397208405e+02, /* 0xc2cff1b5 */
-ln2HI[2] ={ 6.9313812256e-01, /* 0x3f317180 */
- -6.9313812256e-01,}, /* 0xbf317180 */
-ln2LO[2] ={ 9.0580006145e-06, /* 0x3717f7d1 */
- -9.0580006145e-06,}, /* 0xb717f7d1 */
-invln2 = 1.4426950216e+00, /* 0x3fb8aa3b */
-P1 = 1.6666667163e-01, /* 0x3e2aaaab */
-P2 = -2.7777778450e-03, /* 0xbb360b61 */
-P3 = 6.6137559770e-05, /* 0x388ab355 */
-P4 = -1.6533901999e-06, /* 0xb5ddea0e */
-P5 = 4.1381369442e-08; /* 0x3331bb4c */
-
-float
-expf(float x) /* default IEEE double exp */
-{
- float y,hi=0.0,lo=0.0,c,t;
- int32_t k=0,xsb;
- uint32_t hx;
-
- GET_FLOAT_WORD(hx,x);
- xsb = (hx>>31)&1; /* sign bit of x */
- hx &= 0x7fffffff; /* high word of |x| */
-
- /* filter out non-finite argument */
- if(hx >= 0x42b17218) { /* if |x|>=88.721... */
- if(hx>0x7f800000)
- return x+x; /* NaN */
- if(hx==0x7f800000)
- return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */
- if(x > o_threshold) return huge*huge; /* overflow */
- if(x < u_threshold) return twom100*twom100; /* underflow */
- }
-
- /* argument reduction */
- if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */
- if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */
- hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb;
- } else {
- k = invln2*x+halF[xsb];
- t = k;
- hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */
- lo = t*ln2LO[0];
- }
- x = hi - lo;
- }
- else if(hx < 0x31800000) { /* when |x|<2**-28 */
- if(huge+x>one) return one+x;/* trigger inexact */
- }
- else k = 0;
-
- /* x is now in primary range */
- t = x*x;
- c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
- if(k==0) return one-((x*c)/(c-(float)2.0)-x);
- else y = one-((lo-(x*c)/((float)2.0-c))-hi);
- if(k >= -125) {
- uint32_t hy;
- GET_FLOAT_WORD(hy,y);
- SET_FLOAT_WORD(y,hy+(k<<23)); /* add k to y's exponent */
- return y;
- } else {
- uint32_t hy;
- GET_FLOAT_WORD(hy,y);
- SET_FLOAT_WORD(y,hy+((k+100)<<23)); /* add k to y's exponent */
- return y*twom100;
- }
-}
+++ /dev/null
-
-/* @(#)e_fmod.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * fmod(x,y)
- * Return x mod y in exact arithmetic
- * Method: shift and subtract
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one = 1.0, Zero[] = {0.0, -0.0,};
-
-double
-fmod(double x, double y)
-{
- int32_t n,hx,hy,hz,ix,iy,sx,i;
- uint32_t lx,ly,lz;
-
- EXTRACT_WORDS(hx,lx,x);
- EXTRACT_WORDS(hy,ly,y);
- sx = hx&0x80000000; /* sign of x */
- hx ^=sx; /* |x| */
- hy &= 0x7fffffff; /* |y| */
-
- /* purge off exception values */
- if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */
- ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */
- return (x*y)/(x*y);
- if(hx<=hy) {
- if((hx<hy)||(lx<ly)) return x; /* |x|<|y| return x */
- if(lx==ly)
- return Zero[(uint32_t)sx>>31]; /* |x|=|y| return x*0*/
- }
-
- /* determine ix = ilogb(x) */
- if(hx<0x00100000) { /* subnormal x */
- if(hx==0) {
- for (ix = -1043, i=lx; i>0; i<<=1) ix -=1;
- } else {
- for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1;
- }
- } else ix = (hx>>20)-1023;
-
- /* determine iy = ilogb(y) */
- if(hy<0x00100000) { /* subnormal y */
- if(hy==0) {
- for (iy = -1043, i=ly; i>0; i<<=1) iy -=1;
- } else {
- for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1;
- }
- } else iy = (hy>>20)-1023;
-
- /* set up {hx,lx}, {hy,ly} and align y to x */
- if(ix >= -1022)
- hx = 0x00100000|(0x000fffff&hx);
- else { /* subnormal x, shift x to normal */
- n = -1022-ix;
- if(n<=31) {
- hx = (hx<<n)|(lx>>(32-n));
- lx <<= n;
- } else {
- hx = lx<<(n-32);
- lx = 0;
- }
- }
- if(iy >= -1022)
- hy = 0x00100000|(0x000fffff&hy);
- else { /* subnormal y, shift y to normal */
- n = -1022-iy;
- if(n<=31) {
- hy = (hy<<n)|(ly>>(32-n));
- ly <<= n;
- } else {
- hy = ly<<(n-32);
- ly = 0;
- }
- }
-
- /* fix point fmod */
- n = ix - iy;
- while(n--) {
- hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1;
- if(hz<0){hx = hx+hx+(lx>>31); lx = lx+lx;}
- else {
- if((hz|lz)==0) /* return sign(x)*0 */
- return Zero[(uint32_t)sx>>31];
- hx = hz+hz+(lz>>31); lx = lz+lz;
- }
- }
- hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1;
- if(hz>=0) {hx=hz;lx=lz;}
-
- /* convert back to floating value and restore the sign */
- if((hx|lx)==0) /* return sign(x)*0 */
- return Zero[(uint32_t)sx>>31];
- while(hx<0x00100000) { /* normalize x */
- hx = hx+hx+(lx>>31); lx = lx+lx;
- iy -= 1;
- }
- if(iy>= -1022) { /* normalize output */
- hx = ((hx-0x00100000)|((iy+1023)<<20));
- INSERT_WORDS(x,hx|sx,lx);
- } else { /* subnormal output */
- n = -1022 - iy;
- if(n<=20) {
- lx = (lx>>n)|((uint32_t)hx<<(32-n));
- hx >>= n;
- } else if (n<=31) {
- lx = (hx<<(32-n))|(lx>>n); hx = sx;
- } else {
- lx = hx>>(n-32); hx = sx;
- }
- INSERT_WORDS(x,hx|sx,lx);
- x *= one; /* create necessary signal */
- }
- return x; /* exact output */
-}
+++ /dev/null
-/* e_fmodf.c -- float version of e_fmod.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * fmodf(x,y)
- * Return x mod y in exact arithmetic
- * Method: shift and subtract
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one = 1.0, Zero[] = {0.0, -0.0,};
-
-float
-fmodf(float x, float y)
-{
- int32_t n,hx,hy,hz,ix,iy,sx,i;
-
- GET_FLOAT_WORD(hx,x);
- GET_FLOAT_WORD(hy,y);
- sx = hx&0x80000000; /* sign of x */
- hx ^=sx; /* |x| */
- hy &= 0x7fffffff; /* |y| */
-
- /* purge off exception values */
- if(hy==0||(hx>=0x7f800000)|| /* y=0,or x not finite */
- (hy>0x7f800000)) /* or y is NaN */
- return (x*y)/(x*y);
- if(hx<hy) return x; /* |x|<|y| return x */
- if(hx==hy)
- return Zero[(uint32_t)sx>>31]; /* |x|=|y| return x*0*/
-
- /* determine ix = ilogb(x) */
- if(hx<0x00800000) { /* subnormal x */
- for (ix = -126,i=(hx<<8); i>0; i<<=1) ix -=1;
- } else ix = (hx>>23)-127;
-
- /* determine iy = ilogb(y) */
- if(hy<0x00800000) { /* subnormal y */
- for (iy = -126,i=(hy<<8); i>=0; i<<=1) iy -=1;
- } else iy = (hy>>23)-127;
-
- /* set up {hx,lx}, {hy,ly} and align y to x */
- if(ix >= -126)
- hx = 0x00800000|(0x007fffff&hx);
- else { /* subnormal x, shift x to normal */
- n = -126-ix;
- hx = hx<<n;
- }
- if(iy >= -126)
- hy = 0x00800000|(0x007fffff&hy);
- else { /* subnormal y, shift y to normal */
- n = -126-iy;
- hy = hy<<n;
- }
-
- /* fix point fmod */
- n = ix - iy;
- while(n--) {
- hz=hx-hy;
- if(hz<0){hx = hx+hx;}
- else {
- if(hz==0) /* return sign(x)*0 */
- return Zero[(uint32_t)sx>>31];
- hx = hz+hz;
- }
- }
- hz=hx-hy;
- if(hz>=0) {hx=hz;}
-
- /* convert back to floating value and restore the sign */
- if(hx==0) /* return sign(x)*0 */
- return Zero[(uint32_t)sx>>31];
- while(hx<0x00800000) { /* normalize x */
- hx = hx+hx;
- iy -= 1;
- }
- if(iy>= -126) { /* normalize output */
- hx = ((hx-0x00800000)|((iy+127)<<23));
- SET_FLOAT_WORD(x,hx|sx);
- } else { /* subnormal output */
- n = -126 - iy;
- hx >>= n;
- SET_FLOAT_WORD(x,hx|sx);
- x *= one; /* create necessary signal */
- }
- return x; /* exact output */
-}
+++ /dev/null
-
-/* @(#)e_hypot.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* hypot(x,y)
- *
- * Method :
- * If (assume round-to-nearest) z=x*x+y*y
- * has error less than sqrt(2)/2 ulp, than
- * sqrt(z) has error less than 1 ulp (exercise).
- *
- * So, compute sqrt(x*x+y*y) with some care as
- * follows to get the error below 1 ulp:
- *
- * Assume x>y>0;
- * (if possible, set rounding to round-to-nearest)
- * 1. if x > 2y use
- * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y
- * where x1 = x with lower 32 bits cleared, x2 = x-x1; else
- * 2. if x <= 2y use
- * t1*y1+((x-y)*(x-y)+(t1*y2+t2*y))
- * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1,
- * y1= y with lower 32 bits chopped, y2 = y-y1.
- *
- * NOTE: scaling may be necessary if some argument is too
- * large or too tiny
- *
- * Special cases:
- * hypot(x,y) is INF if x or y is +INF or -INF; else
- * hypot(x,y) is NAN if x or y is NAN.
- *
- * Accuracy:
- * hypot(x,y) returns sqrt(x^2+y^2) with error less
- * than 1 ulps (units in the last place)
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-hypot(double x, double y)
-{
- double a=x,b=y,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(ha > 0x5f300000) { /* a>2**500 */
- if(ha >= 0x7ff00000) { /* Inf or NaN */
- uint32_t low;
- w = a+b; /* for sNaN */
- 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(hb < 0x20b00000) { /* b < 2**-500 */
- if(hb <= 0x000fffff) { /* subnormal b or 0 */
- uint32_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;
- } 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 = 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 = sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b)));
- }
- if(k!=0) {
- uint32_t high;
- t1 = 1.0;
- GET_HIGH_WORD(high,t1);
- SET_HIGH_WORD(t1,high+(k<<20));
- return t1*w;
- } else return w;
-}
+++ /dev/null
-/* e_hypotf.c -- float version of e_hypot.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-hypotf(float x, float y)
-{
- float a=x,b=y,t1,t2,y1,y2,w;
- int32_t j,k,ha,hb;
-
- GET_FLOAT_WORD(ha,x);
- ha &= 0x7fffffff;
- GET_FLOAT_WORD(hb,y);
- hb &= 0x7fffffff;
- if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;}
- SET_FLOAT_WORD(a,ha); /* a <- |a| */
- SET_FLOAT_WORD(b,hb); /* b <- |b| */
- if((ha-hb)>0xf000000) {return a+b;} /* x/y > 2**30 */
- k=0;
- if(ha > 0x58800000) { /* a>2**50 */
- if(ha >= 0x7f800000) { /* Inf or NaN */
- w = a+b; /* for sNaN */
- if(ha == 0x7f800000) w = a;
- if(hb == 0x7f800000) w = b;
- return w;
- }
- /* scale a and b by 2**-68 */
- ha -= 0x22000000; hb -= 0x22000000; k += 68;
- SET_FLOAT_WORD(a,ha);
- SET_FLOAT_WORD(b,hb);
- }
- if(hb < 0x26800000) { /* b < 2**-50 */
- if(hb <= 0x007fffff) { /* subnormal b or 0 */
- if(hb==0) return a;
- SET_FLOAT_WORD(t1,0x7e800000); /* t1=2^126 */
- b *= t1;
- a *= t1;
- k -= 126;
- } else { /* scale a and b by 2^68 */
- ha += 0x22000000; /* a *= 2^68 */
- hb += 0x22000000; /* b *= 2^68 */
- k -= 68;
- SET_FLOAT_WORD(a,ha);
- SET_FLOAT_WORD(b,hb);
- }
- }
- /* medium size a and b */
- w = a-b;
- if (w>b) {
- SET_FLOAT_WORD(t1,ha&0xfffff000);
- t2 = a-t1;
- w = sqrtf(t1*t1-(b*(-b)-t2*(a+t1)));
- } else {
- a = a+a;
- SET_FLOAT_WORD(y1,hb&0xfffff000);
- y2 = b - y1;
- SET_FLOAT_WORD(t1,ha+0x00800000);
- t2 = a - t1;
- w = sqrtf(t1*y1-(w*(-w)-(t1*y2+t2*b)));
- }
- if(k!=0) {
- SET_FLOAT_WORD(t1,0x3f800000+(k<<23));
- return t1*w;
- } else return w;
-}
+++ /dev/null
-
-/* @(#)e_log.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* log(x)
- * Return the logrithm of x
- *
- * Method :
- * 1. Argument Reduction: find k and f such that
- * x = 2^k * (1+f),
- * where sqrt(2)/2 < 1+f < sqrt(2) .
- *
- * 2. Approximation of log(1+f).
- * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
- * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
- * = 2s + s*R
- * We use a special Reme algorithm on [0,0.1716] to generate
- * a polynomial of degree 14 to approximate R The maximum error
- * of this polynomial approximation is bounded by 2**-58.45. In
- * other words,
- * 2 4 6 8 10 12 14
- * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s
- * (the values of Lg1 to Lg7 are listed in the program)
- * and
- * | 2 14 | -58.45
- * | Lg1*s +...+Lg7*s - R(z) | <= 2
- * | |
- * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
- * In order to guarantee error in log below 1ulp, we compute log
- * by
- * log(1+f) = f - s*(f - R) (if f is not too large)
- * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy)
- *
- * 3. Finally, log(x) = k*ln2 + log(1+f).
- * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
- * Here ln2 is split into two floating point number:
- * ln2_hi + ln2_lo,
- * where n*ln2_hi is always exact for |n| < 2000.
- *
- * Special cases:
- * log(x) is NaN with signal if x < 0 (including -INF) ;
- * log(+INF) is +INF; log(0) is -INF with signal;
- * log(NaN) is that NaN with no signal.
- *
- * Accuracy:
- * according to an error analysis, the error is always less than
- * 1 ulp (unit in the last place).
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
-ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
-two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
-Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
-Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
-Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
-Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
-Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
-Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
-Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
-
-static const double zero = 0.0;
-
-double
-log(double x)
-{
- double hfsq,f,s,z,R,w,t1,t2,dk;
- int32_t k,hx,i,j;
- uint32_t lx;
-
- EXTRACT_WORDS(hx,lx,x);
-
- k=0;
- if (hx < 0x00100000) { /* x < 2**-1022 */
- if (((hx&0x7fffffff)|lx)==0)
- return -two54/zero; /* 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;
- 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);
- f = x-1.0;
- if((0x000fffff&(2+hx))<3) { /* |f| < 2**-20 */
- if(f==zero) { if(k==0) return zero; else {dk=(double)k;
- return dk*ln2_hi+dk*ln2_lo;} }
- R = f*f*(0.5-0.33333333333333333*f);
- if(k==0) return f-R; else {dk=(double)k;
- return dk*ln2_hi-((R-dk*ln2_lo)-f);}
- }
- s = f/(2.0+f);
- dk = (double)k;
- z = s*s;
- i = hx-0x6147a;
- w = z*z;
- j = 0x6b851-hx;
- t1= w*(Lg2+w*(Lg4+w*Lg6));
- t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7)));
- i |= j;
- R = t2+t1;
- if(i>0) {
- hfsq=0.5*f*f;
- if(k==0) return f-(hfsq-s*(hfsq+R)); else
- return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f);
- } else {
- if(k==0) return f-s*(f-R); else
- return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f);
- }
-}
+++ /dev/null
-
-/* @(#)e_log10.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* log10(x)
- * Return the base 10 logarithm of x
- *
- * Method :
- * Let log10_2hi = leading 40 bits of log10(2) and
- * log10_2lo = log10(2) - log10_2hi,
- * ivln10 = 1/log(10) rounded.
- * Then
- * n = ilogb(x),
- * if(n<0) n = n+1;
- * x = scalbn(x,-n);
- * log10(x) := n*log10_2hi + (n*log10_2lo + ivln10*log(x))
- *
- * Note 1:
- * To guarantee log10(10**n)=n, where 10**n is normal, the rounding
- * mode must set to Round-to-Nearest.
- * Note 2:
- * [1/log(10)] rounded to 53 bits has error .198 ulps;
- * log10 is monotonic at all binary break points.
- *
- * Special cases:
- * log10(x) is NaN with signal if x < 0;
- * log10(+INF) is +INF with no signal; log10(0) is -INF with signal;
- * log10(NaN) is that NaN with no signal;
- * log10(10**N) = N for N=0,1,...,22.
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following constants.
- * The decimal values may be used, provided that the compiler will convert
- * from decimal to binary accurately enough to produce the hexadecimal values
- * shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
-ivln10 = 4.34294481903251816668e-01, /* 0x3FDBCB7B, 0x1526E50E */
-log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */
-log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */
-
-static const double zero = 0.0;
-
-double
-log10(double x)
-{
- double y,z;
- int32_t i,k,hx;
- uint32_t lx;
-
- EXTRACT_WORDS(hx,lx,x);
-
- k=0;
- if (hx < 0x00100000) { /* x < 2**-1022 */
- if (((hx&0x7fffffff)|lx)==0)
- return -two54/zero; /* 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;
- k += (hx>>20)-1023;
- i = ((uint32_t)k&0x80000000)>>31;
- hx = (hx&0x000fffff)|((0x3ff-i)<<20);
- y = (double)(k+i);
- SET_HIGH_WORD(x,hx);
- z = y*log10_2lo + ivln10*log(x);
- return z+y*log10_2hi;
-}
+++ /dev/null
-/* e_log10f.c -- float version of e_log10.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-two25 = 3.3554432000e+07, /* 0x4c000000 */
-ivln10 = 4.3429449201e-01, /* 0x3ede5bd9 */
-log10_2hi = 3.0102920532e-01, /* 0x3e9a2080 */
-log10_2lo = 7.9034151668e-07; /* 0x355427db */
-
-static const float zero = 0.0;
-
-float
-log10f(float x)
-{
- float y,z;
- int32_t i,k,hx;
-
- GET_FLOAT_WORD(hx,x);
-
- k=0;
- if (hx < 0x00800000) { /* x < 2**-126 */
- if ((hx&0x7fffffff)==0)
- return -two25/zero; /* log(+-0)=-inf */
- if (hx<0) return (x-x)/zero; /* log(-#) = NaN */
- k -= 25; x *= two25; /* subnormal number, scale up x */
- GET_FLOAT_WORD(hx,x);
- }
- if (hx >= 0x7f800000) return x+x;
- k += (hx>>23)-127;
- i = ((uint32_t)k&0x80000000)>>31;
- hx = (hx&0x007fffff)|((0x7f-i)<<23);
- y = (float)(k+i);
- SET_FLOAT_WORD(x,hx);
- z = y*log10_2lo + ivln10*logf(x);
- return z+y*log10_2hi;
-}
+++ /dev/null
-/* e_logf.c -- float version of e_log.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-ln2_hi = 6.9313812256e-01, /* 0x3f317180 */
-ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */
-two25 = 3.355443200e+07, /* 0x4c000000 */
-Lg1 = 6.6666668653e-01, /* 3F2AAAAB */
-Lg2 = 4.0000000596e-01, /* 3ECCCCCD */
-Lg3 = 2.8571429849e-01, /* 3E924925 */
-Lg4 = 2.2222198546e-01, /* 3E638E29 */
-Lg5 = 1.8183572590e-01, /* 3E3A3325 */
-Lg6 = 1.5313838422e-01, /* 3E1CD04F */
-Lg7 = 1.4798198640e-01; /* 3E178897 */
-
-static const float zero = 0.0;
-
-float
-logf(float x)
-{
- float hfsq,f,s,z,R,w,t1,t2,dk;
- int32_t k,ix,i,j;
-
- GET_FLOAT_WORD(ix,x);
-
- k=0;
- if (ix < 0x00800000) { /* x < 2**-126 */
- if ((ix&0x7fffffff)==0)
- return -two25/zero; /* log(+-0)=-inf */
- if (ix<0) return (x-x)/zero; /* log(-#) = NaN */
- k -= 25; x *= two25; /* subnormal number, scale up x */
- GET_FLOAT_WORD(ix,x);
- }
- if (ix >= 0x7f800000) return x+x;
- k += (ix>>23)-127;
- ix &= 0x007fffff;
- i = (ix+(0x95f64<<3))&0x800000;
- SET_FLOAT_WORD(x,ix|(i^0x3f800000)); /* normalize x or x/2 */
- k += (i>>23);
- f = x-(float)1.0;
- if((0x007fffff&(15+ix))<16) { /* |f| < 2**-20 */
- if(f==zero) { if(k==0) return zero; else {dk=(float)k;
- return dk*ln2_hi+dk*ln2_lo;} }
- R = f*f*((float)0.5-(float)0.33333333333333333*f);
- if(k==0) return f-R; else {dk=(float)k;
- return dk*ln2_hi-((R-dk*ln2_lo)-f);}
- }
- s = f/((float)2.0+f);
- dk = (float)k;
- z = s*s;
- i = ix-(0x6147a<<3);
- w = z*z;
- j = (0x6b851<<3)-ix;
- t1= w*(Lg2+w*(Lg4+w*Lg6));
- t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7)));
- i |= j;
- R = t2+t1;
- if(i>0) {
- hfsq=(float)0.5*f*f;
- if(k==0) return f-(hfsq-s*(hfsq+R)); else
- return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f);
- } else {
- if(k==0) return f-s*(f-R); else
- return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f);
- }
-}
+++ /dev/null
-/* @(#)e_pow.c 1.5 04/04/22 SMI */
-/*
- * ====================================================
- * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
- *
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* pow(x,y) return x**y
- *
- * n
- * Method: Let x = 2 * (1+f)
- * 1. Compute and return log2(x) in two pieces:
- * log2(x) = w1 + w2,
- * where w1 has 53-24 = 29 bit trailing zeros.
- * 2. Perform y*log2(x) = n+y' by simulating muti-precision
- * arithmetic, where |y'|<=0.5.
- * 3. Return x**y = 2**n*exp(y'*log2)
- *
- * Special cases:
- * 1. (anything) ** 0 is 1
- * 2. (anything) ** 1 is itself
- * 3. (anything) ** NAN is NAN
- * 4. NAN ** (anything except 0) is NAN
- * 5. +-(|x| > 1) ** +INF is +INF
- * 6. +-(|x| > 1) ** -INF is +0
- * 7. +-(|x| < 1) ** +INF is +0
- * 8. +-(|x| < 1) ** -INF is +INF
- * 9. +-1 ** +-INF is NAN
- * 10. +0 ** (+anything except 0, NAN) is +0
- * 11. -0 ** (+anything except 0, NAN, odd integer) is +0
- * 12. +0 ** (-anything except 0, NAN) is +INF
- * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF
- * 14. -0 ** (odd integer) = -( +0 ** (odd integer) )
- * 15. +INF ** (+anything except 0,NAN) is +INF
- * 16. +INF ** (-anything except 0,NAN) is +0
- * 17. -INF ** (anything) = -0 ** (-anything)
- * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer)
- * 19. (-anything except 0 and inf) ** (non-integer) is NAN
- *
- * Accuracy:
- * pow(x,y) returns x**y nearly rounded. In particular
- * pow(integer,integer)
- * always returns the correct integer provided it is
- * representable.
- *
- * Constants :
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-bp[] = {1.0, 1.5,},
-dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */
-dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */
-zero = 0.0,
-one = 1.0,
-two = 2.0,
-two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */
-huge = 1.0e300,
-tiny = 1.0e-300,
- /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
-L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */
-L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */
-L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */
-L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */
-L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */
-L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */
-P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
-P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
-P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
-P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
-P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */
-lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
-lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */
-lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */
-ovt = 8.0085662595372944372e-0017, /* -(1024-log2(ovfl+.5ulp)) */
-cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */
-cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */
-cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/
-ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */
-ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/
-ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/
-
-double
-pow(double x, double y)
-{
- double z,ax,z_h,z_l,p_h,p_l;
- double y1,t1,t2,r,s,t,u,v,w;
- int32_t i,j,k,yisint,n;
- int32_t hx,hy,ix,iy;
- uint32_t lx,ly;
-
- EXTRACT_WORDS(hx,lx,x);
- EXTRACT_WORDS(hy,ly,y);
- ix = hx&0x7fffffff; iy = hy&0x7fffffff;
-
- /* y==zero: x**0 = 1 */
- if((iy|ly)==0) return one;
-
- /* +-NaN return x+y */
- if(ix > 0x7ff00000 || ((ix==0x7ff00000)&&(lx!=0)) ||
- iy > 0x7ff00000 || ((iy==0x7ff00000)&&(ly!=0)))
- return x+y;
-
- /* determine if y is an odd int when x < 0
- * yisint = 0 ... y is not an integer
- * yisint = 1 ... y is an odd int
- * yisint = 2 ... y is an even int
- */
- yisint = 0;
- if(hx<0) {
- if(iy>=0x43400000) yisint = 2; /* even integer y */
- else if(iy>=0x3ff00000) {
- k = (iy>>20)-0x3ff; /* exponent */
- if(k>20) {
- j = ly>>(52-k);
- if((j<<(52-k))==ly) yisint = 2-(j&1);
- } else if(ly==0) {
- j = iy>>(20-k);
- if((j<<(20-k))==iy) yisint = 2-(j&1);
- }
- }
- }
-
- /* special value of y */
- if(ly==0) {
- if (iy==0x7ff00000) { /* y is +-inf */
- if(((ix-0x3ff00000)|lx)==0)
- return y - y; /* inf**+-1 is NaN */
- else if (ix >= 0x3ff00000)/* (|x|>1)**+-inf = inf,0 */
- return (hy>=0)? y: zero;
- else /* (|x|<1)**-,+inf = inf,0 */
- return (hy<0)?-y: zero;
- }
- if(iy==0x3ff00000) { /* y is +-1 */
- if(hy<0) return one/x; else return x;
- }
- if(hy==0x40000000) return x*x; /* y is 2 */
- if(hy==0x3fe00000) { /* y is 0.5 */
- if(hx>=0) /* x >= +0 */
- return sqrt(x);
- }
- }
-
- ax = fabs(x);
- /* special value of x */
- if(lx==0) {
- if(ix==0x7ff00000||ix==0||ix==0x3ff00000){
- z = ax; /*x is +-0,+-inf,+-1*/
- if(hy<0) z = one/z; /* z = (1/|x|) */
- if(hx<0) {
- if(((ix-0x3ff00000)|yisint)==0) {
- z = (z-z)/(z-z); /* (-1)**non-int is NaN */
- } else if(yisint==1)
- z = -z; /* (x<0)**odd = -(|x|**odd) */
- }
- return z;
- }
- }
-
- /* CYGNUS LOCAL + fdlibm-5.3 fix: This used to be
- n = (hx>>31)+1;
- but ANSI C says a right shift of a signed negative quantity is
- implementation defined. */
- n = ((uint32_t)hx>>31)-1;
-
- /* (x<0)**(non-int) is NaN */
- if((n|yisint)==0) return (x-x)/(x-x);
-
- s = one; /* s (sign of result -ve**odd) = -1 else = 1 */
- if((n|(yisint-1))==0) s = -one;/* (-ve)**(odd int) */
-
- /* |y| is huge */
- if(iy>0x41e00000) { /* if |y| > 2**31 */
- if(iy>0x43f00000){ /* if |y| > 2**64, must o/uflow */
- if(ix<=0x3fefffff) return (hy<0)? huge*huge:tiny*tiny;
- if(ix>=0x3ff00000) return (hy>0)? huge*huge:tiny*tiny;
- }
- /* over/underflow if x is not close to one */
- if(ix<0x3fefffff) return (hy<0)? s*huge*huge:s*tiny*tiny;
- if(ix>0x3ff00000) return (hy>0)? s*huge*huge:s*tiny*tiny;
- /* now |1-x| is tiny <= 2**-20, suffice to compute
- log(x) by x-x^2/2+x^3/3-x^4/4 */
- t = ax-one; /* t has 20 trailing zeros */
- w = (t*t)*(0.5-t*(0.3333333333333333333333-t*0.25));
- u = ivln2_h*t; /* ivln2_h has 21 sig. bits */
- v = t*ivln2_l-w*ivln2;
- t1 = u+v;
- SET_LOW_WORD(t1,0);
- t2 = v-(t1-u);
- } else {
- double ss,s2,s_h,s_l,t_h,t_l;
- n = 0;
- /* take care subnormal number */
- if(ix<0x00100000)
- {ax *= two53; n -= 53; GET_HIGH_WORD(ix,ax); }
- n += ((ix)>>20)-0x3ff;
- j = ix&0x000fffff;
- /* determine interval */
- ix = j|0x3ff00000; /* normalize ix */
- if(j<=0x3988E) k=0; /* |x|<sqrt(3/2) */
- else if(j<0xBB67A) k=1; /* |x|<sqrt(3) */
- else {k=0;n+=1;ix -= 0x00100000;}
- SET_HIGH_WORD(ax,ix);
-
- /* compute ss = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
- u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
- v = one/(ax+bp[k]);
- ss = u*v;
- s_h = ss;
- SET_LOW_WORD(s_h,0);
- /* t_h=ax+bp[k] High */
- t_h = zero;
- SET_HIGH_WORD(t_h,((ix>>1)|0x20000000)+0x00080000+(k<<18));
- t_l = ax - (t_h-bp[k]);
- s_l = v*((u-s_h*t_h)-s_h*t_l);
- /* compute log(ax) */
- s2 = ss*ss;
- r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6)))));
- r += s_l*(s_h+ss);
- s2 = s_h*s_h;
- t_h = 3.0+s2+r;
- SET_LOW_WORD(t_h,0);
- t_l = r-((t_h-3.0)-s2);
- /* u+v = ss*(1+...) */
- u = s_h*t_h;
- v = s_l*t_h+t_l*ss;
- /* 2/(3log2)*(ss+...) */
- p_h = u+v;
- SET_LOW_WORD(p_h,0);
- p_l = v-(p_h-u);
- z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */
- z_l = cp_l*p_h+p_l*cp+dp_l[k];
- /* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */
- t = (double)n;
- t1 = (((z_h+z_l)+dp_h[k])+t);
- SET_LOW_WORD(t1,0);
- t2 = z_l-(((t1-t)-dp_h[k])-z_h);
- }
-
- /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
- y1 = y;
- SET_LOW_WORD(y1,0);
- p_l = (y-y1)*t1+y*t2;
- p_h = y1*t1;
- z = p_l+p_h;
- EXTRACT_WORDS(j,i,z);
- if (j>=0x40900000) { /* z >= 1024 */
- if(((j-0x40900000)|i)!=0) /* if z > 1024 */
- return s*huge*huge; /* overflow */
- else {
- if(p_l+ovt>z-p_h) return s*huge*huge; /* overflow */
- }
- } else if((j&0x7fffffff)>=0x4090cc00 ) { /* z <= -1075 */
- if(((j-0xc090cc00)|i)!=0) /* z < -1075 */
- return s*tiny*tiny; /* underflow */
- else {
- if(p_l<=z-p_h) return s*tiny*tiny; /* underflow */
- }
- }
- /*
- * compute 2**(p_h+p_l)
- */
- i = j&0x7fffffff;
- k = (i>>20)-0x3ff;
- n = 0;
- if(i>0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */
- n = j+(0x00100000>>(k+1));
- k = ((n&0x7fffffff)>>20)-0x3ff; /* new k for n */
- t = zero;
- SET_HIGH_WORD(t,n&~(0x000fffff>>k));
- n = ((n&0x000fffff)|0x00100000)>>(20-k);
- if(j<0) n = -n;
- p_h -= t;
- }
- t = p_l+p_h;
- SET_LOW_WORD(t,0);
- u = t*lg2_h;
- v = (p_l-(t-p_h))*lg2+t*lg2_l;
- z = u+v;
- w = v-(z-u);
- t = z*z;
- t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
- r = (z*t1)/(t1-two)-(w+z*w);
- z = one-(r-z);
- GET_HIGH_WORD(j,z);
- j += (n<<20);
- if((j>>20)<=0) z = scalbn(z,n); /* subnormal output */
- else SET_HIGH_WORD(z,j);
- return s*z;
-}
+++ /dev/null
-/* e_powf.c -- float version of e_pow.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-bp[] = {1.0, 1.5,},
-dp_h[] = { 0.0, 5.84960938e-01,}, /* 0x3f15c000 */
-dp_l[] = { 0.0, 1.56322085e-06,}, /* 0x35d1cfdc */
-zero = 0.0,
-one = 1.0,
-two = 2.0,
-two24 = 16777216.0, /* 0x4b800000 */
-huge = 1.0e30,
-tiny = 1.0e-30,
- /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
-L1 = 6.0000002384e-01, /* 0x3f19999a */
-L2 = 4.2857143283e-01, /* 0x3edb6db7 */
-L3 = 3.3333334327e-01, /* 0x3eaaaaab */
-L4 = 2.7272811532e-01, /* 0x3e8ba305 */
-L5 = 2.3066075146e-01, /* 0x3e6c3255 */
-L6 = 2.0697501302e-01, /* 0x3e53f142 */
-P1 = 1.6666667163e-01, /* 0x3e2aaaab */
-P2 = -2.7777778450e-03, /* 0xbb360b61 */
-P3 = 6.6137559770e-05, /* 0x388ab355 */
-P4 = -1.6533901999e-06, /* 0xb5ddea0e */
-P5 = 4.1381369442e-08, /* 0x3331bb4c */
-lg2 = 6.9314718246e-01, /* 0x3f317218 */
-lg2_h = 6.93145752e-01, /* 0x3f317200 */
-lg2_l = 1.42860654e-06, /* 0x35bfbe8c */
-ovt = 4.2995665694e-08, /* -(128-log2(ovfl+.5ulp)) */
-cp = 9.6179670095e-01, /* 0x3f76384f =2/(3ln2) */
-cp_h = 9.6179199219e-01, /* 0x3f763800 =head of cp */
-cp_l = 4.7017383622e-06, /* 0x369dc3a0 =tail of cp_h */
-ivln2 = 1.4426950216e+00, /* 0x3fb8aa3b =1/ln2 */
-ivln2_h = 1.4426879883e+00, /* 0x3fb8aa00 =16b 1/ln2*/
-ivln2_l = 7.0526075433e-06; /* 0x36eca570 =1/ln2 tail*/
-
-float
-powf(float x, float y)
-{
- float z,ax,z_h,z_l,p_h,p_l;
- float y1,t1,t2,r,s,sn,t,u,v,w;
- int32_t i,j,k,yisint,n;
- int32_t hx,hy,ix,iy,is;
-
- GET_FLOAT_WORD(hx,x);
- GET_FLOAT_WORD(hy,y);
- ix = hx&0x7fffffff; iy = hy&0x7fffffff;
-
- /* y==zero: x**0 = 1 */
- if(iy==0) return one;
-
- /* +-NaN return x+y */
- if(ix > 0x7f800000 ||
- iy > 0x7f800000)
- return x+y;
-
- /* determine if y is an odd int when x < 0
- * yisint = 0 ... y is not an integer
- * yisint = 1 ... y is an odd int
- * yisint = 2 ... y is an even int
- */
- yisint = 0;
- if(hx<0) {
- if(iy>=0x4b800000) yisint = 2; /* even integer y */
- else if(iy>=0x3f800000) {
- k = (iy>>23)-0x7f; /* exponent */
- j = iy>>(23-k);
- if((j<<(23-k))==iy) yisint = 2-(j&1);
- }
- }
-
- /* special value of y */
- if (iy==0x7f800000) { /* y is +-inf */
- if (ix==0x3f800000)
- return y - y; /* inf**+-1 is NaN */
- else if (ix > 0x3f800000)/* (|x|>1)**+-inf = inf,0 */
- return (hy>=0)? y: zero;
- else /* (|x|<1)**-,+inf = inf,0 */
- return (hy<0)?-y: zero;
- }
- if(iy==0x3f800000) { /* y is +-1 */
- if(hy<0) return one/x; else return x;
- }
- if(hy==0x40000000) return x*x; /* y is 2 */
- if(hy==0x3f000000) { /* y is 0.5 */
- if(hx>=0) /* x >= +0 */
- return sqrtf(x);
- }
-
- ax = fabsf(x);
- /* special value of x */
- if(ix==0x7f800000||ix==0||ix==0x3f800000){
- z = ax; /*x is +-0,+-inf,+-1*/
- if(hy<0) z = one/z; /* z = (1/|x|) */
- if(hx<0) {
- if(((ix-0x3f800000)|yisint)==0) {
- z = (z-z)/(z-z); /* (-1)**non-int is NaN */
- } else if(yisint==1)
- z = -z; /* (x<0)**odd = -(|x|**odd) */
- }
- return z;
- }
-
- n = ((uint32_t)hx>>31)-1;
-
- /* (x<0)**(non-int) is NaN */
- if((n|yisint)==0) return (x-x)/(x-x);
-
- sn = one; /* s (sign of result -ve**odd) = -1 else = 1 */
- if((n|(yisint-1))==0) sn = -one;/* (-ve)**(odd int) */
-
- /* |y| is huge */
- if(iy>0x4d000000) { /* if |y| > 2**27 */
- /* over/underflow if x is not close to one */
- if(ix<0x3f7ffff8) return (hy<0)? sn*huge*huge:sn*tiny*tiny;
- if(ix>0x3f800007) return (hy>0)? sn*huge*huge:sn*tiny*tiny;
- /* now |1-x| is tiny <= 2**-20, suffice to compute
- log(x) by x-x^2/2+x^3/3-x^4/4 */
- t = ax-1; /* t has 20 trailing zeros */
- w = (t*t)*((float)0.5-t*((float)0.333333333333-t*(float)0.25));
- u = ivln2_h*t; /* ivln2_h has 16 sig. bits */
- v = t*ivln2_l-w*ivln2;
- t1 = u+v;
- GET_FLOAT_WORD(is,t1);
- SET_FLOAT_WORD(t1,is&0xfffff000);
- t2 = v-(t1-u);
- } else {
- float s2,s_h,s_l,t_h,t_l;
- n = 0;
- /* take care subnormal number */
- if(ix<0x00800000)
- {ax *= two24; n -= 24; GET_FLOAT_WORD(ix,ax); }
- n += ((ix)>>23)-0x7f;
- j = ix&0x007fffff;
- /* determine interval */
- ix = j|0x3f800000; /* normalize ix */
- if(j<=0x1cc471) k=0; /* |x|<sqrt(3/2) */
- else if(j<0x5db3d7) k=1; /* |x|<sqrt(3) */
- else {k=0;n+=1;ix -= 0x00800000;}
- SET_FLOAT_WORD(ax,ix);
-
- /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
- u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
- v = one/(ax+bp[k]);
- s = u*v;
- s_h = s;
- GET_FLOAT_WORD(is,s_h);
- SET_FLOAT_WORD(s_h,is&0xfffff000);
- /* t_h=ax+bp[k] High */
- is = ((ix>>1)&0xfffff000)|0x20000000;
- SET_FLOAT_WORD(t_h,is+0x00400000+(k<<21));
- t_l = ax - (t_h-bp[k]);
- s_l = v*((u-s_h*t_h)-s_h*t_l);
- /* compute log(ax) */
- s2 = s*s;
- r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6)))));
- r += s_l*(s_h+s);
- s2 = s_h*s_h;
- t_h = (float)3.0+s2+r;
- GET_FLOAT_WORD(is,t_h);
- SET_FLOAT_WORD(t_h,is&0xfffff000);
- t_l = r-((t_h-(float)3.0)-s2);
- /* u+v = s*(1+...) */
- u = s_h*t_h;
- v = s_l*t_h+t_l*s;
- /* 2/(3log2)*(s+...) */
- p_h = u+v;
- GET_FLOAT_WORD(is,p_h);
- SET_FLOAT_WORD(p_h,is&0xfffff000);
- p_l = v-(p_h-u);
- z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */
- z_l = cp_l*p_h+p_l*cp+dp_l[k];
- /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */
- t = (float)n;
- t1 = (((z_h+z_l)+dp_h[k])+t);
- GET_FLOAT_WORD(is,t1);
- SET_FLOAT_WORD(t1,is&0xfffff000);
- t2 = z_l-(((t1-t)-dp_h[k])-z_h);
- }
-
- /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
- GET_FLOAT_WORD(is,y);
- SET_FLOAT_WORD(y1,is&0xfffff000);
- p_l = (y-y1)*t1+y*t2;
- p_h = y1*t1;
- z = p_l+p_h;
- GET_FLOAT_WORD(j,z);
- if (j>0x43000000) /* if z > 128 */
- return sn*huge*huge; /* overflow */
- else if (j==0x43000000) { /* if z == 128 */
- if(p_l+ovt>z-p_h) return sn*huge*huge; /* overflow */
- }
- else if ((j&0x7fffffff)>0x43160000) /* z <= -150 */
- return sn*tiny*tiny; /* underflow */
- else if (j==0xc3160000){ /* z == -150 */
- if(p_l<=z-p_h) return sn*tiny*tiny; /* underflow */
- }
- /*
- * compute 2**(p_h+p_l)
- */
- i = j&0x7fffffff;
- k = (i>>23)-0x7f;
- n = 0;
- if(i>0x3f000000) { /* if |z| > 0.5, set n = [z+0.5] */
- n = j+(0x00800000>>(k+1));
- k = ((n&0x7fffffff)>>23)-0x7f; /* new k for n */
- SET_FLOAT_WORD(t,n&~(0x007fffff>>k));
- n = ((n&0x007fffff)|0x00800000)>>(23-k);
- if(j<0) n = -n;
- p_h -= t;
- }
- t = p_l+p_h;
- GET_FLOAT_WORD(is,t);
- SET_FLOAT_WORD(t,is&0xffff8000);
- u = t*lg2_h;
- v = (p_l-(t-p_h))*lg2+t*lg2_l;
- z = u+v;
- w = v-(z-u);
- t = z*z;
- t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
- r = (z*t1)/(t1-two)-(w+z*w);
- z = one-(r-z);
- GET_FLOAT_WORD(j,z);
- j += (n<<23);
- if((j>>23)<=0) z = scalbnf(z,n); /* subnormal output */
- else SET_FLOAT_WORD(z,j);
- return sn*z;
-}
+++ /dev/null
-
-/* @(#)e_rem_pio2.c 1.4 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- *
- */
-
-/* __ieee754_rem_pio2(x,y)
- *
- * return the remainder of x rem pi/2 in y[0]+y[1]
- * use __kernel_rem_pio2()
- */
-
-#include <math.h>
-#include "math_private.h"
-
-/*
- * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi
- */
-static const int32_t two_over_pi[] = {
-0xA2F983, 0x6E4E44, 0x1529FC, 0x2757D1, 0xF534DD, 0xC0DB62,
-0x95993C, 0x439041, 0xFE5163, 0xABDEBB, 0xC561B7, 0x246E3A,
-0x424DD2, 0xE00649, 0x2EEA09, 0xD1921C, 0xFE1DEB, 0x1CB129,
-0xA73EE8, 0x8235F5, 0x2EBB44, 0x84E99C, 0x7026B4, 0x5F7E41,
-0x3991D6, 0x398353, 0x39F49C, 0x845F8B, 0xBDF928, 0x3B1FF8,
-0x97FFDE, 0x05980F, 0xEF2F11, 0x8B5A0A, 0x6D1F6D, 0x367ECF,
-0x27CB09, 0xB74F46, 0x3F669E, 0x5FEA2D, 0x7527BA, 0xC7EBE5,
-0xF17B3D, 0x0739F7, 0x8A5292, 0xEA6BFB, 0x5FB11F, 0x8D5D08,
-0x560330, 0x46FC7B, 0x6BABF0, 0xCFBC20, 0x9AF436, 0x1DA9E3,
-0x91615E, 0xE61B08, 0x659985, 0x5F14A0, 0x68408D, 0xFFD880,
-0x4D7327, 0x310606, 0x1556CA, 0x73A8C9, 0x60E27B, 0xC08C6B,
-};
-
-static const int32_t npio2_hw[] = {
-0x3FF921FB, 0x400921FB, 0x4012D97C, 0x401921FB, 0x401F6A7A, 0x4022D97C,
-0x4025FDBB, 0x402921FB, 0x402C463A, 0x402F6A7A, 0x4031475C, 0x4032D97C,
-0x40346B9C, 0x4035FDBB, 0x40378FDB, 0x403921FB, 0x403AB41B, 0x403C463A,
-0x403DD85A, 0x403F6A7A, 0x40407E4C, 0x4041475C, 0x4042106C, 0x4042D97C,
-0x4043A28C, 0x40446B9C, 0x404534AC, 0x4045FDBB, 0x4046C6CB, 0x40478FDB,
-0x404858EB, 0x404921FB,
-};
-
-/*
- * invpio2: 53 bits of 2/pi
- * pio2_1: first 33 bit of pi/2
- * pio2_1t: pi/2 - pio2_1
- * pio2_2: second 33 bit of pi/2
- * pio2_2t: pi/2 - (pio2_1+pio2_2)
- * pio2_3: third 33 bit of pi/2
- * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
- */
-
-static const double
-zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
-half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
-two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
-invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
-pio2_1 = 1.57079632673412561417e+00, /* 0x3FF921FB, 0x54400000 */
-pio2_1t = 6.07710050650619224932e-11, /* 0x3DD0B461, 0x1A626331 */
-pio2_2 = 6.07710050630396597660e-11, /* 0x3DD0B461, 0x1A600000 */
-pio2_2t = 2.02226624879595063154e-21, /* 0x3BA3198A, 0x2E037073 */
-pio2_3 = 2.02226624871116645580e-21, /* 0x3BA3198A, 0x2E000000 */
-pio2_3t = 8.47842766036889956997e-32; /* 0x397B839A, 0x252049C1 */
-
-int32_t __ieee754_rem_pio2(double x, double *y)
-{
- double z,w,t,r,fn;
- double tx[3];
- int32_t e0,i,j,nx,n,ix,hx;
- uint32_t low;
-
- GET_HIGH_WORD(hx,x); /* high word of x */
- ix = hx&0x7fffffff;
- if(ix<=0x3fe921fb) /* |x| ~<= pi/4 , no need for reduction */
- {y[0] = x; y[1] = 0; return 0;}
- if(ix<0x4002d97c) { /* |x| < 3pi/4, special case with n=+-1 */
- if(hx>0) {
- z = x - pio2_1;
- if(ix!=0x3ff921fb) { /* 33+53 bit pi is good enough */
- y[0] = z - pio2_1t;
- y[1] = (z-y[0])-pio2_1t;
- } else { /* near pi/2, use 33+33+53 bit pi */
- z -= pio2_2;
- y[0] = z - pio2_2t;
- y[1] = (z-y[0])-pio2_2t;
- }
- return 1;
- } else { /* negative x */
- z = x + pio2_1;
- if(ix!=0x3ff921fb) { /* 33+53 bit pi is good enough */
- y[0] = z + pio2_1t;
- y[1] = (z-y[0])+pio2_1t;
- } else { /* near pi/2, use 33+33+53 bit pi */
- z += pio2_2;
- y[0] = z + pio2_2t;
- y[1] = (z-y[0])+pio2_2t;
- }
- return -1;
- }
- }
- if(ix<=0x413921fb) { /* |x| ~<= 2^19*(pi/2), medium size */
- t = fabs(x);
- n = (int32_t) (t*invpio2+half);
- fn = (double)n;
- r = t-fn*pio2_1;
- w = fn*pio2_1t; /* 1st round good to 85 bit */
- if(n<32&&ix!=npio2_hw[n-1]) {
- y[0] = r-w; /* quick check no cancellation */
- } else {
- uint32_t high;
- j = ix>>20;
- y[0] = r-w;
- GET_HIGH_WORD(high,y[0]);
- i = j-((high>>20)&0x7ff);
- if(i>16) { /* 2nd iteration needed, good to 118 */
- t = r;
- w = fn*pio2_2;
- r = t-w;
- w = fn*pio2_2t-((t-r)-w);
- y[0] = r-w;
- GET_HIGH_WORD(high,y[0]);
- i = j-((high>>20)&0x7ff);
- if(i>49) { /* 3rd iteration need, 151 bits acc */
- t = r; /* will cover all possible cases */
- w = fn*pio2_3;
- r = t-w;
- w = fn*pio2_3t-((t-r)-w);
- y[0] = r-w;
- }
- }
- }
- y[1] = (r-y[0])-w;
- if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;}
- else return n;
- }
- /*
- * all other (large) arguments
- */
- if(ix>=0x7ff00000) { /* x is inf or NaN */
- y[0]=y[1]=x-x; return 0;
- }
- /* set z = scalbn(|x|,ilogb(x)-23) */
- GET_LOW_WORD(low,x);
- e0 = (ix>>20)-1046; /* e0 = ilogb(z)-23; */
- INSERT_WORDS(z, ix - ((int32_t)(e0<<20)), low);
- for(i=0;i<2;i++) {
- tx[i] = (double)((int32_t)(z));
- z = (z-tx[i])*two24;
- }
- tx[2] = z;
- nx = 3;
- while(tx[nx-1]==zero) nx--; /* skip zero term */
- n = __kernel_rem_pio2(tx,y,e0,nx,2,two_over_pi);
- if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;}
- return n;
-}
+++ /dev/null
-/* e_rem_pio2f.c -- float version of e_rem_pio2.c
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* __ieee754_rem_pio2f(x,y)
- *
- * return the remainder of x rem pi/2 in y[0]+y[1]
- * use __kernel_rem_pio2f()
- */
-
-#include <math.h>
-#include "math_private.h"
-
-/*
- * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi
- */
-static const int32_t two_over_pi[] = {
-0xA2, 0xF9, 0x83, 0x6E, 0x4E, 0x44, 0x15, 0x29, 0xFC,
-0x27, 0x57, 0xD1, 0xF5, 0x34, 0xDD, 0xC0, 0xDB, 0x62,
-0x95, 0x99, 0x3C, 0x43, 0x90, 0x41, 0xFE, 0x51, 0x63,
-0xAB, 0xDE, 0xBB, 0xC5, 0x61, 0xB7, 0x24, 0x6E, 0x3A,
-0x42, 0x4D, 0xD2, 0xE0, 0x06, 0x49, 0x2E, 0xEA, 0x09,
-0xD1, 0x92, 0x1C, 0xFE, 0x1D, 0xEB, 0x1C, 0xB1, 0x29,
-0xA7, 0x3E, 0xE8, 0x82, 0x35, 0xF5, 0x2E, 0xBB, 0x44,
-0x84, 0xE9, 0x9C, 0x70, 0x26, 0xB4, 0x5F, 0x7E, 0x41,
-0x39, 0x91, 0xD6, 0x39, 0x83, 0x53, 0x39, 0xF4, 0x9C,
-0x84, 0x5F, 0x8B, 0xBD, 0xF9, 0x28, 0x3B, 0x1F, 0xF8,
-0x97, 0xFF, 0xDE, 0x05, 0x98, 0x0F, 0xEF, 0x2F, 0x11,
-0x8B, 0x5A, 0x0A, 0x6D, 0x1F, 0x6D, 0x36, 0x7E, 0xCF,
-0x27, 0xCB, 0x09, 0xB7, 0x4F, 0x46, 0x3F, 0x66, 0x9E,
-0x5F, 0xEA, 0x2D, 0x75, 0x27, 0xBA, 0xC7, 0xEB, 0xE5,
-0xF1, 0x7B, 0x3D, 0x07, 0x39, 0xF7, 0x8A, 0x52, 0x92,
-0xEA, 0x6B, 0xFB, 0x5F, 0xB1, 0x1F, 0x8D, 0x5D, 0x08,
-0x56, 0x03, 0x30, 0x46, 0xFC, 0x7B, 0x6B, 0xAB, 0xF0,
-0xCF, 0xBC, 0x20, 0x9A, 0xF4, 0x36, 0x1D, 0xA9, 0xE3,
-0x91, 0x61, 0x5E, 0xE6, 0x1B, 0x08, 0x65, 0x99, 0x85,
-0x5F, 0x14, 0xA0, 0x68, 0x40, 0x8D, 0xFF, 0xD8, 0x80,
-0x4D, 0x73, 0x27, 0x31, 0x06, 0x06, 0x15, 0x56, 0xCA,
-0x73, 0xA8, 0xC9, 0x60, 0xE2, 0x7B, 0xC0, 0x8C, 0x6B,
-};
-
-/* This array is like the one in e_rem_pio2.c, but the numbers are
- single precision and the last 8 bits are forced to 0. */
-static const int32_t npio2_hw[] = {
-0x3fc90f00, 0x40490f00, 0x4096cb00, 0x40c90f00, 0x40fb5300, 0x4116cb00,
-0x412fed00, 0x41490f00, 0x41623100, 0x417b5300, 0x418a3a00, 0x4196cb00,
-0x41a35c00, 0x41afed00, 0x41bc7e00, 0x41c90f00, 0x41d5a000, 0x41e23100,
-0x41eec200, 0x41fb5300, 0x4203f200, 0x420a3a00, 0x42108300, 0x4216cb00,
-0x421d1400, 0x42235c00, 0x4229a500, 0x422fed00, 0x42363600, 0x423c7e00,
-0x4242c700, 0x42490f00
-};
-
-/*
- * invpio2: 24 bits of 2/pi
- * pio2_1: first 17 bit of pi/2
- * pio2_1t: pi/2 - pio2_1
- * pio2_2: second 17 bit of pi/2
- * pio2_2t: pi/2 - (pio2_1+pio2_2)
- * pio2_3: third 17 bit of pi/2
- * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
- */
-
-static const float
-zero = 0.0000000000e+00, /* 0x00000000 */
-half = 5.0000000000e-01, /* 0x3f000000 */
-two8 = 2.5600000000e+02, /* 0x43800000 */
-invpio2 = 6.3661980629e-01, /* 0x3f22f984 */
-pio2_1 = 1.5707855225e+00, /* 0x3fc90f80 */
-pio2_1t = 1.0804334124e-05, /* 0x37354443 */
-pio2_2 = 1.0804273188e-05, /* 0x37354400 */
-pio2_2t = 6.0770999344e-11, /* 0x2e85a308 */
-pio2_3 = 6.0770943833e-11, /* 0x2e85a300 */
-pio2_3t = 6.1232342629e-17; /* 0x248d3132 */
-
-int32_t __ieee754_rem_pio2f(float x, float *y)
-{
- float z,w,t,r,fn;
- float tx[3];
- int32_t e0,i,j,nx,n,ix,hx;
-
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix<=0x3f490fd8) /* |x| ~<= pi/4 , no need for reduction */
- {y[0] = x; y[1] = 0; return 0;}
- if(ix<0x4016cbe4) { /* |x| < 3pi/4, special case with n=+-1 */
- if(hx>0) {
- z = x - pio2_1;
- if((ix&0xfffffff0)!=0x3fc90fd0) { /* 24+24 bit pi OK */
- y[0] = z - pio2_1t;
- y[1] = (z-y[0])-pio2_1t;
- } else { /* near pi/2, use 24+24+24 bit pi */
- z -= pio2_2;
- y[0] = z - pio2_2t;
- y[1] = (z-y[0])-pio2_2t;
- }
- return 1;
- } else { /* negative x */
- z = x + pio2_1;
- if((ix&0xfffffff0)!=0x3fc90fd0) { /* 24+24 bit pi OK */
- y[0] = z + pio2_1t;
- y[1] = (z-y[0])+pio2_1t;
- } else { /* near pi/2, use 24+24+24 bit pi */
- z += pio2_2;
- y[0] = z + pio2_2t;
- y[1] = (z-y[0])+pio2_2t;
- }
- return -1;
- }
- }
- if(ix<=0x43490f80) { /* |x| ~<= 2^7*(pi/2), medium size */
- t = fabsf(x);
- n = (int32_t) (t*invpio2+half);
- fn = (float)n;
- r = t-fn*pio2_1;
- w = fn*pio2_1t; /* 1st round good to 40 bit */
- if(n<32&&(ix&0xffffff00)!=npio2_hw[n-1]) {
- y[0] = r-w; /* quick check no cancellation */
- } else {
- uint32_t high;
- j = ix>>23;
- y[0] = r-w;
- GET_FLOAT_WORD(high,y[0]);
- i = j-((high>>23)&0xff);
- if(i>8) { /* 2nd iteration needed, good to 57 */
- t = r;
- w = fn*pio2_2;
- r = t-w;
- w = fn*pio2_2t-((t-r)-w);
- y[0] = r-w;
- GET_FLOAT_WORD(high,y[0]);
- i = j-((high>>23)&0xff);
- if(i>25) { /* 3rd iteration need, 74 bits acc */
- t = r; /* will cover all possible cases */
- w = fn*pio2_3;
- r = t-w;
- w = fn*pio2_3t-((t-r)-w);
- y[0] = r-w;
- }
- }
- }
- y[1] = (r-y[0])-w;
- if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;}
- else return n;
- }
- /*
- * all other (large) arguments
- */
- if(ix>=0x7f800000) { /* x is inf or NaN */
- y[0]=y[1]=x-x; return 0;
- }
- /* set z = scalbn(|x|,ilogb(x)-7) */
- e0 = (ix>>23)-134; /* e0 = ilogb(z)-7; */
- SET_FLOAT_WORD(z, ix - ((int32_t)(e0<<23)));
- for(i=0;i<2;i++) {
- tx[i] = (float)((int32_t)(z));
- z = (z-tx[i])*two8;
- }
- tx[2] = z;
- nx = 3;
- while(tx[nx-1]==zero) nx--; /* skip zero term */
- n = __kernel_rem_pio2f(tx,y,e0,nx,2,two_over_pi);
- if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;}
- return n;
-}
+++ /dev/null
-
-/* @(#)e_remainder.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* remainder(x,p)
- * Return :
- * returns x REM p = x - [x/p]*p as if in infinite
- * precise arithmetic, where [x/p] is the (infinite bit)
- * integer nearest x/p (in half way case choose the even one).
- * Method :
- * Based on fmod() return x-[x/p]chopped*p exactlp.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double zero = 0.0;
-
-
-double
-remainder(double x, double p)
-{
- int32_t hx,hp;
- uint32_t sx,lx,lp;
- double p_half;
-
- EXTRACT_WORDS(hx,lx,x);
- EXTRACT_WORDS(hp,lp,p);
- sx = hx&0x80000000;
- hp &= 0x7fffffff;
- hx &= 0x7fffffff;
-
- /* purge off exception values */
- if((hp|lp)==0) return (x*p)/(x*p); /* p = 0 */
- if((hx>=0x7ff00000)|| /* x not finite */
- ((hp>=0x7ff00000)&& /* p is NaN */
- (((hp-0x7ff00000)|lp)!=0)))
- return (x*p)/(x*p);
-
-
- if (hp<=0x7fdfffff) x = fmod(x,p+p); /* now x < 2p */
- if (((hx-hp)|(lx-lp))==0) return zero*x;
- x = fabs(x);
- p = fabs(p);
- if (hp<0x00200000) {
- if(x+x>p) {
- x-=p;
- if(x+x>=p) x -= p;
- }
- } else {
- p_half = 0.5*p;
- if(x>p_half) {
- x-=p;
- if(x>=p_half) x -= p;
- }
- }
- GET_HIGH_WORD(hx,x);
- SET_HIGH_WORD(x,hx^sx);
- return x;
-}
+++ /dev/null
-/* e_remainderf.c -- float version of e_remainder.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float zero = 0.0;
-
-
-float
-remainderf(float x, float p)
-{
- int32_t hx,hp;
- uint32_t sx;
- float p_half;
-
- GET_FLOAT_WORD(hx,x);
- GET_FLOAT_WORD(hp,p);
- sx = hx&0x80000000;
- hp &= 0x7fffffff;
- hx &= 0x7fffffff;
-
- /* purge off exception values */
- if(hp==0) return (x*p)/(x*p); /* p = 0 */
- if((hx>=0x7f800000)|| /* x not finite */
- ((hp>0x7f800000))) /* p is NaN */
- return (x*p)/(x*p);
-
-
- if (hp<=0x7effffff) x = fmodf(x,p+p); /* now x < 2p */
- if ((hx-hp)==0) return zero*x;
- x = fabsf(x);
- p = fabsf(p);
- if (hp<0x01000000) {
- if(x+x>p) {
- x-=p;
- if(x+x>=p) x -= p;
- }
- } else {
- p_half = (float)0.5*p;
- if(x>p_half) {
- x-=p;
- if(x>=p_half) x -= p;
- }
- }
- GET_FLOAT_WORD(hx,x);
- SET_FLOAT_WORD(x,hx^sx);
- return x;
-}
+++ /dev/null
-
-/* @(#)e_scalb.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * scalb(x, fn) is provide for
- * passing various standard test suite. One
- * should use scalbn() instead.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-scalb(double x, double fn)
-{
- if (isnan(x)||isnan(fn)) return x*fn;
- if (!isfinite(fn)) {
- if(fn>0.0) return x*fn;
- else return x/(-fn);
- }
- if (rint(fn)!=fn) return (fn-fn)/(fn-fn);
- if ( fn > 65000.0) return scalbn(x, 65000);
- if (-fn > 65000.0) return scalbn(x,-65000);
- return scalbn(x,(int)fn);
-}
+++ /dev/null
-/* e_scalbf.c -- float version of e_scalb.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-scalbf(float x, float fn)
-{
- if (isnan(x)||isnan(fn)) return x*fn;
- if (!isfinite(fn)) {
- if(fn>(float)0.0) return x*fn;
- else return x/(-fn);
- }
- if (rintf(fn)!=fn) return (fn-fn)/(fn-fn);
- if ( fn > (float)65000.0) return scalbnf(x, 65000);
- if (-fn > (float)65000.0) return scalbnf(x,-65000);
- return scalbnf(x,(int)fn);
-}
+++ /dev/null
-
-/* @(#)e_sinh.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* sinh(x)
- * Method :
- * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2
- * 1. Replace x by |x| (sinh(-x) = -sinh(x)).
- * 2.
- * E + E/(E+1)
- * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x)
- * 2
- *
- * 22 <= x <= lnovft : sinh(x) := exp(x)/2
- * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2)
- * ln2ovft < x : sinh(x) := x*shuge (overflow)
- *
- * Special cases:
- * sinh(x) is |x| if x is +INF, -INF, or NaN.
- * only sinh(0)=0 is exact for finite x.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one = 1.0, shuge = 1.0e307;
-
-double
-sinh(double x)
-{
- double t,w,h;
- int32_t ix,jx;
- uint32_t lx;
-
- /* High word of |x|. */
- GET_HIGH_WORD(jx,x);
- ix = jx&0x7fffffff;
-
- /* x is INF or NaN */
- if(ix>=0x7ff00000) return x+x;
-
- h = 0.5;
- if (jx<0) h = -h;
- /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */
- if (ix < 0x40360000) { /* |x|<22 */
- if (ix<0x3e300000) /* |x|<2**-28 */
- if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */
- t = expm1(fabs(x));
- if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one));
- return h*(t+t/(t+one));
- }
-
- /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */
- if (ix < 0x40862E42) return h*exp(fabs(x));
-
- /* |x| in [log(maxdouble), overflowthresold] */
- GET_LOW_WORD(lx,x);
- if (ix<0x408633CE || ((ix==0x408633ce)&&(lx<=(uint32_t)0x8fb9f87d))) {
- w = exp(0.5*fabs(x));
- t = h*w;
- return t*w;
- }
-
- /* |x| > overflowthresold, sinh(x) overflow */
- return x*shuge;
-}
+++ /dev/null
-/* e_sinhf.c -- float version of e_sinh.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one = 1.0, shuge = 1.0e37;
-
-float
-sinhf(float x)
-{
- float t,w,h;
- int32_t ix,jx;
-
- GET_FLOAT_WORD(jx,x);
- ix = jx&0x7fffffff;
-
- /* x is INF or NaN */
- if(ix>=0x7f800000) return x+x;
-
- h = 0.5;
- if (jx<0) h = -h;
- /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */
- if (ix < 0x41b00000) { /* |x|<22 */
- if (ix<0x31800000) /* |x|<2**-28 */
- if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */
- t = expm1f(fabsf(x));
- if(ix<0x3f800000) return h*((float)2.0*t-t*t/(t+one));
- return h*(t+t/(t+one));
- }
-
- /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */
- if (ix < 0x42b17180) return h*expf(fabsf(x));
-
- /* |x| in [log(maxdouble), overflowthresold] */
- if (ix<=0x42b2d4fc) {
- w = expf((float)0.5*fabsf(x));
- t = h*w;
- return t*w;
- }
-
- /* |x| > overflowthresold, sinh(x) overflow */
- return x*shuge;
-}
+++ /dev/null
-
-/* @(#)e_sqrt.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* sqrt(x)
- * Return correctly rounded sqrt.
- * ------------------------------------------
- * | Use the hardware sqrt if you have one |
- * ------------------------------------------
- * Method:
- * Bit by bit method using integer arithmetic. (Slow, but portable)
- * 1. Normalization
- * Scale x to y in [1,4) with even powers of 2:
- * find an integer k such that 1 <= (y=x*2^(2k)) < 4, then
- * sqrt(x) = 2^k * sqrt(y)
- * 2. Bit by bit computation
- * Let q = sqrt(y) truncated to i bit after binary point (q = 1),
- * i 0
- * i+1 2
- * s = 2*q , and y = 2 * ( y - q ). (1)
- * i i i i
- *
- * To compute q from q , one checks whether
- * i+1 i
- *
- * -(i+1) 2
- * (q + 2 ) <= y. (2)
- * i
- * -(i+1)
- * If (2) is false, then q = q ; otherwise q = q + 2 .
- * i+1 i i+1 i
- *
- * With some algebric manipulation, it is not difficult to see
- * that (2) is equivalent to
- * -(i+1)
- * s + 2 <= y (3)
- * i i
- *
- * The advantage of (3) is that s and y can be computed by
- * i i
- * the following recurrence formula:
- * if (3) is false
- *
- * s = s , y = y ; (4)
- * i+1 i i+1 i
- *
- * otherwise,
- * -i -(i+1)
- * s = s + 2 , y = y - s - 2 (5)
- * i+1 i i+1 i i
- *
- * One may easily use induction to prove (4) and (5).
- * Note. Since the left hand side of (3) contain only i+2 bits,
- * it does not necessary to do a full (53-bit) comparison
- * in (3).
- * 3. Final rounding
- * After generating the 53 bits result, we compute one more bit.
- * Together with the remainder, we can decide whether the
- * result is exact, bigger than 1/2ulp, or less than 1/2ulp
- * (it will never equal to 1/2ulp).
- * The rounding mode can be detected by checking whether
- * huge + tiny is equal to huge, and whether huge - tiny is
- * equal to huge for some floating point number "huge" and "tiny".
- *
- * Special cases:
- * sqrt(+-0) = +-0 ... exact
- * sqrt(inf) = inf
- * sqrt(-ve) = NaN ... with invalid signal
- * sqrt(NaN) = NaN ... with invalid signal for signaling NaN
- *
- * Other methods : see the appended file at the end of the program below.
- *---------------
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one = 1.0, tiny=1.0e-300;
-
-double
-sqrt(double x)
-{
- double z;
- int32_t sign = (int)0x80000000;
- int32_t ix0,s0,q,m,t,i;
- uint32_t r,t1,s1,ix1,q1;
-
- EXTRACT_WORDS(ix0,ix1,x);
-
- /* take care of Inf and NaN */
- if((ix0&0x7ff00000)==0x7ff00000) {
- return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf
- sqrt(-inf)=sNaN */
- }
- /* take care of zero */
- if(ix0<=0) {
- if(((ix0&(~sign))|ix1)==0) return x;/* sqrt(+-0) = +-0 */
- else if(ix0<0)
- return (x-x)/(x-x); /* sqrt(-ve) = sNaN */
- }
- /* normalize x */
- m = (ix0>>20);
- if(m==0) { /* subnormal x */
- while(ix0==0) {
- m -= 21;
- ix0 |= (ix1>>11); ix1 <<= 21;
- }
- for(i=0;(ix0&0x00100000)==0;i++) ix0<<=1;
- m -= i-1;
- ix0 |= (ix1>>(32-i));
- ix1 <<= i;
- }
- m -= 1023; /* unbias exponent */
- ix0 = (ix0&0x000fffff)|0x00100000;
- if(m&1){ /* odd m, double x to make it even */
- ix0 += ix0 + ((ix1&sign)>>31);
- ix1 += ix1;
- }
- m >>= 1; /* m = [m/2] */
-
- /* generate sqrt(x) bit by bit */
- ix0 += ix0 + ((ix1&sign)>>31);
- ix1 += ix1;
- q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */
- r = 0x00200000; /* r = moving bit from right to left */
-
- while(r!=0) {
- t = s0+r;
- if(t<=ix0) {
- s0 = t+r;
- ix0 -= t;
- q += r;
- }
- ix0 += ix0 + ((ix1&sign)>>31);
- ix1 += ix1;
- r>>=1;
- }
-
- r = sign;
- while(r!=0) {
- t1 = s1+r;
- t = s0;
- if((t<ix0)||((t==ix0)&&(t1<=ix1))) {
- s1 = t1+r;
- if(((t1&sign)==sign)&&(s1&sign)==0) s0 += 1;
- ix0 -= t;
- if (ix1 < t1) ix0 -= 1;
- ix1 -= t1;
- q1 += r;
- }
- ix0 += ix0 + ((ix1&sign)>>31);
- ix1 += ix1;
- r>>=1;
- }
-
- /* use floating add to find out rounding direction */
- if((ix0|ix1)!=0) {
- z = one-tiny; /* trigger inexact flag */
- if (z>=one) {
- z = one+tiny;
- if (q1==(uint32_t)0xffffffff) { q1=0; q += 1;}
- else if (z>one) {
- if (q1==(uint32_t)0xfffffffe) q+=1;
- q1+=2;
- } else
- q1 += (q1&1);
- }
- }
- ix0 = (q>>1)+0x3fe00000;
- ix1 = q1>>1;
- if ((q&1)==1) ix1 |= sign;
- ix0 += (m <<20);
- INSERT_WORDS(z,ix0,ix1);
- return z;
-}
-
-/*
-Other methods (use floating-point arithmetic)
--------------
-(This is a copy of a drafted paper by Prof W. Kahan
-and K.C. Ng, written in May, 1986)
-
- Two algorithms are given here to implement sqrt(x)
- (IEEE double precision arithmetic) in software.
- Both supply sqrt(x) correctly rounded. The first algorithm (in
- Section A) uses newton iterations and involves four divisions.
- The second one uses reciproot iterations to avoid division, but
- requires more multiplications. Both algorithms need the ability
- to chop results of arithmetic operations instead of round them,
- and the INEXACT flag to indicate when an arithmetic operation
- is executed exactly with no roundoff error, all part of the
- standard (IEEE 754-1985). The ability to perform shift, add,
- subtract and logical AND operations upon 32-bit words is needed
- too, though not part of the standard.
-
-A. sqrt(x) by Newton Iteration
-
- (1) Initial approximation
-
- Let x0 and x1 be the leading and the trailing 32-bit words of
- a floating point number x (in IEEE double format) respectively
-
- 1 11 52 ...widths
- ------------------------------------------------------
- x: |s| e | f |
- ------------------------------------------------------
- msb lsb msb lsb ...order
-
-
- ------------------------ ------------------------
- x0: |s| e | f1 | x1: | f2 |
- ------------------------ ------------------------
-
- By performing shifts and subtracts on x0 and x1 (both regarded
- as integers), we obtain an 8-bit approximation of sqrt(x) as
- follows.
-
- k := (x0>>1) + 0x1ff80000;
- y0 := k - T1[31&(k>>15)]. ... y ~ sqrt(x) to 8 bits
- Here k is a 32-bit integer and T1[] is an integer array containing
- correction terms. Now magically the floating value of y (y's
- leading 32-bit word is y0, the value of its trailing word is 0)
- approximates sqrt(x) to almost 8-bit.
-
- Value of T1:
- static int T1[32]= {
- 0, 1024, 3062, 5746, 9193, 13348, 18162, 23592,
- 29598, 36145, 43202, 50740, 58733, 67158, 75992, 85215,
- 83599, 71378, 60428, 50647, 41945, 34246, 27478, 21581,
- 16499, 12183, 8588, 5674, 3403, 1742, 661, 130,};
-
- (2) Iterative refinement
-
- Apply Heron's rule three times to y, we have y approximates
- sqrt(x) to within 1 ulp (Unit in the Last Place):
-
- y := (y+x/y)/2 ... almost 17 sig. bits
- y := (y+x/y)/2 ... almost 35 sig. bits
- y := y-(y-x/y)/2 ... within 1 ulp
-
-
- Remark 1.
- Another way to improve y to within 1 ulp is:
-
- y := (y+x/y) ... almost 17 sig. bits to 2*sqrt(x)
- y := y - 0x00100006 ... almost 18 sig. bits to sqrt(x)
-
- 2
- (x-y )*y
- y := y + 2* ---------- ...within 1 ulp
- 2
- 3y + x
-
-
- This formula has one division fewer than the one above; however,
- it requires more multiplications and additions. Also x must be
- scaled in advance to avoid spurious overflow in evaluating the
- expression 3y*y+x. Hence it is not recommended uless division
- is slow. If division is very slow, then one should use the
- reciproot algorithm given in section B.
-
- (3) Final adjustment
-
- By twiddling y's last bit it is possible to force y to be
- correctly rounded according to the prevailing rounding mode
- as follows. Let r and i be copies of the rounding mode and
- inexact flag before entering the square root program. Also we
- use the expression y+-ulp for the next representable floating
- numbers (up and down) of y. Note that y+-ulp = either fixed
- point y+-1, or multiply y by nextafter(1,+-inf) in chopped
- mode.
-
- I := FALSE; ... reset INEXACT flag I
- R := RZ; ... set rounding mode to round-toward-zero
- z := x/y; ... chopped quotient, possibly inexact
- If(not I) then { ... if the quotient is exact
- if(z=y) {
- I := i; ... restore inexact flag
- R := r; ... restore rounded mode
- return sqrt(x):=y.
- } else {
- z := z - ulp; ... special rounding
- }
- }
- i := TRUE; ... sqrt(x) is inexact
- If (r=RN) then z=z+ulp ... rounded-to-nearest
- If (r=RP) then { ... round-toward-+inf
- y = y+ulp; z=z+ulp;
- }
- y := y+z; ... chopped sum
- y0:=y0-0x00100000; ... y := y/2 is correctly rounded.
- I := i; ... restore inexact flag
- R := r; ... restore rounded mode
- return sqrt(x):=y.
-
- (4) Special cases
-
- Square root of +inf, +-0, or NaN is itself;
- Square root of a negative number is NaN with invalid signal.
-
-
-B. sqrt(x) by Reciproot Iteration
-
- (1) Initial approximation
-
- Let x0 and x1 be the leading and the trailing 32-bit words of
- a floating point number x (in IEEE double format) respectively
- (see section A). By performing shifs and subtracts on x0 and y0,
- we obtain a 7.8-bit approximation of 1/sqrt(x) as follows.
-
- k := 0x5fe80000 - (x0>>1);
- y0:= k - T2[63&(k>>14)]. ... y ~ 1/sqrt(x) to 7.8 bits
-
- Here k is a 32-bit integer and T2[] is an integer array
- containing correction terms. Now magically the floating
- value of y (y's leading 32-bit word is y0, the value of
- its trailing word y1 is set to zero) approximates 1/sqrt(x)
- to almost 7.8-bit.
-
- Value of T2:
- static int T2[64]= {
- 0x1500, 0x2ef8, 0x4d67, 0x6b02, 0x87be, 0xa395, 0xbe7a, 0xd866,
- 0xf14a, 0x1091b,0x11fcd,0x13552,0x14999,0x15c98,0x16e34,0x17e5f,
- 0x18d03,0x19a01,0x1a545,0x1ae8a,0x1b5c4,0x1bb01,0x1bfde,0x1c28d,
- 0x1c2de,0x1c0db,0x1ba73,0x1b11c,0x1a4b5,0x1953d,0x18266,0x16be0,
- 0x1683e,0x179d8,0x18a4d,0x19992,0x1a789,0x1b445,0x1bf61,0x1c989,
- 0x1d16d,0x1d77b,0x1dddf,0x1e2ad,0x1e5bf,0x1e6e8,0x1e654,0x1e3cd,
- 0x1df2a,0x1d635,0x1cb16,0x1be2c,0x1ae4e,0x19bde,0x1868e,0x16e2e,
- 0x1527f,0x1334a,0x11051,0xe951, 0xbe01, 0x8e0d, 0x5924, 0x1edd,};
-
- (2) Iterative refinement
-
- Apply Reciproot iteration three times to y and multiply the
- result by x to get an approximation z that matches sqrt(x)
- to about 1 ulp. To be exact, we will have
- -1ulp < sqrt(x)-z<1.0625ulp.
-
- ... set rounding mode to Round-to-nearest
- y := y*(1.5-0.5*x*y*y) ... almost 15 sig. bits to 1/sqrt(x)
- y := y*((1.5-2^-30)+0.5*x*y*y)... about 29 sig. bits to 1/sqrt(x)
- ... special arrangement for better accuracy
- z := x*y ... 29 bits to sqrt(x), with z*y<1
- z := z + 0.5*z*(1-z*y) ... about 1 ulp to sqrt(x)
-
- Remark 2. The constant 1.5-2^-30 is chosen to bias the error so that
- (a) the term z*y in the final iteration is always less than 1;
- (b) the error in the final result is biased upward so that
- -1 ulp < sqrt(x) - z < 1.0625 ulp
- instead of |sqrt(x)-z|<1.03125ulp.
-
- (3) Final adjustment
-
- By twiddling y's last bit it is possible to force y to be
- correctly rounded according to the prevailing rounding mode
- as follows. Let r and i be copies of the rounding mode and
- inexact flag before entering the square root program. Also we
- use the expression y+-ulp for the next representable floating
- numbers (up and down) of y. Note that y+-ulp = either fixed
- point y+-1, or multiply y by nextafter(1,+-inf) in chopped
- mode.
-
- R := RZ; ... set rounding mode to round-toward-zero
- switch(r) {
- case RN: ... round-to-nearest
- if(x<= z*(z-ulp)...chopped) z = z - ulp; else
- if(x<= z*(z+ulp)...chopped) z = z; else z = z+ulp;
- break;
- case RZ:case RM: ... round-to-zero or round-to--inf
- R:=RP; ... reset rounding mod to round-to-+inf
- if(x<z*z ... rounded up) z = z - ulp; else
- if(x>=(z+ulp)*(z+ulp) ...rounded up) z = z+ulp;
- break;
- case RP: ... round-to-+inf
- if(x>(z+ulp)*(z+ulp)...chopped) z = z+2*ulp; else
- if(x>z*z ...chopped) z = z+ulp;
- break;
- }
-
- Remark 3. The above comparisons can be done in fixed point. For
- example, to compare x and w=z*z chopped, it suffices to compare
- x1 and w1 (the trailing parts of x and w), regarding them as
- two's complement integers.
-
- ...Is z an exact square root?
- To determine whether z is an exact square root of x, let z1 be the
- trailing part of z, and also let x0 and x1 be the leading and
- trailing parts of x.
-
- If ((z1&0x03ffffff)!=0) ... not exact if trailing 26 bits of z!=0
- I := 1; ... Raise Inexact flag: z is not exact
- else {
- j := 1 - [(x0>>20)&1] ... j = logb(x) mod 2
- k := z1 >> 26; ... get z's 25-th and 26-th
- fraction bits
- I := i or (k&j) or ((k&(j+j+1))!=(x1&3));
- }
- R:= r ... restore rounded mode
- return sqrt(x):=z.
-
- If multiplication is cheaper then the foregoing red tape, the
- Inexact flag can be evaluated by
-
- I := i;
- I := (z*z!=x) or I.
-
- Note that z*z can overwrite I; this value must be sensed if it is
- True.
-
- Remark 4. If z*z = x exactly, then bit 25 to bit 0 of z1 must be
- zero.
-
- --------------------
- z1: | f2 |
- --------------------
- bit 31 bit 0
-
- Further more, bit 27 and 26 of z1, bit 0 and 1 of x1, and the odd
- or even of logb(x) have the following relations:
-
- -------------------------------------------------
- bit 27,26 of z1 bit 1,0 of x1 logb(x)
- -------------------------------------------------
- 00 00 odd and even
- 01 01 even
- 10 10 odd
- 10 00 even
- 11 01 even
- -------------------------------------------------
-
- (4) Special cases (see (4) of Section A).
-
- */
-
+++ /dev/null
-/* e_sqrtf.c -- float version of e_sqrt.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one = 1.0, tiny=1.0e-30;
-
-float
-sqrtf(float x)
-{
- float z;
- int32_t sign = (int)0x80000000;
- int32_t ix,s,q,m,t,i;
- uint32_t r;
-
- GET_FLOAT_WORD(ix,x);
-
- /* take care of Inf and NaN */
- if((ix&0x7f800000)==0x7f800000) {
- return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf
- sqrt(-inf)=sNaN */
- }
- /* take care of zero */
- if(ix<=0) {
- if((ix&(~sign))==0) return x;/* sqrt(+-0) = +-0 */
- else if(ix<0)
- return (x-x)/(x-x); /* sqrt(-ve) = sNaN */
- }
- /* normalize x */
- m = (ix>>23);
- if(m==0) { /* subnormal x */
- for(i=0;(ix&0x00800000)==0;i++) ix<<=1;
- m -= i-1;
- }
- m -= 127; /* unbias exponent */
- ix = (ix&0x007fffff)|0x00800000;
- if(m&1) /* odd m, double x to make it even */
- ix += ix;
- m >>= 1; /* m = [m/2] */
-
- /* generate sqrt(x) bit by bit */
- ix += ix;
- q = s = 0; /* q = sqrt(x) */
- r = 0x01000000; /* r = moving bit from right to left */
-
- while(r!=0) {
- t = s+r;
- if(t<=ix) {
- s = t+r;
- ix -= t;
- q += r;
- }
- ix += ix;
- r>>=1;
- }
-
- /* use floating add to find out rounding direction */
- if(ix!=0) {
- z = one-tiny; /* trigger inexact flag */
- if (z>=one) {
- z = one+tiny;
- if (z>one)
- q += 2;
- else
- q += (q&1);
- }
- }
- ix = (q>>1)+0x3f000000;
- ix += (m <<23);
- SET_FLOAT_WORD(z,ix);
- return z;
-}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_erf.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* double erf(double x)
+ * double erfc(double x)
+ * x
+ * 2 |\
+ * erf(x) = --------- | exp(-t*t)dt
+ * sqrt(pi) \|
+ * 0
+ *
+ * erfc(x) = 1-erf(x)
+ * Note that
+ * erf(-x) = -erf(x)
+ * erfc(-x) = 2 - erfc(x)
+ *
+ * Method:
+ * 1. For |x| in [0, 0.84375]
+ * erf(x) = x + x*R(x^2)
+ * erfc(x) = 1 - erf(x) if x in [-.84375,0.25]
+ * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375]
+ * where R = P/Q where P is an odd poly of degree 8 and
+ * Q is an odd poly of degree 10.
+ * -57.90
+ * | R - (erf(x)-x)/x | <= 2
+ *
+ *
+ * Remark. The formula is derived by noting
+ * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
+ * and that
+ * 2/sqrt(pi) = 1.128379167095512573896158903121545171688
+ * is close to one. The interval is chosen because the fix
+ * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
+ * near 0.6174), and by some experiment, 0.84375 is chosen to
+ * guarantee the error is less than one ulp for erf.
+ *
+ * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and
+ * c = 0.84506291151 rounded to single (24 bits)
+ * erf(x) = sign(x) * (c + P1(s)/Q1(s))
+ * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0
+ * 1+(c+P1(s)/Q1(s)) if x < 0
+ * |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06
+ * Remark: here we use the taylor series expansion at x=1.
+ * erf(1+s) = erf(1) + s*Poly(s)
+ * = 0.845.. + P1(s)/Q1(s)
+ * That is, we use rational approximation to approximate
+ * erf(1+s) - (c = (single)0.84506291151)
+ * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
+ * where
+ * P1(s) = degree 6 poly in s
+ * Q1(s) = degree 6 poly in s
+ *
+ * 3. For x in [1.25,1/0.35(~2.857143)],
+ * erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1)
+ * erf(x) = 1 - erfc(x)
+ * where
+ * R1(z) = degree 7 poly in z, (z=1/x^2)
+ * S1(z) = degree 8 poly in z
+ *
+ * 4. For x in [1/0.35,28]
+ * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
+ * = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6<x<0
+ * = 2.0 - tiny (if x <= -6)
+ * erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6, else
+ * erf(x) = sign(x)*(1.0 - tiny)
+ * where
+ * R2(z) = degree 6 poly in z, (z=1/x^2)
+ * S2(z) = degree 7 poly in z
+ *
+ * Note1:
+ * To compute exp(-x*x-0.5625+R/S), let s be a single
+ * precision number and s := x; then
+ * -x*x = -s*s + (s-x)*(s+x)
+ * exp(-x*x-0.5626+R/S) =
+ * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S);
+ * Note2:
+ * Here 4 and 5 make use of the asymptotic series
+ * exp(-x*x)
+ * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) )
+ * x*sqrt(pi)
+ * We use rational approximation to approximate
+ * g(s)=f(1/x^2) = log(erfc(x)*x) - x*x + 0.5625
+ * Here is the error bound for R1/S1 and R2/S2
+ * |R1/S1 - f(x)| < 2**(-62.57)
+ * |R2/S2 - f(x)| < 2**(-61.52)
+ *
+ * 5. For inf > x >= 28
+ * erf(x) = sign(x) *(1 - tiny) (raise inexact)
+ * erfc(x) = tiny*tiny (raise underflow) if x > 0
+ * = 2 - tiny if x<0
+ *
+ * 7. Special case:
+ * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
+ * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
+ * erfc/erf(NaN) is NaN
+ */
+
+#include "libm.h"
+
+static const double
+tiny = 1e-300,
+half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
+/* c = (float)0.84506291151 */
+erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */
+/*
+ * Coefficients for approximation to erf on [0,0.84375]
+ */
+efx = 1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */
+efx8 = 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */
+pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */
+pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */
+pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */
+pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */
+pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */
+qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */
+qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */
+qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */
+qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */
+qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */
+/*
+ * Coefficients for approximation to erf in [0.84375,1.25]
+ */
+pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */
+pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */
+pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */
+pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */
+pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */
+pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */
+pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */
+qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */
+qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */
+qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */
+qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */
+qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */
+qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */
+/*
+ * Coefficients for approximation to erfc in [1.25,1/0.35]
+ */
+ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */
+ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */
+ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */
+ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */
+ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */
+ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */
+ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */
+ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */
+sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */
+sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */
+sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */
+sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */
+sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */
+sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */
+sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */
+sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */
+/*
+ * Coefficients for approximation to erfc in [1/.35,28]
+ */
+rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */
+rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */
+rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */
+rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */
+rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */
+rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */
+rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */
+sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */
+sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */
+sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */
+sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */
+sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */
+sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */
+sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */
+
+double erf(double x)
+{
+ int32_t hx,ix,i;
+ double R,S,P,Q,s,y,z,r;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7ff00000) {
+ /* erf(nan)=nan, erf(+-inf)=+-1 */
+ i = ((uint32_t)hx>>31)<<1;
+ return (double)(1-i) + one/x;
+ }
+ if (ix < 0x3feb0000) { /* |x|<0.84375 */
+ if (ix < 0x3e300000) { /* |x|<2**-28 */
+ if (ix < 0x00800000)
+ /* avoid underflow */
+ return 0.125*(8.0*x + efx8*x);
+ return x + efx*x;
+ }
+ z = x*x;
+ r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
+ s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
+ y = r/s;
+ return x + x*y;
+ }
+ if (ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabs(x)-one;
+ P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
+ Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
+ if (hx >= 0)
+ return erx + P/Q;
+ return -erx - P/Q;
+ }
+ if (ix >= 0x40180000) { /* inf > |x| >= 6 */
+ if (hx >= 0)
+ return one-tiny;
+ return tiny-one;
+ }
+ x = fabs(x);
+ s = one/(x*x);
+ if (ix < 0x4006DB6E) { /* |x| < 1/0.35 */
+ R = ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
+ ra5+s*(ra6+s*ra7))))));
+ S = one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
+ sa5+s*(sa6+s*(sa7+s*sa8)))))));
+ } else { /* |x| >= 1/0.35 */
+ R = rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
+ rb5+s*rb6)))));
+ S = one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
+ sb5+s*(sb6+s*sb7))))));
+ }
+ z = x;
+ SET_LOW_WORD(z,0);
+ r = exp(-z*z-0.5625)*exp((z-x)*(z+x)+R/S);
+ if (hx >= 0)
+ return one-r/x;
+ return r/x-one;
+}
+
+double erfc(double x)
+{
+ int32_t hx,ix;
+ double R,S,P,Q,s,y,z,r;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7ff00000) {
+ /* erfc(nan)=nan, erfc(+-inf)=0,2 */
+ return (double)(((uint32_t)hx>>31)<<1) + one/x;
+ }
+ if (ix < 0x3feb0000) { /* |x| < 0.84375 */
+ if (ix < 0x3c700000) /* |x| < 2**-56 */
+ return one - x;
+ z = x*x;
+ r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
+ s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
+ y = r/s;
+ if (hx < 0x3fd00000) { /* x < 1/4 */
+ return one - (x+x*y);
+ } else {
+ r = x*y;
+ r += x-half;
+ return half - r ;
+ }
+ }
+ if (ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabs(x)-one;
+ P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
+ Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
+ if (hx >= 0) {
+ z = one-erx;
+ return z - P/Q;
+ } else {
+ z = erx+P/Q;
+ return one+z;
+ }
+ }
+ if (ix < 0x403c0000) { /* |x| < 28 */
+ x = fabs(x);
+ s = one/(x*x);
+ if (ix < 0x4006DB6D) { /* |x| < 1/.35 ~ 2.857143*/
+ R = ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
+ ra5+s*(ra6+s*ra7))))));
+ S = one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
+ sa5+s*(sa6+s*(sa7+s*sa8)))))));
+ } else { /* |x| >= 1/.35 ~ 2.857143 */
+ if (hx < 0 && ix >= 0x40180000) /* x < -6 */
+ return two-tiny;
+ R = rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
+ rb5+s*rb6)))));
+ S = one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
+ sb5+s*(sb6+s*sb7))))));
+ }
+ z = x;
+ SET_LOW_WORD(z, 0);
+ r = exp(-z*z-0.5625)*exp((z-x)*(z+x)+R/S);
+ if (hx > 0)
+ return r/x;
+ return two-r/x;
+ }
+ if (hx > 0)
+ return tiny*tiny;
+ return two-tiny;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_erff.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+tiny = 1e-30,
+half = 5.0000000000e-01, /* 0x3F000000 */
+one = 1.0000000000e+00, /* 0x3F800000 */
+two = 2.0000000000e+00, /* 0x40000000 */
+/* c = (subfloat)0.84506291151 */
+erx = 8.4506291151e-01, /* 0x3f58560b */
+/*
+ * Coefficients for approximation to erf on [0,0.84375]
+ */
+efx = 1.2837916613e-01, /* 0x3e0375d4 */
+efx8 = 1.0270333290e+00, /* 0x3f8375d4 */
+pp0 = 1.2837916613e-01, /* 0x3e0375d4 */
+pp1 = -3.2504209876e-01, /* 0xbea66beb */
+pp2 = -2.8481749818e-02, /* 0xbce9528f */
+pp3 = -5.7702702470e-03, /* 0xbbbd1489 */
+pp4 = -2.3763017452e-05, /* 0xb7c756b1 */
+qq1 = 3.9791721106e-01, /* 0x3ecbbbce */
+qq2 = 6.5022252500e-02, /* 0x3d852a63 */
+qq3 = 5.0813062117e-03, /* 0x3ba68116 */
+qq4 = 1.3249473704e-04, /* 0x390aee49 */
+qq5 = -3.9602282413e-06, /* 0xb684e21a */
+/*
+ * Coefficients for approximation to erf in [0.84375,1.25]
+ */
+pa0 = -2.3621185683e-03, /* 0xbb1acdc6 */
+pa1 = 4.1485610604e-01, /* 0x3ed46805 */
+pa2 = -3.7220788002e-01, /* 0xbebe9208 */
+pa3 = 3.1834661961e-01, /* 0x3ea2fe54 */
+pa4 = -1.1089469492e-01, /* 0xbde31cc2 */
+pa5 = 3.5478305072e-02, /* 0x3d1151b3 */
+pa6 = -2.1663755178e-03, /* 0xbb0df9c0 */
+qa1 = 1.0642088205e-01, /* 0x3dd9f331 */
+qa2 = 5.4039794207e-01, /* 0x3f0a5785 */
+qa3 = 7.1828655899e-02, /* 0x3d931ae7 */
+qa4 = 1.2617121637e-01, /* 0x3e013307 */
+qa5 = 1.3637083583e-02, /* 0x3c5f6e13 */
+qa6 = 1.1984500103e-02, /* 0x3c445aa3 */
+/*
+ * Coefficients for approximation to erfc in [1.25,1/0.35]
+ */
+ra0 = -9.8649440333e-03, /* 0xbc21a093 */
+ra1 = -6.9385856390e-01, /* 0xbf31a0b7 */
+ra2 = -1.0558626175e+01, /* 0xc128f022 */
+ra3 = -6.2375331879e+01, /* 0xc2798057 */
+ra4 = -1.6239666748e+02, /* 0xc322658c */
+ra5 = -1.8460508728e+02, /* 0xc3389ae7 */
+ra6 = -8.1287437439e+01, /* 0xc2a2932b */
+ra7 = -9.8143291473e+00, /* 0xc11d077e */
+sa1 = 1.9651271820e+01, /* 0x419d35ce */
+sa2 = 1.3765776062e+02, /* 0x4309a863 */
+sa3 = 4.3456588745e+02, /* 0x43d9486f */
+sa4 = 6.4538726807e+02, /* 0x442158c9 */
+sa5 = 4.2900814819e+02, /* 0x43d6810b */
+sa6 = 1.0863500214e+02, /* 0x42d9451f */
+sa7 = 6.5702495575e+00, /* 0x40d23f7c */
+sa8 = -6.0424413532e-02, /* 0xbd777f97 */
+/*
+ * Coefficients for approximation to erfc in [1/.35,28]
+ */
+rb0 = -9.8649431020e-03, /* 0xbc21a092 */
+rb1 = -7.9928326607e-01, /* 0xbf4c9dd4 */
+rb2 = -1.7757955551e+01, /* 0xc18e104b */
+rb3 = -1.6063638306e+02, /* 0xc320a2ea */
+rb4 = -6.3756646729e+02, /* 0xc41f6441 */
+rb5 = -1.0250950928e+03, /* 0xc480230b */
+rb6 = -4.8351919556e+02, /* 0xc3f1c275 */
+sb1 = 3.0338060379e+01, /* 0x41f2b459 */
+sb2 = 3.2579251099e+02, /* 0x43a2e571 */
+sb3 = 1.5367296143e+03, /* 0x44c01759 */
+sb4 = 3.1998581543e+03, /* 0x4547fdbb */
+sb5 = 2.5530502930e+03, /* 0x451f90ce */
+sb6 = 4.7452853394e+02, /* 0x43ed43a7 */
+sb7 = -2.2440952301e+01; /* 0xc1b38712 */
+
+float erff(float x)
+{
+ int32_t hx,ix,i;
+ float R,S,P,Q,s,y,z,r;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7f800000) {
+ /* erf(nan)=nan, erf(+-inf)=+-1 */
+ i = ((uint32_t)hx>>31)<<1;
+ return (float)(1-i)+one/x;
+ }
+ if (ix < 0x3f580000) { /* |x| < 0.84375 */
+ if (ix < 0x31800000) { /* |x| < 2**-28 */
+ if (ix < 0x04000000)
+ /*avoid underflow */
+ return (float)0.125*((float)8.0*x+efx8*x);
+ return x + efx*x;
+ }
+ z = x*x;
+ r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
+ s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
+ y = r/s;
+ return x + x*y;
+ }
+ if (ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabsf(x)-one;
+ P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
+ Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
+ if (hx >= 0)
+ return erx + P/Q;
+ return -erx - P/Q;
+ }
+ if (ix >= 0x40c00000) { /* inf > |x| >= 6 */
+ if (hx >= 0)
+ return one - tiny;
+ return tiny - one;
+ }
+ x = fabsf(x);
+ s = one/(x*x);
+ if (ix < 0x4036DB6E) { /* |x| < 1/0.35 */
+ R = ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
+ ra5+s*(ra6+s*ra7))))));
+ S = one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
+ sa5+s*(sa6+s*(sa7+s*sa8)))))));
+ } else { /* |x| >= 1/0.35 */
+ R = rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
+ rb5+s*rb6)))));
+ S = one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
+ sb5+s*(sb6+s*sb7))))));
+ }
+ GET_FLOAT_WORD(ix, x);
+ SET_FLOAT_WORD(z, ix&0xfffff000);
+ r = expf(-z*z - (float)0.5625) * expf((z-x)*(z+x) + R/S);
+ if (hx >= 0)
+ return one - r/x;
+ return r/x - one;
+}
+
+float erfcf(float x)
+{
+ int32_t hx,ix;
+ float R,S,P,Q,s,y,z,r;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7f800000) {
+ /* erfc(nan)=nan, erfc(+-inf)=0,2 */
+ return (float)(((uint32_t)hx>>31)<<1) + one/x;
+ }
+
+ if (ix < 0x3f580000) { /* |x| < 0.84375 */
+ if (ix < 0x23800000) /* |x| < 2**-56 */
+ return one - x;
+ z = x*x;
+ r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
+ s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
+ y = r/s;
+ if (hx < 0x3e800000) { /* x<1/4 */
+ return one - (x+x*y);
+ } else {
+ r = x*y;
+ r += (x-half);
+ return half - r ;
+ }
+ }
+ if (ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabsf(x)-one;
+ P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
+ Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
+ if(hx >= 0) {
+ z = one - erx;
+ return z - P/Q;
+ } else {
+ z = erx + P/Q;
+ return one + z;
+ }
+ }
+ if (ix < 0x41e00000) { /* |x| < 28 */
+ x = fabsf(x);
+ s = one/(x*x);
+ if (ix < 0x4036DB6D) { /* |x| < 1/.35 ~ 2.857143*/
+ R = ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
+ ra5+s*(ra6+s*ra7))))));
+ S = one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
+ sa5+s*(sa6+s*(sa7+s*sa8)))))));
+ } else { /* |x| >= 1/.35 ~ 2.857143 */
+ if (hx < 0 && ix >= 0x40c00000) /* x < -6 */
+ return two-tiny;
+ R = rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
+ rb5+s*rb6)))));
+ S = one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
+ sb5+s*(sb6+s*sb7))))));
+ }
+ GET_FLOAT_WORD(ix, x);
+ SET_FLOAT_WORD(z, ix&0xfffff000);
+ r = expf(-z*z - (float)0.5625) * expf((z-x)*(z+x) + R/S);
+ if (hx > 0)
+ return r/x;
+ return two - r/x;
+ }
+ if (hx > 0)
+ return tiny*tiny;
+ return two - tiny;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_erfl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/* double erf(double x)
+ * double erfc(double x)
+ * x
+ * 2 |\
+ * erf(x) = --------- | exp(-t*t)dt
+ * sqrt(pi) \|
+ * 0
+ *
+ * erfc(x) = 1-erf(x)
+ * Note that
+ * erf(-x) = -erf(x)
+ * erfc(-x) = 2 - erfc(x)
+ *
+ * Method:
+ * 1. For |x| in [0, 0.84375]
+ * erf(x) = x + x*R(x^2)
+ * erfc(x) = 1 - erf(x) if x in [-.84375,0.25]
+ * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375]
+ * Remark. The formula is derived by noting
+ * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
+ * and that
+ * 2/sqrt(pi) = 1.128379167095512573896158903121545171688
+ * is close to one. The interval is chosen because the fix
+ * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
+ * near 0.6174), and by some experiment, 0.84375 is chosen to
+ * guarantee the error is less than one ulp for erf.
+ *
+ * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and
+ * c = 0.84506291151 rounded to single (24 bits)
+ * erf(x) = sign(x) * (c + P1(s)/Q1(s))
+ * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0
+ * 1+(c+P1(s)/Q1(s)) if x < 0
+ * Remark: here we use the taylor series expansion at x=1.
+ * erf(1+s) = erf(1) + s*Poly(s)
+ * = 0.845.. + P1(s)/Q1(s)
+ * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
+ *
+ * 3. For x in [1.25,1/0.35(~2.857143)],
+ * erfc(x) = (1/x)*exp(-x*x-0.5625+R1(z)/S1(z))
+ * z=1/x^2
+ * erf(x) = 1 - erfc(x)
+ *
+ * 4. For x in [1/0.35,107]
+ * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
+ * = 2.0 - (1/x)*exp(-x*x-0.5625+R2(z)/S2(z))
+ * if -6.666<x<0
+ * = 2.0 - tiny (if x <= -6.666)
+ * z=1/x^2
+ * erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6.666, else
+ * erf(x) = sign(x)*(1.0 - tiny)
+ * Note1:
+ * To compute exp(-x*x-0.5625+R/S), let s be a single
+ * precision number and s := x; then
+ * -x*x = -s*s + (s-x)*(s+x)
+ * exp(-x*x-0.5626+R/S) =
+ * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S);
+ * Note2:
+ * Here 4 and 5 make use of the asymptotic series
+ * exp(-x*x)
+ * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) )
+ * x*sqrt(pi)
+ *
+ * 5. For inf > x >= 107
+ * erf(x) = sign(x) *(1 - tiny) (raise inexact)
+ * erfc(x) = tiny*tiny (raise underflow) if x > 0
+ * = 2 - tiny if x<0
+ *
+ * 7. Special case:
+ * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
+ * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
+ * erfc/erf(NaN) is NaN
+ */
+
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double erfl(long double x)
+{
+ return erfl(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double
+tiny = 1e-4931L,
+half = 0.5L,
+one = 1.0L,
+two = 2.0L,
+/* c = (float)0.84506291151 */
+erx = 0.845062911510467529296875L,
+
+/*
+ * Coefficients for approximation to erf on [0,0.84375]
+ */
+/* 2/sqrt(pi) - 1 */
+efx = 1.2837916709551257389615890312154517168810E-1L,
+/* 8 * (2/sqrt(pi) - 1) */
+efx8 = 1.0270333367641005911692712249723613735048E0L,
+pp[6] = {
+ 1.122751350964552113068262337278335028553E6L,
+ -2.808533301997696164408397079650699163276E6L,
+ -3.314325479115357458197119660818768924100E5L,
+ -6.848684465326256109712135497895525446398E4L,
+ -2.657817695110739185591505062971929859314E3L,
+ -1.655310302737837556654146291646499062882E2L,
+},
+qq[6] = {
+ 8.745588372054466262548908189000448124232E6L,
+ 3.746038264792471129367533128637019611485E6L,
+ 7.066358783162407559861156173539693900031E5L,
+ 7.448928604824620999413120955705448117056E4L,
+ 4.511583986730994111992253980546131408924E3L,
+ 1.368902937933296323345610240009071254014E2L,
+ /* 1.000000000000000000000000000000000000000E0 */
+},
+
+/*
+ * Coefficients for approximation to erf in [0.84375,1.25]
+ */
+/* erf(x+1) = 0.845062911510467529296875 + pa(x)/qa(x)
+ -0.15625 <= x <= +.25
+ Peak relative error 8.5e-22 */
+pa[8] = {
+ -1.076952146179812072156734957705102256059E0L,
+ 1.884814957770385593365179835059971587220E2L,
+ -5.339153975012804282890066622962070115606E1L,
+ 4.435910679869176625928504532109635632618E1L,
+ 1.683219516032328828278557309642929135179E1L,
+ -2.360236618396952560064259585299045804293E0L,
+ 1.852230047861891953244413872297940938041E0L,
+ 9.394994446747752308256773044667843200719E-2L,
+},
+qa[7] = {
+ 4.559263722294508998149925774781887811255E2L,
+ 3.289248982200800575749795055149780689738E2L,
+ 2.846070965875643009598627918383314457912E2L,
+ 1.398715859064535039433275722017479994465E2L,
+ 6.060190733759793706299079050985358190726E1L,
+ 2.078695677795422351040502569964299664233E1L,
+ 4.641271134150895940966798357442234498546E0L,
+ /* 1.000000000000000000000000000000000000000E0 */
+},
+
+/*
+ * Coefficients for approximation to erfc in [1.25,1/0.35]
+ */
+/* erfc(1/x) = x exp (-1/x^2 - 0.5625 + ra(x^2)/sa(x^2))
+ 1/2.85711669921875 < 1/x < 1/1.25
+ Peak relative error 3.1e-21 */
+ra[] = {
+ 1.363566591833846324191000679620738857234E-1L,
+ 1.018203167219873573808450274314658434507E1L,
+ 1.862359362334248675526472871224778045594E2L,
+ 1.411622588180721285284945138667933330348E3L,
+ 5.088538459741511988784440103218342840478E3L,
+ 8.928251553922176506858267311750789273656E3L,
+ 7.264436000148052545243018622742770549982E3L,
+ 2.387492459664548651671894725748959751119E3L,
+ 2.220916652813908085449221282808458466556E2L,
+},
+sa[] = {
+ -1.382234625202480685182526402169222331847E1L,
+ -3.315638835627950255832519203687435946482E2L,
+ -2.949124863912936259747237164260785326692E3L,
+ -1.246622099070875940506391433635999693661E4L,
+ -2.673079795851665428695842853070996219632E4L,
+ -2.880269786660559337358397106518918220991E4L,
+ -1.450600228493968044773354186390390823713E4L,
+ -2.874539731125893533960680525192064277816E3L,
+ -1.402241261419067750237395034116942296027E2L,
+ /* 1.000000000000000000000000000000000000000E0 */
+},
+
+/*
+ * Coefficients for approximation to erfc in [1/.35,107]
+ */
+/* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rb(x^2)/sb(x^2))
+ 1/6.6666259765625 < 1/x < 1/2.85711669921875
+ Peak relative error 4.2e-22 */
+rb[] = {
+ -4.869587348270494309550558460786501252369E-5L,
+ -4.030199390527997378549161722412466959403E-3L,
+ -9.434425866377037610206443566288917589122E-2L,
+ -9.319032754357658601200655161585539404155E-1L,
+ -4.273788174307459947350256581445442062291E0L,
+ -8.842289940696150508373541814064198259278E0L,
+ -7.069215249419887403187988144752613025255E0L,
+ -1.401228723639514787920274427443330704764E0L,
+},
+sb[] = {
+ 4.936254964107175160157544545879293019085E-3L,
+ 1.583457624037795744377163924895349412015E-1L,
+ 1.850647991850328356622940552450636420484E0L,
+ 9.927611557279019463768050710008450625415E0L,
+ 2.531667257649436709617165336779212114570E1L,
+ 2.869752886406743386458304052862814690045E1L,
+ 1.182059497870819562441683560749192539345E1L,
+ /* 1.000000000000000000000000000000000000000E0 */
+},
+/* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rc(x^2)/sc(x^2))
+ 1/107 <= 1/x <= 1/6.6666259765625
+ Peak relative error 1.1e-21 */
+rc[] = {
+ -8.299617545269701963973537248996670806850E-5L,
+ -6.243845685115818513578933902532056244108E-3L,
+ -1.141667210620380223113693474478394397230E-1L,
+ -7.521343797212024245375240432734425789409E-1L,
+ -1.765321928311155824664963633786967602934E0L,
+ -1.029403473103215800456761180695263439188E0L,
+},
+sc[] = {
+ 8.413244363014929493035952542677768808601E-3L,
+ 2.065114333816877479753334599639158060979E-1L,
+ 1.639064941530797583766364412782135680148E0L,
+ 4.936788463787115555582319302981666347450E0L,
+ 5.005177727208955487404729933261347679090E0L,
+ /* 1.000000000000000000000000000000000000000E0 */
+};
+
+long double erfl(long double x)
+{
+ long double R, S, P, Q, s, y, z, r;
+ int32_t ix, i;
+ uint32_t se, i0, i1;
+
+ GET_LDOUBLE_WORDS (se, i0, i1, x);
+ ix = se & 0x7fff;
+
+ if (ix >= 0x7fff) { /* erf(nan)=nan */
+ i = ((se & 0xffff) >> 15) << 1;
+ return (long double)(1 - i) + one / x; /* erf(+-inf)=+-1 */
+ }
+
+ ix = (ix << 16) | (i0 >> 16);
+ if (ix < 0x3ffed800) { /* |x| < 0.84375 */
+ if (ix < 0x3fde8000) { /* |x| < 2**-33 */
+ if (ix < 0x00080000)
+ return 0.125 * (8.0 * x + efx8 * x); /* avoid underflow */
+ return x + efx * x;
+ }
+ z = x * x;
+ r = pp[0] + z * (pp[1] +
+ z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5]))));
+ s = qq[0] + z * (qq[1] +
+ z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z)))));
+ y = r / s;
+ return x + x * y;
+ }
+ if (ix < 0x3fffa000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabsl (x) - one;
+ P = pa[0] + s * (pa[1] + s * (pa[2] +
+ s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7]))))));
+ Q = qa[0] + s * (qa[1] + s * (qa[2] +
+ s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s))))));
+ if ((se & 0x8000) == 0)
+ return erx + P / Q;
+ return -erx - P / Q;
+ }
+ if (ix >= 0x4001d555) { /* inf > |x| >= 6.6666259765625 */
+ if ((se & 0x8000) == 0)
+ return one - tiny;
+ return tiny - one;
+ }
+ x = fabsl (x);
+ s = one / (x * x);
+ if (ix < 0x4000b6db) { /* 1.25 <= |x| < 2.85711669921875 ~ 1/.35 */
+ R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] +
+ s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8])))))));
+ S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] +
+ s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s))))))));
+ } else { /* 2.857 <= |x| < 6.667 */
+ R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] +
+ s * (rb[5] + s * (rb[6] + s * rb[7]))))));
+ S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] +
+ s * (sb[5] + s * (sb[6] + s))))));
+ }
+ z = x;
+ GET_LDOUBLE_WORDS(i, i0, i1, z);
+ i1 = 0;
+ SET_LDOUBLE_WORDS(z, i, i0, i1);
+ r = expl(-z * z - 0.5625) * expl((z - x) * (z + x) + R / S);
+ if ((se & 0x8000) == 0)
+ return one - r / x;
+ return r / x - one;
+}
+
+long double erfcl(long double x)
+{
+ int32_t hx, ix;
+ long double R, S, P, Q, s, y, z, r;
+ uint32_t se, i0, i1;
+
+ GET_LDOUBLE_WORDS (se, i0, i1, x);
+ ix = se & 0x7fff;
+ if (ix >= 0x7fff) { /* erfc(nan) = nan, erfc(+-inf) = 0,2 */
+ return (long double)(((se & 0xffff) >> 15) << 1) + one / x;
+ }
+
+ ix = (ix << 16) | (i0 >> 16);
+ if (ix < 0x3ffed800) { /* |x| < 0.84375 */
+ if (ix < 0x3fbe0000) /* |x| < 2**-65 */
+ return one - x;
+ z = x * x;
+ r = pp[0] + z * (pp[1] +
+ z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5]))));
+ s = qq[0] + z * (qq[1] +
+ z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z)))));
+ y = r / s;
+ if (ix < 0x3ffd8000) /* x < 1/4 */
+ return one - (x + x * y);
+ r = x * y;
+ r += x - half;
+ return half - r;
+ }
+ if (ix < 0x3fffa000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabsl (x) - one;
+ P = pa[0] + s * (pa[1] + s * (pa[2] +
+ s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7]))))));
+ Q = qa[0] + s * (qa[1] + s * (qa[2] +
+ s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s))))));
+ if ((se & 0x8000) == 0) {
+ z = one - erx;
+ return z - P / Q;
+ }
+ z = erx + P / Q;
+ return one + z;
+ }
+ if (ix < 0x4005d600) { /* |x| < 107 */
+ x = fabsl (x);
+ s = one / (x * x);
+ if (ix < 0x4000b6db) { /* 1.25 <= |x| < 2.85711669921875 ~ 1/.35 */
+ R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] +
+ s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8])))))));
+ S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] +
+ s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s))))))));
+ } else if (ix < 0x4001d555) { /* 6.6666259765625 > |x| >= 1/.35 ~ 2.857143 */
+ R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] +
+ s * (rb[5] + s * (rb[6] + s * rb[7]))))));
+ S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] +
+ s * (sb[5] + s * (sb[6] + s))))));
+ } else { /* 107 > |x| >= 6.666 */
+ if (se & 0x8000)
+ return two - tiny;/* x < -6.666 */
+ R = rc[0] + s * (rc[1] + s * (rc[2] + s * (rc[3] +
+ s * (rc[4] + s * rc[5]))));
+ S = sc[0] + s * (sc[1] + s * (sc[2] + s * (sc[3] +
+ s * (sc[4] + s))));
+ }
+ z = x;
+ GET_LDOUBLE_WORDS (hx, i0, i1, z);
+ i1 = 0;
+ i0 &= 0xffffff00;
+ SET_LDOUBLE_WORDS (z, hx, i0, i1);
+ r = expl (-z * z - 0.5625) *
+ expl ((z - x) * (z + x) + R / S);
+ if ((se & 0x8000) == 0)
+ return r / x;
+ return two - r / x;
+ }
+
+ if ((se & 0x8000) == 0)
+ return tiny * tiny;
+ return two - tiny;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_exp.c */
+/*
+ * ====================================================
+ * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* exp(x)
+ * Returns the exponential of x.
+ *
+ * Method
+ * 1. Argument reduction:
+ * Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658.
+ * Given x, find r and integer k such that
+ *
+ * x = k*ln2 + r, |r| <= 0.5*ln2.
+ *
+ * Here r will be represented as r = hi-lo for better
+ * accuracy.
+ *
+ * 2. Approximation of exp(r) by a special rational function on
+ * the interval [0,0.34658]:
+ * Write
+ * R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ...
+ * We use a special Remes algorithm on [0,0.34658] to generate
+ * a polynomial of degree 5 to approximate R. The maximum error
+ * of this polynomial approximation is bounded by 2**-59. In
+ * other words,
+ * R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5
+ * (where z=r*r, and the values of P1 to P5 are listed below)
+ * and
+ * | 5 | -59
+ * | 2.0+P1*z+...+P5*z - R(z) | <= 2
+ * | |
+ * The computation of exp(r) thus becomes
+ * 2*r
+ * exp(r) = 1 + -------
+ * R - r
+ * r*R1(r)
+ * = 1 + r + ----------- (for better accuracy)
+ * 2 - R1(r)
+ * where
+ * 2 4 10
+ * R1(r) = r - (P1*r + P2*r + ... + P5*r ).
+ *
+ * 3. Scale back to obtain exp(x):
+ * From step 1, we have
+ * exp(x) = 2^k * exp(r)
+ *
+ * Special cases:
+ * exp(INF) is INF, exp(NaN) is NaN;
+ * exp(-INF) is 0, and
+ * for finite argument, only exp(0)=1 is exact.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Misc. info.
+ * For IEEE double
+ * if x > 7.09782712893383973096e+02 then exp(x) overflow
+ * if x < -7.45133219101941108420e+02 then exp(x) underflow
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.0,
+halF[2] = {0.5,-0.5,},
+huge = 1.0e+300,
+o_threshold = 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
+u_threshold = -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */
+ln2HI[2] = { 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */
+ -6.93147180369123816490e-01},/* 0xbfe62e42, 0xfee00000 */
+ln2LO[2] = { 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */
+ -1.90821492927058770002e-10},/* 0xbdea39ef, 0x35793c76 */
+invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */
+P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
+P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
+P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
+P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
+P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */
+
+static volatile double
+twom1000 = 9.33263618503218878990e-302; /* 2**-1000=0x01700000,0 */
+
+double exp(double x)
+{
+ double y,hi=0.0,lo=0.0,c,t,twopk;
+ int32_t k=0,xsb;
+ uint32_t hx;
+
+ GET_HIGH_WORD(hx, x);
+ xsb = (hx>>31)&1; /* sign bit of x */
+ hx &= 0x7fffffff; /* high word of |x| */
+
+ /* filter out non-finite argument */
+ if (hx >= 0x40862E42) { /* if |x| >= 709.78... */
+ if (hx >= 0x7ff00000) {
+ uint32_t lx;
+
+ GET_LOW_WORD(lx,x);
+ if (((hx&0xfffff)|lx) != 0) /* NaN */
+ return x+x;
+ return xsb==0 ? x : 0.0; /* exp(+-inf)={inf,0} */
+ }
+ if (x > o_threshold)
+ return huge*huge; /* overflow */
+ if (x < u_threshold)
+ return twom1000*twom1000; /* underflow */
+ }
+
+ /* argument reduction */
+ if (hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
+ if (hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
+ hi = x-ln2HI[xsb];
+ lo = ln2LO[xsb];
+ k = 1 - xsb - xsb;
+ } else {
+ k = (int)(invln2*x+halF[xsb]);
+ t = k;
+ hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */
+ lo = t*ln2LO[0];
+ }
+ STRICT_ASSIGN(double, x, hi - lo);
+ } else if(hx < 0x3e300000) { /* |x| < 2**-28 */
+ /* raise inexact */
+ if (huge+x > one)
+ return one+x;
+ } else
+ k = 0;
+
+ /* x is now in primary range */
+ t = x*x;
+ if (k >= -1021)
+ INSERT_WORDS(twopk, 0x3ff00000+(k<<20), 0);
+ else
+ INSERT_WORDS(twopk, 0x3ff00000+((k+1000)<<20), 0);
+ c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
+ if (k == 0)
+ return one - ((x*c)/(c-2.0) - x);
+ y = one-((lo-(x*c)/(2.0-c))-hi);
+ if (k < -1021)
+ return y*twopk*twom1000;
+ if (k == 1024)
+ return y*2.0*0x1p1023;
+ return y*twopk;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_exp2.c */
+/*-
+ * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+#define TBLBITS 8
+#define TBLSIZE (1 << TBLBITS)
+
+static const double
+huge = 0x1p1000,
+redux = 0x1.8p52 / TBLSIZE,
+P1 = 0x1.62e42fefa39efp-1,
+P2 = 0x1.ebfbdff82c575p-3,
+P3 = 0x1.c6b08d704a0a6p-5,
+P4 = 0x1.3b2ab88f70400p-7,
+P5 = 0x1.5d88003875c74p-10;
+
+static volatile double twom1000 = 0x1p-1000;
+
+static const double tbl[TBLSIZE * 2] = {
+/* exp2(z + eps) eps */
+ 0x1.6a09e667f3d5dp-1, 0x1.9880p-44,
+ 0x1.6b052fa751744p-1, 0x1.8000p-50,
+ 0x1.6c012750bd9fep-1, -0x1.8780p-45,
+ 0x1.6cfdcddd476bfp-1, 0x1.ec00p-46,
+ 0x1.6dfb23c651a29p-1, -0x1.8000p-50,
+ 0x1.6ef9298593ae3p-1, -0x1.c000p-52,
+ 0x1.6ff7df9519386p-1, -0x1.fd80p-45,
+ 0x1.70f7466f42da3p-1, -0x1.c880p-45,
+ 0x1.71f75e8ec5fc3p-1, 0x1.3c00p-46,
+ 0x1.72f8286eacf05p-1, -0x1.8300p-44,
+ 0x1.73f9a48a58152p-1, -0x1.0c00p-47,
+ 0x1.74fbd35d7ccfcp-1, 0x1.f880p-45,
+ 0x1.75feb564267f1p-1, 0x1.3e00p-47,
+ 0x1.77024b1ab6d48p-1, -0x1.7d00p-45,
+ 0x1.780694fde5d38p-1, -0x1.d000p-50,
+ 0x1.790b938ac1d00p-1, 0x1.3000p-49,
+ 0x1.7a11473eb0178p-1, -0x1.d000p-49,
+ 0x1.7b17b0976d060p-1, 0x1.0400p-45,
+ 0x1.7c1ed0130c133p-1, 0x1.0000p-53,
+ 0x1.7d26a62ff8636p-1, -0x1.6900p-45,
+ 0x1.7e2f336cf4e3bp-1, -0x1.2e00p-47,
+ 0x1.7f3878491c3e8p-1, -0x1.4580p-45,
+ 0x1.80427543e1b4ep-1, 0x1.3000p-44,
+ 0x1.814d2add1071ap-1, 0x1.f000p-47,
+ 0x1.82589994ccd7ep-1, -0x1.1c00p-45,
+ 0x1.8364c1eb942d0p-1, 0x1.9d00p-45,
+ 0x1.8471a4623cab5p-1, 0x1.7100p-43,
+ 0x1.857f4179f5bbcp-1, 0x1.2600p-45,
+ 0x1.868d99b4491afp-1, -0x1.2c40p-44,
+ 0x1.879cad931a395p-1, -0x1.3000p-45,
+ 0x1.88ac7d98a65b8p-1, -0x1.a800p-45,
+ 0x1.89bd0a4785800p-1, -0x1.d000p-49,
+ 0x1.8ace5422aa223p-1, 0x1.3280p-44,
+ 0x1.8be05bad619fap-1, 0x1.2b40p-43,
+ 0x1.8cf3216b54383p-1, -0x1.ed00p-45,
+ 0x1.8e06a5e08664cp-1, -0x1.0500p-45,
+ 0x1.8f1ae99157807p-1, 0x1.8280p-45,
+ 0x1.902fed0282c0ep-1, -0x1.cb00p-46,
+ 0x1.9145b0b91ff96p-1, -0x1.5e00p-47,
+ 0x1.925c353aa2ff9p-1, 0x1.5400p-48,
+ 0x1.93737b0cdc64ap-1, 0x1.7200p-46,
+ 0x1.948b82b5f98aep-1, -0x1.9000p-47,
+ 0x1.95a44cbc852cbp-1, 0x1.5680p-45,
+ 0x1.96bdd9a766f21p-1, -0x1.6d00p-44,
+ 0x1.97d829fde4e2ap-1, -0x1.1000p-47,
+ 0x1.98f33e47a23a3p-1, 0x1.d000p-45,
+ 0x1.9a0f170ca0604p-1, -0x1.8a40p-44,
+ 0x1.9b2bb4d53ff89p-1, 0x1.55c0p-44,
+ 0x1.9c49182a3f15bp-1, 0x1.6b80p-45,
+ 0x1.9d674194bb8c5p-1, -0x1.c000p-49,
+ 0x1.9e86319e3238ep-1, 0x1.7d00p-46,
+ 0x1.9fa5e8d07f302p-1, 0x1.6400p-46,
+ 0x1.a0c667b5de54dp-1, -0x1.5000p-48,
+ 0x1.a1e7aed8eb8f6p-1, 0x1.9e00p-47,
+ 0x1.a309bec4a2e27p-1, 0x1.ad80p-45,
+ 0x1.a42c980460a5dp-1, -0x1.af00p-46,
+ 0x1.a5503b23e259bp-1, 0x1.b600p-47,
+ 0x1.a674a8af46213p-1, 0x1.8880p-44,
+ 0x1.a799e1330b3a7p-1, 0x1.1200p-46,
+ 0x1.a8bfe53c12e8dp-1, 0x1.6c00p-47,
+ 0x1.a9e6b5579fcd2p-1, -0x1.9b80p-45,
+ 0x1.ab0e521356fb8p-1, 0x1.b700p-45,
+ 0x1.ac36bbfd3f381p-1, 0x1.9000p-50,
+ 0x1.ad5ff3a3c2780p-1, 0x1.4000p-49,
+ 0x1.ae89f995ad2a3p-1, -0x1.c900p-45,
+ 0x1.afb4ce622f367p-1, 0x1.6500p-46,
+ 0x1.b0e07298db790p-1, 0x1.fd40p-45,
+ 0x1.b20ce6c9a89a9p-1, 0x1.2700p-46,
+ 0x1.b33a2b84f1a4bp-1, 0x1.d470p-43,
+ 0x1.b468415b747e7p-1, -0x1.8380p-44,
+ 0x1.b59728de5593ap-1, 0x1.8000p-54,
+ 0x1.b6c6e29f1c56ap-1, 0x1.ad00p-47,
+ 0x1.b7f76f2fb5e50p-1, 0x1.e800p-50,
+ 0x1.b928cf22749b2p-1, -0x1.4c00p-47,
+ 0x1.ba5b030a10603p-1, -0x1.d700p-47,
+ 0x1.bb8e0b79a6f66p-1, 0x1.d900p-47,
+ 0x1.bcc1e904bc1ffp-1, 0x1.2a00p-47,
+ 0x1.bdf69c3f3a16fp-1, -0x1.f780p-46,
+ 0x1.bf2c25bd71db8p-1, -0x1.0a00p-46,
+ 0x1.c06286141b2e9p-1, -0x1.1400p-46,
+ 0x1.c199bdd8552e0p-1, 0x1.be00p-47,
+ 0x1.c2d1cd9fa64eep-1, -0x1.9400p-47,
+ 0x1.c40ab5fffd02fp-1, -0x1.ed00p-47,
+ 0x1.c544778fafd15p-1, 0x1.9660p-44,
+ 0x1.c67f12e57d0cbp-1, -0x1.a100p-46,
+ 0x1.c7ba88988c1b6p-1, -0x1.8458p-42,
+ 0x1.c8f6d9406e733p-1, -0x1.a480p-46,
+ 0x1.ca3405751c4dfp-1, 0x1.b000p-51,
+ 0x1.cb720dcef9094p-1, 0x1.1400p-47,
+ 0x1.ccb0f2e6d1689p-1, 0x1.0200p-48,
+ 0x1.cdf0b555dc412p-1, 0x1.3600p-48,
+ 0x1.cf3155b5bab3bp-1, -0x1.6900p-47,
+ 0x1.d072d4a0789bcp-1, 0x1.9a00p-47,
+ 0x1.d1b532b08c8fap-1, -0x1.5e00p-46,
+ 0x1.d2f87080d8a85p-1, 0x1.d280p-46,
+ 0x1.d43c8eacaa203p-1, 0x1.1a00p-47,
+ 0x1.d5818dcfba491p-1, 0x1.f000p-50,
+ 0x1.d6c76e862e6a1p-1, -0x1.3a00p-47,
+ 0x1.d80e316c9834ep-1, -0x1.cd80p-47,
+ 0x1.d955d71ff6090p-1, 0x1.4c00p-48,
+ 0x1.da9e603db32aep-1, 0x1.f900p-48,
+ 0x1.dbe7cd63a8325p-1, 0x1.9800p-49,
+ 0x1.dd321f301b445p-1, -0x1.5200p-48,
+ 0x1.de7d5641c05bfp-1, -0x1.d700p-46,
+ 0x1.dfc97337b9aecp-1, -0x1.6140p-46,
+ 0x1.e11676b197d5ep-1, 0x1.b480p-47,
+ 0x1.e264614f5a3e7p-1, 0x1.0ce0p-43,
+ 0x1.e3b333b16ee5cp-1, 0x1.c680p-47,
+ 0x1.e502ee78b3fb4p-1, -0x1.9300p-47,
+ 0x1.e653924676d68p-1, -0x1.5000p-49,
+ 0x1.e7a51fbc74c44p-1, -0x1.7f80p-47,
+ 0x1.e8f7977cdb726p-1, -0x1.3700p-48,
+ 0x1.ea4afa2a490e8p-1, 0x1.5d00p-49,
+ 0x1.eb9f4867ccae4p-1, 0x1.61a0p-46,
+ 0x1.ecf482d8e680dp-1, 0x1.5500p-48,
+ 0x1.ee4aaa2188514p-1, 0x1.6400p-51,
+ 0x1.efa1bee615a13p-1, -0x1.e800p-49,
+ 0x1.f0f9c1cb64106p-1, -0x1.a880p-48,
+ 0x1.f252b376bb963p-1, -0x1.c900p-45,
+ 0x1.f3ac948dd7275p-1, 0x1.a000p-53,
+ 0x1.f50765b6e4524p-1, -0x1.4f00p-48,
+ 0x1.f6632798844fdp-1, 0x1.a800p-51,
+ 0x1.f7bfdad9cbe38p-1, 0x1.abc0p-48,
+ 0x1.f91d802243c82p-1, -0x1.4600p-50,
+ 0x1.fa7c1819e908ep-1, -0x1.b0c0p-47,
+ 0x1.fbdba3692d511p-1, -0x1.0e00p-51,
+ 0x1.fd3c22b8f7194p-1, -0x1.0de8p-46,
+ 0x1.fe9d96b2a23eep-1, 0x1.e430p-49,
+ 0x1.0000000000000p+0, 0x0.0000p+0,
+ 0x1.00b1afa5abcbep+0, -0x1.3400p-52,
+ 0x1.0163da9fb3303p+0, -0x1.2170p-46,
+ 0x1.02168143b0282p+0, 0x1.a400p-52,
+ 0x1.02c9a3e77806cp+0, 0x1.f980p-49,
+ 0x1.037d42e11bbcap+0, -0x1.7400p-51,
+ 0x1.04315e86e7f89p+0, 0x1.8300p-50,
+ 0x1.04e5f72f65467p+0, -0x1.a3f0p-46,
+ 0x1.059b0d315855ap+0, -0x1.2840p-47,
+ 0x1.0650a0e3c1f95p+0, 0x1.1600p-48,
+ 0x1.0706b29ddf71ap+0, 0x1.5240p-46,
+ 0x1.07bd42b72a82dp+0, -0x1.9a00p-49,
+ 0x1.0874518759bd0p+0, 0x1.6400p-49,
+ 0x1.092bdf66607c8p+0, -0x1.0780p-47,
+ 0x1.09e3ecac6f383p+0, -0x1.8000p-54,
+ 0x1.0a9c79b1f3930p+0, 0x1.fa00p-48,
+ 0x1.0b5586cf988fcp+0, -0x1.ac80p-48,
+ 0x1.0c0f145e46c8ap+0, 0x1.9c00p-50,
+ 0x1.0cc922b724816p+0, 0x1.5200p-47,
+ 0x1.0d83b23395dd8p+0, -0x1.ad00p-48,
+ 0x1.0e3ec32d3d1f3p+0, 0x1.bac0p-46,
+ 0x1.0efa55fdfa9a6p+0, -0x1.4e80p-47,
+ 0x1.0fb66affed2f0p+0, -0x1.d300p-47,
+ 0x1.1073028d7234bp+0, 0x1.1500p-48,
+ 0x1.11301d0125b5bp+0, 0x1.c000p-49,
+ 0x1.11edbab5e2af9p+0, 0x1.6bc0p-46,
+ 0x1.12abdc06c31d5p+0, 0x1.8400p-49,
+ 0x1.136a814f2047dp+0, -0x1.ed00p-47,
+ 0x1.1429aaea92de9p+0, 0x1.8e00p-49,
+ 0x1.14e95934f3138p+0, 0x1.b400p-49,
+ 0x1.15a98c8a58e71p+0, 0x1.5300p-47,
+ 0x1.166a45471c3dfp+0, 0x1.3380p-47,
+ 0x1.172b83c7d5211p+0, 0x1.8d40p-45,
+ 0x1.17ed48695bb9fp+0, -0x1.5d00p-47,
+ 0x1.18af9388c8d93p+0, -0x1.c880p-46,
+ 0x1.1972658375d66p+0, 0x1.1f00p-46,
+ 0x1.1a35beb6fcba7p+0, 0x1.0480p-46,
+ 0x1.1af99f81387e3p+0, -0x1.7390p-43,
+ 0x1.1bbe084045d54p+0, 0x1.4e40p-45,
+ 0x1.1c82f95281c43p+0, -0x1.a200p-47,
+ 0x1.1d4873168b9b2p+0, 0x1.3800p-49,
+ 0x1.1e0e75eb44031p+0, 0x1.ac00p-49,
+ 0x1.1ed5022fcd938p+0, 0x1.1900p-47,
+ 0x1.1f9c18438cdf7p+0, -0x1.b780p-46,
+ 0x1.2063b88628d8fp+0, 0x1.d940p-45,
+ 0x1.212be3578a81ep+0, 0x1.8000p-50,
+ 0x1.21f49917ddd41p+0, 0x1.b340p-45,
+ 0x1.22bdda2791323p+0, 0x1.9f80p-46,
+ 0x1.2387a6e7561e7p+0, -0x1.9c80p-46,
+ 0x1.2451ffb821427p+0, 0x1.2300p-47,
+ 0x1.251ce4fb2a602p+0, -0x1.3480p-46,
+ 0x1.25e85711eceb0p+0, 0x1.2700p-46,
+ 0x1.26b4565e27d16p+0, 0x1.1d00p-46,
+ 0x1.2780e341de00fp+0, 0x1.1ee0p-44,
+ 0x1.284dfe1f5633ep+0, -0x1.4c00p-46,
+ 0x1.291ba7591bb30p+0, -0x1.3d80p-46,
+ 0x1.29e9df51fdf09p+0, 0x1.8b00p-47,
+ 0x1.2ab8a66d10e9bp+0, -0x1.27c0p-45,
+ 0x1.2b87fd0dada3ap+0, 0x1.a340p-45,
+ 0x1.2c57e39771af9p+0, -0x1.0800p-46,
+ 0x1.2d285a6e402d9p+0, -0x1.ed00p-47,
+ 0x1.2df961f641579p+0, -0x1.4200p-48,
+ 0x1.2ecafa93e2ecfp+0, -0x1.4980p-45,
+ 0x1.2f9d24abd8822p+0, -0x1.6300p-46,
+ 0x1.306fe0a31b625p+0, -0x1.2360p-44,
+ 0x1.31432edeea50bp+0, -0x1.0df8p-40,
+ 0x1.32170fc4cd7b8p+0, -0x1.2480p-45,
+ 0x1.32eb83ba8e9a2p+0, -0x1.5980p-45,
+ 0x1.33c08b2641766p+0, 0x1.ed00p-46,
+ 0x1.3496266e3fa27p+0, -0x1.c000p-50,
+ 0x1.356c55f929f0fp+0, -0x1.0d80p-44,
+ 0x1.36431a2de88b9p+0, 0x1.2c80p-45,
+ 0x1.371a7373aaa39p+0, 0x1.0600p-45,
+ 0x1.37f26231e74fep+0, -0x1.6600p-46,
+ 0x1.38cae6d05d838p+0, -0x1.ae00p-47,
+ 0x1.39a401b713ec3p+0, -0x1.4720p-43,
+ 0x1.3a7db34e5a020p+0, 0x1.8200p-47,
+ 0x1.3b57fbfec6e95p+0, 0x1.e800p-44,
+ 0x1.3c32dc313a8f2p+0, 0x1.f800p-49,
+ 0x1.3d0e544ede122p+0, -0x1.7a00p-46,
+ 0x1.3dea64c1234bbp+0, 0x1.6300p-45,
+ 0x1.3ec70df1c4eccp+0, -0x1.8a60p-43,
+ 0x1.3fa4504ac7e8cp+0, -0x1.cdc0p-44,
+ 0x1.40822c367a0bbp+0, 0x1.5b80p-45,
+ 0x1.4160a21f72e95p+0, 0x1.ec00p-46,
+ 0x1.423fb27094646p+0, -0x1.3600p-46,
+ 0x1.431f5d950a920p+0, 0x1.3980p-45,
+ 0x1.43ffa3f84b9ebp+0, 0x1.a000p-48,
+ 0x1.44e0860618919p+0, -0x1.6c00p-48,
+ 0x1.45c2042a7d201p+0, -0x1.bc00p-47,
+ 0x1.46a41ed1d0016p+0, -0x1.2800p-46,
+ 0x1.4786d668b3326p+0, 0x1.0e00p-44,
+ 0x1.486a2b5c13c00p+0, -0x1.d400p-45,
+ 0x1.494e1e192af04p+0, 0x1.c200p-47,
+ 0x1.4a32af0d7d372p+0, -0x1.e500p-46,
+ 0x1.4b17dea6db801p+0, 0x1.7800p-47,
+ 0x1.4bfdad53629e1p+0, -0x1.3800p-46,
+ 0x1.4ce41b817c132p+0, 0x1.0800p-47,
+ 0x1.4dcb299fddddbp+0, 0x1.c700p-45,
+ 0x1.4eb2d81d8ab96p+0, -0x1.ce00p-46,
+ 0x1.4f9b2769d2d02p+0, 0x1.9200p-46,
+ 0x1.508417f4531c1p+0, -0x1.8c00p-47,
+ 0x1.516daa2cf662ap+0, -0x1.a000p-48,
+ 0x1.5257de83f51eap+0, 0x1.a080p-43,
+ 0x1.5342b569d4edap+0, -0x1.6d80p-45,
+ 0x1.542e2f4f6ac1ap+0, -0x1.2440p-44,
+ 0x1.551a4ca5d94dbp+0, 0x1.83c0p-43,
+ 0x1.56070dde9116bp+0, 0x1.4b00p-45,
+ 0x1.56f4736b529dep+0, 0x1.15a0p-43,
+ 0x1.57e27dbe2c40ep+0, -0x1.9e00p-45,
+ 0x1.58d12d497c76fp+0, -0x1.3080p-45,
+ 0x1.59c0827ff0b4cp+0, 0x1.dec0p-43,
+ 0x1.5ab07dd485427p+0, -0x1.4000p-51,
+ 0x1.5ba11fba87af4p+0, 0x1.0080p-44,
+ 0x1.5c9268a59460bp+0, -0x1.6c80p-45,
+ 0x1.5d84590998e3fp+0, 0x1.69a0p-43,
+ 0x1.5e76f15ad20e1p+0, -0x1.b400p-46,
+ 0x1.5f6a320dcebcap+0, 0x1.7700p-46,
+ 0x1.605e1b976dcb8p+0, 0x1.6f80p-45,
+ 0x1.6152ae6cdf715p+0, 0x1.1000p-47,
+ 0x1.6247eb03a5531p+0, -0x1.5d00p-46,
+ 0x1.633dd1d1929b5p+0, -0x1.2d00p-46,
+ 0x1.6434634ccc313p+0, -0x1.a800p-49,
+ 0x1.652b9febc8efap+0, -0x1.8600p-45,
+ 0x1.6623882553397p+0, 0x1.1fe0p-40,
+ 0x1.671c1c708328ep+0, -0x1.7200p-44,
+ 0x1.68155d44ca97ep+0, 0x1.6800p-49,
+ 0x1.690f4b19e9471p+0, -0x1.9780p-45,
+};
+
+/*
+ * exp2(x): compute the base 2 exponential of x
+ *
+ * Accuracy: Peak error < 0.503 ulp for normalized results.
+ *
+ * Method: (accurate tables)
+ *
+ * Reduce x:
+ * x = 2**k + y, for integer k and |y| <= 1/2.
+ * Thus we have exp2(x) = 2**k * exp2(y).
+ *
+ * Reduce y:
+ * y = i/TBLSIZE + z - eps[i] for integer i near y * TBLSIZE.
+ * Thus we have exp2(y) = exp2(i/TBLSIZE) * exp2(z - eps[i]),
+ * with |z - eps[i]| <= 2**-9 + 2**-39 for the table used.
+ *
+ * We compute exp2(i/TBLSIZE) via table lookup and exp2(z - eps[i]) via
+ * a degree-5 minimax polynomial with maximum error under 1.3 * 2**-61.
+ * The values in exp2t[] and eps[] are chosen such that
+ * exp2t[i] = exp2(i/TBLSIZE + eps[i]), and eps[i] is a small offset such
+ * that exp2t[i] is accurate to 2**-64.
+ *
+ * Note that the range of i is +-TBLSIZE/2, so we actually index the tables
+ * by i0 = i + TBLSIZE/2. For cache efficiency, exp2t[] and eps[] are
+ * virtual tables, interleaved in the real table tbl[].
+ *
+ * This method is due to Gal, with many details due to Gal and Bachelis:
+ *
+ * Gal, S. and Bachelis, B. An Accurate Elementary Mathematical Library
+ * for the IEEE Floating Point Standard. TOMS 17(1), 26-46 (1991).
+ */
+double exp2(double x)
+{
+ double r, t, twopk, twopkp1000, z;
+ uint32_t hx, ix, lx, i0;
+ int k;
+
+ /* Filter out exceptional cases. */
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x40900000) { /* |x| >= 1024 */
+ if (ix >= 0x7ff00000) {
+ GET_LOW_WORD(lx, x);
+ if (((ix & 0xfffff) | lx) != 0 || (hx & 0x80000000) == 0)
+ return x + x; /* x is NaN or +Inf */
+ else
+ return 0.0; /* x is -Inf */
+ }
+ if (x >= 0x1.0p10)
+ return huge * huge; /* overflow */
+ if (x <= -0x1.0ccp10)
+ return twom1000 * twom1000; /* underflow */
+ } else if (ix < 0x3c900000) { /* |x| < 0x1p-54 */
+ return 1.0 + x;
+ }
+
+ /* Reduce x, computing z, i0, and k. */
+ STRICT_ASSIGN(double, t, x + redux);
+ GET_LOW_WORD(i0, t);
+ i0 += TBLSIZE / 2;
+ k = (i0 >> TBLBITS) << 20;
+ i0 = (i0 & (TBLSIZE - 1)) << 1;
+ t -= redux;
+ z = x - t;
+
+ /* Compute r = exp2(y) = exp2t[i0] * p(z - eps[i]). */
+ t = tbl[i0]; /* exp2t[i0] */
+ z -= tbl[i0 + 1]; /* eps[i0] */
+ if (k >= -1021 << 20)
+ INSERT_WORDS(twopk, 0x3ff00000 + k, 0);
+ else
+ INSERT_WORDS(twopkp1000, 0x3ff00000 + k + (1000 << 20), 0);
+ r = t + t * z * (P1 + z * (P2 + z * (P3 + z * (P4 + z * P5))));
+
+ /* Scale by 2**(k>>20). */
+ if (k < -1021 << 20)
+ return r * twopkp1000 * twom1000;
+ if (k == 1024 << 20)
+ return r * 2.0 * 0x1p1023;
+ return r * twopk;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_exp2f.c */
+/*-
+ * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+#define TBLBITS 4
+#define TBLSIZE (1 << TBLBITS)
+
+static const float
+huge = 0x1p100f,
+redux = 0x1.8p23f / TBLSIZE,
+P1 = 0x1.62e430p-1f,
+P2 = 0x1.ebfbe0p-3f,
+P3 = 0x1.c6b348p-5f,
+P4 = 0x1.3b2c9cp-7f;
+
+static volatile float twom100 = 0x1p-100f;
+
+static const double exp2ft[TBLSIZE] = {
+ 0x1.6a09e667f3bcdp-1,
+ 0x1.7a11473eb0187p-1,
+ 0x1.8ace5422aa0dbp-1,
+ 0x1.9c49182a3f090p-1,
+ 0x1.ae89f995ad3adp-1,
+ 0x1.c199bdd85529cp-1,
+ 0x1.d5818dcfba487p-1,
+ 0x1.ea4afa2a490dap-1,
+ 0x1.0000000000000p+0,
+ 0x1.0b5586cf9890fp+0,
+ 0x1.172b83c7d517bp+0,
+ 0x1.2387a6e756238p+0,
+ 0x1.306fe0a31b715p+0,
+ 0x1.3dea64c123422p+0,
+ 0x1.4bfdad5362a27p+0,
+ 0x1.5ab07dd485429p+0,
+};
+
+/*
+ * exp2f(x): compute the base 2 exponential of x
+ *
+ * Accuracy: Peak error < 0.501 ulp; location of peak: -0.030110927.
+ *
+ * Method: (equally-spaced tables)
+ *
+ * Reduce x:
+ * x = 2**k + y, for integer k and |y| <= 1/2.
+ * Thus we have exp2f(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**-(TBLSIZE+1).
+ *
+ * We compute exp2(i/TBLSIZE) via table lookup and exp2(z) via a
+ * degree-4 minimax polynomial with maximum error under 1.4 * 2**-33.
+ * Using double precision for everything except the reduction makes
+ * roundoff error insignificant and simplifies the scaling step.
+ *
+ * This method is due to Tang, but I do not use his suggested parameters:
+ *
+ * Tang, P. Table-driven Implementation of the Exponential Function
+ * in IEEE Floating-Point Arithmetic. TOMS 15(2), 144-157 (1989).
+ */
+float exp2f(float x)
+{
+ double tv, twopk, u, z;
+ float t;
+ uint32_t hx, ix, i0;
+ int32_t k;
+
+ /* Filter out exceptional cases. */
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x43000000) { /* |x| >= 128 */
+ if (ix >= 0x7f800000) {
+ if ((ix & 0x7fffff) != 0 || (hx & 0x80000000) == 0)
+ return x + x; /* x is NaN or +Inf */
+ else
+ return 0.0; /* x is -Inf */
+ }
+ if (x >= 0x1.0p7f)
+ return huge * huge; /* overflow */
+ if (x <= -0x1.2cp7f)
+ return twom100 * twom100; /* underflow */
+ } else if (ix <= 0x33000000) { /* |x| <= 0x1p-25 */
+ return 1.0f + x;
+ }
+
+ /* Reduce x, computing z, i0, and k. */
+ STRICT_ASSIGN(float, t, x + redux);
+ GET_FLOAT_WORD(i0, t);
+ i0 += TBLSIZE / 2;
+ k = (i0 >> TBLBITS) << 20;
+ i0 &= TBLSIZE - 1;
+ t -= redux;
+ z = x - t;
+ INSERT_WORDS(twopk, 0x3ff00000 + k, 0);
+
+ /* Compute r = exp2(y) = exp2ft[i0] * p(z). */
+ tv = exp2ft[i0];
+ u = tv * z;
+ tv = tv + u * (P1 + z * P2) + u * (z * z) * (P3 + z * P4);
+
+ /* Scale by 2**(k>>20). */
+ return tv * twopk;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/ld80/s_exp2l.c */
+/*-
+ * Copyright (c) 2005-2008 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double exp2l(long double x)
+{
+ return exp2l(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+
+#define TBLBITS 7
+#define TBLSIZE (1 << TBLBITS)
+
+#define BIAS (LDBL_MAX_EXP - 1)
+#define EXPMASK (BIAS + LDBL_MAX_EXP)
+
+static const long double huge = 0x1p10000L;
+/* XXX Prevent gcc from erroneously constant folding this. */
+static volatile long double twom10000 = 0x1p-10000L;
+
+static const double
+redux = 0x1.8p63 / TBLSIZE,
+P1 = 0x1.62e42fefa39efp-1,
+P2 = 0x1.ebfbdff82c58fp-3,
+P3 = 0x1.c6b08d7049fap-5,
+P4 = 0x1.3b2ab6fba4da5p-7,
+P5 = 0x1.5d8804780a736p-10,
+P6 = 0x1.430918835e33dp-13;
+
+static const double tbl[TBLSIZE * 2] = {
+ 0x1.6a09e667f3bcdp-1, -0x1.bdd3413b2648p-55,
+ 0x1.6c012750bdabfp-1, -0x1.2895667ff0cp-57,
+ 0x1.6dfb23c651a2fp-1, -0x1.bbe3a683c88p-58,
+ 0x1.6ff7df9519484p-1, -0x1.83c0f25860fp-56,
+ 0x1.71f75e8ec5f74p-1, -0x1.16e4786887bp-56,
+ 0x1.73f9a48a58174p-1, -0x1.0a8d96c65d5p-55,
+ 0x1.75feb564267c9p-1, -0x1.0245957316ep-55,
+ 0x1.780694fde5d3fp-1, 0x1.866b80a0216p-55,
+ 0x1.7a11473eb0187p-1, -0x1.41577ee0499p-56,
+ 0x1.7c1ed0130c132p-1, 0x1.f124cd1164ep-55,
+ 0x1.7e2f336cf4e62p-1, 0x1.05d02ba157ap-57,
+ 0x1.80427543e1a12p-1, -0x1.27c86626d97p-55,
+ 0x1.82589994cce13p-1, -0x1.d4c1dd41533p-55,
+ 0x1.8471a4623c7adp-1, -0x1.8d684a341cep-56,
+ 0x1.868d99b4492edp-1, -0x1.fc6f89bd4f68p-55,
+ 0x1.88ac7d98a6699p-1, 0x1.994c2f37cb5p-55,
+ 0x1.8ace5422aa0dbp-1, 0x1.6e9f156864bp-55,
+ 0x1.8cf3216b5448cp-1, -0x1.0d55e32e9e4p-57,
+ 0x1.8f1ae99157736p-1, 0x1.5cc13a2e397p-56,
+ 0x1.9145b0b91ffc6p-1, -0x1.dd6792e5825p-55,
+ 0x1.93737b0cdc5e5p-1, -0x1.75fc781b58p-58,
+ 0x1.95a44cbc8520fp-1, -0x1.64b7c96a5fp-57,
+ 0x1.97d829fde4e5p-1, -0x1.d185b7c1b86p-55,
+ 0x1.9a0f170ca07bap-1, -0x1.173bd91cee6p-55,
+ 0x1.9c49182a3f09p-1, 0x1.c7c46b071f2p-57,
+ 0x1.9e86319e32323p-1, 0x1.824ca78e64cp-57,
+ 0x1.a0c667b5de565p-1, -0x1.359495d1cd5p-55,
+ 0x1.a309bec4a2d33p-1, 0x1.6305c7ddc368p-55,
+ 0x1.a5503b23e255dp-1, -0x1.d2f6edb8d42p-55,
+ 0x1.a799e1330b358p-1, 0x1.bcb7ecac564p-55,
+ 0x1.a9e6b5579fdbfp-1, 0x1.0fac90ef7fdp-55,
+ 0x1.ac36bbfd3f37ap-1, -0x1.f9234cae76dp-56,
+ 0x1.ae89f995ad3adp-1, 0x1.7a1cd345dcc8p-55,
+ 0x1.b0e07298db666p-1, -0x1.bdef54c80e4p-55,
+ 0x1.b33a2b84f15fbp-1, -0x1.2805e3084d8p-58,
+ 0x1.b59728de5593ap-1, -0x1.c71dfbbba6ep-55,
+ 0x1.b7f76f2fb5e47p-1, -0x1.5584f7e54acp-57,
+ 0x1.ba5b030a1064ap-1, -0x1.efcd30e5429p-55,
+ 0x1.bcc1e904bc1d2p-1, 0x1.23dd07a2d9fp-56,
+ 0x1.bf2c25bd71e09p-1, -0x1.efdca3f6b9c8p-55,
+ 0x1.c199bdd85529cp-1, 0x1.11065895049p-56,
+ 0x1.c40ab5fffd07ap-1, 0x1.b4537e083c6p-55,
+ 0x1.c67f12e57d14bp-1, 0x1.2884dff483c8p-55,
+ 0x1.c8f6d9406e7b5p-1, 0x1.1acbc48805cp-57,
+ 0x1.cb720dcef9069p-1, 0x1.503cbd1e94ap-57,
+ 0x1.cdf0b555dc3fap-1, -0x1.dd83b53829dp-56,
+ 0x1.d072d4a07897cp-1, -0x1.cbc3743797a8p-55,
+ 0x1.d2f87080d89f2p-1, -0x1.d487b719d858p-55,
+ 0x1.d5818dcfba487p-1, 0x1.2ed02d75b37p-56,
+ 0x1.d80e316c98398p-1, -0x1.11ec18bedep-55,
+ 0x1.da9e603db3285p-1, 0x1.c2300696db5p-55,
+ 0x1.dd321f301b46p-1, 0x1.2da5778f019p-55,
+ 0x1.dfc97337b9b5fp-1, -0x1.1a5cd4f184b8p-55,
+ 0x1.e264614f5a129p-1, -0x1.7b627817a148p-55,
+ 0x1.e502ee78b3ff6p-1, 0x1.39e8980a9cdp-56,
+ 0x1.e7a51fbc74c83p-1, 0x1.2d522ca0c8ep-55,
+ 0x1.ea4afa2a490dap-1, -0x1.e9c23179c288p-55,
+ 0x1.ecf482d8e67f1p-1, -0x1.c93f3b411ad8p-55,
+ 0x1.efa1bee615a27p-1, 0x1.dc7f486a4b68p-55,
+ 0x1.f252b376bba97p-1, 0x1.3a1a5bf0d8e8p-55,
+ 0x1.f50765b6e454p-1, 0x1.9d3e12dd8a18p-55,
+ 0x1.f7bfdad9cbe14p-1, -0x1.dbb12d00635p-55,
+ 0x1.fa7c1819e90d8p-1, 0x1.74853f3a593p-56,
+ 0x1.fd3c22b8f71f1p-1, 0x1.2eb74966578p-58,
+ 0x1p+0, 0x0p+0,
+ 0x1.0163da9fb3335p+0, 0x1.b61299ab8cd8p-54,
+ 0x1.02c9a3e778061p+0, -0x1.19083535b08p-56,
+ 0x1.04315e86e7f85p+0, -0x1.0a31c1977c98p-54,
+ 0x1.059b0d3158574p+0, 0x1.d73e2a475b4p-55,
+ 0x1.0706b29ddf6dep+0, -0x1.c91dfe2b13cp-55,
+ 0x1.0874518759bc8p+0, 0x1.186be4bb284p-57,
+ 0x1.09e3ecac6f383p+0, 0x1.14878183161p-54,
+ 0x1.0b5586cf9890fp+0, 0x1.8a62e4adc61p-54,
+ 0x1.0cc922b7247f7p+0, 0x1.01edc16e24f8p-54,
+ 0x1.0e3ec32d3d1a2p+0, 0x1.03a1727c58p-59,
+ 0x1.0fb66affed31bp+0, -0x1.b9bedc44ebcp-57,
+ 0x1.11301d0125b51p+0, -0x1.6c51039449bp-54,
+ 0x1.12abdc06c31ccp+0, -0x1.1b514b36ca8p-58,
+ 0x1.1429aaea92dep+0, -0x1.32fbf9af1368p-54,
+ 0x1.15a98c8a58e51p+0, 0x1.2406ab9eeabp-55,
+ 0x1.172b83c7d517bp+0, -0x1.19041b9d78ap-55,
+ 0x1.18af9388c8deap+0, -0x1.11023d1970f8p-54,
+ 0x1.1a35beb6fcb75p+0, 0x1.e5b4c7b4969p-55,
+ 0x1.1bbe084045cd4p+0, -0x1.95386352ef6p-54,
+ 0x1.1d4873168b9aap+0, 0x1.e016e00a264p-54,
+ 0x1.1ed5022fcd91dp+0, -0x1.1df98027bb78p-54,
+ 0x1.2063b88628cd6p+0, 0x1.dc775814a85p-55,
+ 0x1.21f49917ddc96p+0, 0x1.2a97e9494a6p-55,
+ 0x1.2387a6e756238p+0, 0x1.9b07eb6c7058p-54,
+ 0x1.251ce4fb2a63fp+0, 0x1.ac155bef4f5p-55,
+ 0x1.26b4565e27cddp+0, 0x1.2bd339940eap-55,
+ 0x1.284dfe1f56381p+0, -0x1.a4c3a8c3f0d8p-54,
+ 0x1.29e9df51fdee1p+0, 0x1.612e8afad12p-55,
+ 0x1.2b87fd0dad99p+0, -0x1.10adcd6382p-59,
+ 0x1.2d285a6e4030bp+0, 0x1.0024754db42p-54,
+ 0x1.2ecafa93e2f56p+0, 0x1.1ca0f45d524p-56,
+ 0x1.306fe0a31b715p+0, 0x1.6f46ad23183p-55,
+ 0x1.32170fc4cd831p+0, 0x1.a9ce78e1804p-55,
+ 0x1.33c08b26416ffp+0, 0x1.327218436598p-54,
+ 0x1.356c55f929ff1p+0, -0x1.b5cee5c4e46p-55,
+ 0x1.371a7373aa9cbp+0, -0x1.63aeabf42ebp-54,
+ 0x1.38cae6d05d866p+0, -0x1.e958d3c99048p-54,
+ 0x1.3a7db34e59ff7p+0, -0x1.5e436d661f6p-56,
+ 0x1.3c32dc313a8e5p+0, -0x1.efff8375d2ap-54,
+ 0x1.3dea64c123422p+0, 0x1.ada0911f09fp-55,
+ 0x1.3fa4504ac801cp+0, -0x1.7d023f956fap-54,
+ 0x1.4160a21f72e2ap+0, -0x1.ef3691c309p-58,
+ 0x1.431f5d950a897p+0, -0x1.1c7dde35f7ap-55,
+ 0x1.44e086061892dp+0, 0x1.89b7a04ef8p-59,
+ 0x1.46a41ed1d0057p+0, 0x1.c944bd1648a8p-54,
+ 0x1.486a2b5c13cdp+0, 0x1.3c1a3b69062p-56,
+ 0x1.4a32af0d7d3dep+0, 0x1.9cb62f3d1be8p-54,
+ 0x1.4bfdad5362a27p+0, 0x1.d4397afec42p-56,
+ 0x1.4dcb299fddd0dp+0, 0x1.8ecdbbc6a78p-54,
+ 0x1.4f9b2769d2ca7p+0, -0x1.4b309d25958p-54,
+ 0x1.516daa2cf6642p+0, -0x1.f768569bd94p-55,
+ 0x1.5342b569d4f82p+0, -0x1.07abe1db13dp-55,
+ 0x1.551a4ca5d920fp+0, -0x1.d689cefede6p-55,
+ 0x1.56f4736b527dap+0, 0x1.9bb2c011d938p-54,
+ 0x1.58d12d497c7fdp+0, 0x1.295e15b9a1ep-55,
+ 0x1.5ab07dd485429p+0, 0x1.6324c0546478p-54,
+ 0x1.5c9268a5946b7p+0, 0x1.c4b1b81698p-60,
+ 0x1.5e76f15ad2148p+0, 0x1.ba6f93080e68p-54,
+ 0x1.605e1b976dc09p+0, -0x1.3e2429b56de8p-54,
+ 0x1.6247eb03a5585p+0, -0x1.383c17e40b48p-54,
+ 0x1.6434634ccc32p+0, -0x1.c483c759d89p-55,
+ 0x1.6623882552225p+0, -0x1.bb60987591cp-54,
+ 0x1.68155d44ca973p+0, 0x1.038ae44f74p-57,
+};
+
+/*
+ * 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, twopk, twopkp10000, z;
+ uint32_t hx, ix, i0;
+ int 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 == BIAS + LDBL_MAX_EXP) {
+ if (u.xbits.man != 1ULL << 63 || (hx & 0x8000) == 0)
+ return x + x; /* x is +Inf or NaN */
+ return 0.0; /* x is -Inf */
+ }
+ if (x >= 16384)
+ return huge * huge; /* overflow */
+ if (x <= -16446)
+ return twom10000 * twom10000; /* underflow */
+ } else if (ix <= BIAS - 66) { /* |x| < 0x1p-66 */
+ return 1.0 + 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.
+ *
+ * XXX If the exponent is negative, the computation of k depends on
+ * '>>' doing sign extension.
+ */
+ u.e = x + redux;
+ i0 = u.bits.manl + TBLSIZE / 2;
+ k = (int)i0 >> TBLBITS;
+ i0 = (i0 & (TBLSIZE - 1)) << 1;
+ u.e -= redux;
+ z = x - u.e;
+ v.xbits.man = 1ULL << 63;
+ if (k >= LDBL_MIN_EXP) {
+ v.xbits.expsign = LDBL_MAX_EXP - 1 + k;
+ twopk = v.e;
+ } else {
+ v.xbits.expsign = LDBL_MAX_EXP - 1 + k + 10000;
+ twopkp10000 = v.e;
+ }
+
+ /* Compute r = exp2l(y) = exp2lt[i0] * p(z). */
+ long double t_hi = tbl[i0];
+ long double t_lo = tbl[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;
+
+ /* Scale by 2**k. */
+ if (k >= LDBL_MIN_EXP) {
+ if (k == LDBL_MAX_EXP)
+ return r * 2.0 * 0x1p16383L;
+ return r * twopk;
+ }
+ return r * twopkp10000 * twom10000;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_expf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+one = 1.0,
+halF[2] = {0.5,-0.5,},
+huge = 1.0e+30,
+o_threshold = 8.8721679688e+01, /* 0x42b17180 */
+u_threshold = -1.0397208405e+02, /* 0xc2cff1b5 */
+ln2HI[2] = { 6.9314575195e-01, /* 0x3f317200 */
+ -6.9314575195e-01,},/* 0xbf317200 */
+ln2LO[2] = { 1.4286067653e-06, /* 0x35bfbe8e */
+ -1.4286067653e-06,},/* 0xb5bfbe8e */
+invln2 = 1.4426950216e+00, /* 0x3fb8aa3b */
+/*
+ * Domain [-0.34568, 0.34568], range ~[-4.278e-9, 4.447e-9]:
+ * |x*(exp(x)+1)/(exp(x)-1) - p(x)| < 2**-27.74
+ */
+P1 = 1.6666625440e-1, /* 0xaaaa8f.0p-26 */
+P2 = -2.7667332906e-3; /* -0xb55215.0p-32 */
+
+static volatile float twom100 = 7.8886090522e-31; /* 2**-100=0x0d800000 */
+
+float expf(float x)
+{
+ float y,hi=0.0,lo=0.0,c,t,twopk;
+ int32_t k=0,xsb;
+ uint32_t hx;
+
+ GET_FLOAT_WORD(hx, x);
+ xsb = (hx>>31)&1; /* sign bit of x */
+ hx &= 0x7fffffff; /* high word of |x| */
+
+ /* filter out non-finite argument */
+ if (hx >= 0x42b17218) { /* if |x|>=88.721... */
+ if (hx > 0x7f800000) /* NaN */
+ return x+x;
+ if (hx == 0x7f800000) /* exp(+-inf)={inf,0} */
+ return xsb==0 ? x : 0.0;
+ if (x > o_threshold)
+ return huge*huge; /* overflow */
+ if (x < u_threshold)
+ return twom100*twom100; /* underflow */
+ }
+
+ /* argument reduction */
+ if (hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */
+ if (hx < 0x3F851592) { /* and |x| < 1.5 ln2 */
+ hi = x-ln2HI[xsb];
+ lo = ln2LO[xsb];
+ k = 1 - xsb - xsb;
+ } else {
+ k = invln2*x + halF[xsb];
+ t = k;
+ hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */
+ lo = t*ln2LO[0];
+ }
+ STRICT_ASSIGN(float, x, hi - lo);
+ } else if(hx < 0x39000000) { /* |x|<2**-14 */
+ /* raise inexact */
+ if (huge+x > one)
+ return one + x;
+ } else
+ k = 0;
+
+ /* x is now in primary range */
+ t = x*x;
+ if (k >= -125)
+ SET_FLOAT_WORD(twopk, 0x3f800000+(k<<23));
+ else
+ SET_FLOAT_WORD(twopk, 0x3f800000+((k+100)<<23));
+ c = x - t*(P1+t*P2);
+ if (k == 0)
+ return one - ((x*c)/(c-(float)2.0)-x);
+ y = one - ((lo-(x*c)/((float)2.0-c))-hi);
+ if (k < -125)
+ return y*twopk*twom100;
+ if (k == 128)
+ return y*2.0F*0x1p127F;
+ return y*twopk;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_expl.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Exponential function, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, expl();
+ *
+ * y = expl( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns e (2.71828...) raised to the x power.
+ *
+ * Range reduction is accomplished by separating the argument
+ * into an integer k and fraction f such that
+ *
+ * x k f
+ * e = 2 e.
+ *
+ * A Pade' form of degree 2/3 is used to approximate exp(f) - 1
+ * in the basic range [-0.5 ln 2, 0.5 ln 2].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE +-10000 50000 1.12e-19 2.81e-20
+ *
+ *
+ * Error amplification in the exponential function can be
+ * a serious matter. The error propagation involves
+ * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ),
+ * which shows that a 1 lsb error in representing X produces
+ * a relative error of X times 1 lsb in the function.
+ * While the routine gives an accurate result for arguments
+ * that are exactly represented by a long double precision
+ * computer number, the result contains amplified roundoff
+ * error for large arguments not exactly represented.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * exp underflow x < MINLOG 0.0
+ * exp overflow x > MAXLOG MAXNUM
+ *
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double expl(long double x)
+{
+ return exp(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+
+static long double P[3] = {
+ 1.2617719307481059087798E-4L,
+ 3.0299440770744196129956E-2L,
+ 9.9999999999999999991025E-1L,
+};
+static long double Q[4] = {
+ 3.0019850513866445504159E-6L,
+ 2.5244834034968410419224E-3L,
+ 2.2726554820815502876593E-1L,
+ 2.0000000000000000000897E0L,
+};
+static const long double
+C1 = 6.9314575195312500000000E-1L,
+C2 = 1.4286068203094172321215E-6L,
+MAXLOGL = 1.1356523406294143949492E4L,
+MINLOGL = -1.13994985314888605586758E4L,
+LOG2EL = 1.4426950408889634073599E0L;
+
+long double expl(long double x)
+{
+ long double px, xx;
+ int n;
+
+ if (isnan(x))
+ return x;
+ if (x > MAXLOGL)
+ return INFINITY;
+ if (x < MINLOGL)
+ return 0.0L;
+
+ /* Express e**x = e**g 2**n
+ * = e**g e**(n loge(2))
+ * = e**(g + n loge(2))
+ */
+ px = floorl(LOG2EL * x + 0.5L); /* floor() truncates toward -infinity. */
+ n = px;
+ x -= px * C1;
+ x -= px * C2;
+
+ /* rational approximation for exponential
+ * of the fractional part:
+ * e**x = 1 + 2x P(x**2)/(Q(x**2) - P(x**2))
+ */
+ xx = x * x;
+ px = x * __polevll(xx, P, 2);
+ x = px/(__polevll(xx, Q, 3) - px);
+ x = 1.0L + ldexpl(x, 1);
+ x = ldexpl(x, n);
+ return x;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_expm1.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* expm1(x)
+ * Returns exp(x)-1, the exponential of x minus 1.
+ *
+ * Method
+ * 1. Argument reduction:
+ * Given x, find r and integer k such that
+ *
+ * x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658
+ *
+ * Here a correction term c will be computed to compensate
+ * the error in r when rounded to a floating-point number.
+ *
+ * 2. Approximating expm1(r) by a special rational function on
+ * the interval [0,0.34658]:
+ * Since
+ * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ...
+ * we define R1(r*r) by
+ * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r)
+ * That is,
+ * R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r)
+ * = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r))
+ * = 1 - r^2/60 + r^4/2520 - r^6/100800 + ...
+ * We use a special Reme algorithm on [0,0.347] to generate
+ * a polynomial of degree 5 in r*r to approximate R1. The
+ * maximum error of this polynomial approximation is bounded
+ * by 2**-61. In other words,
+ * R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5
+ * where Q1 = -1.6666666666666567384E-2,
+ * Q2 = 3.9682539681370365873E-4,
+ * Q3 = -9.9206344733435987357E-6,
+ * Q4 = 2.5051361420808517002E-7,
+ * Q5 = -6.2843505682382617102E-9;
+ * z = r*r,
+ * with error bounded by
+ * | 5 | -61
+ * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2
+ * | |
+ *
+ * expm1(r) = exp(r)-1 is then computed by the following
+ * specific way which minimize the accumulation rounding error:
+ * 2 3
+ * r r [ 3 - (R1 + R1*r/2) ]
+ * expm1(r) = r + --- + --- * [--------------------]
+ * 2 2 [ 6 - r*(3 - R1*r/2) ]
+ *
+ * To compensate the error in the argument reduction, we use
+ * expm1(r+c) = expm1(r) + c + expm1(r)*c
+ * ~ expm1(r) + c + r*c
+ * Thus c+r*c will be added in as the correction terms for
+ * expm1(r+c). Now rearrange the term to avoid optimization
+ * screw up:
+ * ( 2 2 )
+ * ({ ( r [ R1 - (3 - R1*r/2) ] ) } r )
+ * expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- )
+ * ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 )
+ * ( )
+ *
+ * = r - E
+ * 3. Scale back to obtain expm1(x):
+ * From step 1, we have
+ * expm1(x) = either 2^k*[expm1(r)+1] - 1
+ * = or 2^k*[expm1(r) + (1-2^-k)]
+ * 4. Implementation notes:
+ * (A). To save one multiplication, we scale the coefficient Qi
+ * to Qi*2^i, and replace z by (x^2)/2.
+ * (B). To achieve maximum accuracy, we compute expm1(x) by
+ * (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf)
+ * (ii) if k=0, return r-E
+ * (iii) if k=-1, return 0.5*(r-E)-0.5
+ * (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E)
+ * else return 1.0+2.0*(r-E);
+ * (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1)
+ * (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else
+ * (vii) return 2^k(1-((E+2^-k)-r))
+ *
+ * Special cases:
+ * expm1(INF) is INF, expm1(NaN) is NaN;
+ * expm1(-INF) is -1, and
+ * for finite argument, only expm1(0)=0 is exact.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Misc. info.
+ * For IEEE double
+ * if x > 7.09782712893383973096e+02 then expm1(x) overflow
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "libm.h"
+
+static const double
+one = 1.0,
+huge = 1.0e+300,
+tiny = 1.0e-300,
+o_threshold = 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
+ln2_hi = 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */
+ln2_lo = 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */
+invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */
+/* Scaled Q's: Qn_here = 2**n * Qn_above, for R(2*z) where z = hxs = x*x/2: */
+Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */
+Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */
+Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */
+Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */
+Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */
+
+double expm1(double x)
+{
+ double y,hi,lo,c,t,e,hxs,hfx,r1,twopk;
+ int32_t k,xsb;
+ uint32_t hx;
+
+ GET_HIGH_WORD(hx, x);
+ xsb = hx&0x80000000; /* sign bit of x */
+ hx &= 0x7fffffff; /* high word of |x| */
+
+ /* filter out huge and non-finite argument */
+ if (hx >= 0x4043687A) { /* if |x|>=56*ln2 */
+ if (hx >= 0x40862E42) { /* if |x|>=709.78... */
+ if (hx >= 0x7ff00000) {
+ uint32_t low;
+
+ GET_LOW_WORD(low, x);
+ if (((hx&0xfffff)|low) != 0) /* NaN */
+ return x+x;
+ return xsb==0 ? x : -1.0; /* exp(+-inf)={inf,-1} */
+ }
+ if(x > o_threshold)
+ return huge*huge; /* overflow */
+ }
+ if (xsb != 0) { /* x < -56*ln2, return -1.0 with inexact */
+ /* raise inexact */
+ if(x+tiny<0.0)
+ return tiny-one; /* return -1 */
+ }
+ }
+
+ /* argument reduction */
+ if (hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
+ if (hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
+ if (xsb == 0) {
+ hi = x - ln2_hi;
+ lo = ln2_lo;
+ k = 1;
+ } else {
+ hi = x + ln2_hi;
+ lo = -ln2_lo;
+ k = -1;
+ }
+ } else {
+ k = invln2*x + (xsb==0 ? 0.5 : -0.5);
+ t = k;
+ hi = x - t*ln2_hi; /* t*ln2_hi is exact here */
+ lo = t*ln2_lo;
+ }
+ STRICT_ASSIGN(double, x, hi - lo);
+ c = (hi-x)-lo;
+ } else if (hx < 0x3c900000) { /* |x| < 2**-54, return x */
+ /* raise inexact flags when x != 0 */
+ t = huge+x;
+ return x - (t-(huge+x));
+ } else
+ k = 0;
+
+ /* x is now in primary range */
+ hfx = 0.5*x;
+ hxs = x*hfx;
+ r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5))));
+ t = 3.0-r1*hfx;
+ e = hxs*((r1-t)/(6.0 - x*t));
+ if (k == 0) /* c is 0 */
+ return x - (x*e-hxs);
+ INSERT_WORDS(twopk, 0x3ff00000+(k<<20), 0); /* 2^k */
+ e = x*(e-c) - c;
+ e -= hxs;
+ if (k == -1)
+ return 0.5*(x-e) - 0.5;
+ if (k == 1) {
+ if (x < -0.25)
+ return -2.0*(e-(x+0.5));
+ return one+2.0*(x-e);
+ }
+ if (k <= -2 || k > 56) { /* suffice to return exp(x)-1 */
+ y = one - (e-x);
+ if (k == 1024)
+ y = y*2.0*0x1p1023;
+ else
+ y = y*twopk;
+ return y - one;
+ }
+ t = one;
+ if (k < 20) {
+ SET_HIGH_WORD(t, 0x3ff00000 - (0x200000>>k)); /* t=1-2^-k */
+ y = t-(e-x);
+ y = y*twopk;
+ } else {
+ SET_HIGH_WORD(t, ((0x3ff-k)<<20)); /* 2^-k */
+ y = x-(e+t);
+ y += one;
+ y = y*twopk;
+ }
+ return y;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_expm1f.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+one = 1.0,
+huge = 1.0e+30,
+tiny = 1.0e-30,
+o_threshold = 8.8721679688e+01, /* 0x42b17180 */
+ln2_hi = 6.9313812256e-01, /* 0x3f317180 */
+ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */
+invln2 = 1.4426950216e+00, /* 0x3fb8aa3b */
+/*
+ * Domain [-0.34568, 0.34568], range ~[-6.694e-10, 6.696e-10]:
+ * |6 / x * (1 + 2 * (1 / (exp(x) - 1) - 1 / x)) - q(x)| < 2**-30.04
+ * Scaled coefficients: Qn_here = 2**n * Qn_for_q (see s_expm1.c):
+ */
+Q1 = -3.3333212137e-2, /* -0x888868.0p-28 */
+Q2 = 1.5807170421e-3; /* 0xcf3010.0p-33 */
+
+float expm1f(float x)
+{
+ float y,hi,lo,c,t,e,hxs,hfx,r1,twopk;
+ int32_t k,xsb;
+ uint32_t hx;
+
+ GET_FLOAT_WORD(hx, x);
+ xsb = hx&0x80000000; /* sign bit of x */
+ hx &= 0x7fffffff; /* high word of |x| */
+
+ /* filter out huge and non-finite argument */
+ if (hx >= 0x4195b844) { /* if |x|>=27*ln2 */
+ if (hx >= 0x42b17218) { /* if |x|>=88.721... */
+ if (hx > 0x7f800000) /* NaN */
+ return x+x;
+ if (hx == 0x7f800000) /* exp(+-inf)={inf,-1} */
+ return xsb==0 ? x : -1.0;
+ if (x > o_threshold)
+ return huge*huge; /* overflow */
+ }
+ if (xsb != 0) { /* x < -27*ln2 */
+ /* raise inexact */
+ if (x+tiny < (float)0.0)
+ return tiny-one; /* return -1 */
+ }
+ }
+
+ /* argument reduction */
+ if (hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */
+ if (hx < 0x3F851592) { /* and |x| < 1.5 ln2 */
+ if (xsb == 0) {
+ hi = x - ln2_hi;
+ lo = ln2_lo;
+ k = 1;
+ } else {
+ hi = x + ln2_hi;
+ lo = -ln2_lo;
+ k = -1;
+ }
+ } else {
+ k = invln2*x+((xsb==0)?(float)0.5:(float)-0.5);
+ t = k;
+ hi = x - t*ln2_hi; /* t*ln2_hi is exact here */
+ lo = t*ln2_lo;
+ }
+ STRICT_ASSIGN(float, x, hi - lo);
+ c = (hi-x)-lo;
+ } else if (hx < 0x33000000) { /* when |x|<2**-25, return x */
+ t = huge+x; /* return x with inexact flags when x!=0 */
+ return x - (t-(huge+x));
+ } else
+ k = 0;
+
+ /* x is now in primary range */
+ hfx = (float)0.5*x;
+ hxs = x*hfx;
+ r1 = one+hxs*(Q1+hxs*Q2);
+ t = (float)3.0 - r1*hfx;
+ e = hxs*((r1-t)/((float)6.0 - x*t));
+ if (k == 0) /* c is 0 */
+ return x - (x*e-hxs);
+ SET_FLOAT_WORD(twopk, 0x3f800000+(k<<23)); /* 2^k */
+ e = x*(e-c) - c;
+ e -= hxs;
+ if (k == -1)
+ return (float)0.5*(x-e) - (float)0.5;
+ if (k == 1) {
+ if (x < (float)-0.25)
+ return -(float)2.0*(e-(x+(float)0.5));
+ return one+(float)2.0*(x-e);
+ }
+ if (k <= -2 || k > 56) { /* suffice to return exp(x)-1 */
+ y = one - (e - x);
+ if (k == 128)
+ y = y*2.0F*0x1p127F;
+ else
+ y = y*twopk;
+ return y - one;
+ }
+ t = one;
+ if (k < 23) {
+ SET_FLOAT_WORD(t, 0x3f800000 - (0x1000000>>k)); /* t=1-2^-k */
+ y = t - (e - x);
+ y = y*twopk;
+ } else {
+ SET_FLOAT_WORD(t, ((0x7f-k)<<23)); /* 2^-k */
+ y = x - (e + t);
+ y += one;
+ y = y*twopk;
+ }
+ return y;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_expm1l.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Exponential function, minus 1
+ * Long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, expm1l();
+ *
+ * y = expm1l( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns e (2.71828...) raised to the x power, minus 1.
+ *
+ * Range reduction is accomplished by separating the argument
+ * into an integer k and fraction f such that
+ *
+ * x k f
+ * e = 2 e.
+ *
+ * An expansion x + .5 x^2 + x^3 R(x) approximates exp(f) - 1
+ * in the basic range [-0.5 ln 2, 0.5 ln 2].
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -45,+MAXLOG 200,000 1.2e-19 2.5e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * expm1l overflow x > MAXLOG MAXNUM
+ *
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double expm1l(long double x)
+{
+ return expm1(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double MAXLOGL = 1.1356523406294143949492E4L;
+
+/* exp(x) - 1 = x + 0.5 x^2 + x^3 P(x)/Q(x)
+ -.5 ln 2 < x < .5 ln 2
+ Theoretical peak relative error = 3.4e-22 */
+static const long double
+P0 = -1.586135578666346600772998894928250240826E4L,
+P1 = 2.642771505685952966904660652518429479531E3L,
+P2 = -3.423199068835684263987132888286791620673E2L,
+P3 = 1.800826371455042224581246202420972737840E1L,
+P4 = -5.238523121205561042771939008061958820811E-1L,
+Q0 = -9.516813471998079611319047060563358064497E4L,
+Q1 = 3.964866271411091674556850458227710004570E4L,
+Q2 = -7.207678383830091850230366618190187434796E3L,
+Q3 = 7.206038318724600171970199625081491823079E2L,
+Q4 = -4.002027679107076077238836622982900945173E1L,
+/* Q5 = 1.000000000000000000000000000000000000000E0 */
+/* C1 + C2 = ln 2 */
+C1 = 6.93145751953125E-1L,
+C2 = 1.428606820309417232121458176568075500134E-6L,
+/* ln 2^-65 */
+minarg = -4.5054566736396445112120088E1L,
+huge = 0x1p10000L;
+
+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.0L;
+
+ 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 = ldexpl(1.0L, k);
+ x = px * qx + (px - 1.0);
+ return x;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double fabs(double x)
+{
+ union dshape u;
+
+ u.value = x;
+ u.bits &= (uint64_t)-1 / 2;
+ return u.value;
+}
--- /dev/null
+#include "libm.h"
+
+float fabsf(float x)
+{
+ union fshape u;
+
+ u.value = x;
+ u.bits &= (uint32_t)-1 / 2;
+ return u.value;
+}
--- /dev/null
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double fabsl(long double x)
+{
+ return fabs(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+long double fabsl(long double x)
+{
+ union ldshape u = {x};
+
+ u.bits.sign = 0;
+ return u.value;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double fdim(double x, double y)
+{
+ if (isnan(x))
+ return x;
+ if (isnan(y))
+ return y;
+ return x > y ? x - y : 0;
+}
--- /dev/null
+#include "libm.h"
+
+float fdimf(float x, float y)
+{
+ if (isnan(x))
+ return x;
+ if (isnan(y))
+ return y;
+ return x > y ? x - y : 0;
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double fdiml(long double x, long double y)
+{
+ return fdim(x, y);
+}
+#else
+long double fdiml(long double x, long double y)
+{
+ if (isnan(x))
+ return x;
+ if (isnan(y))
+ return y;
+ return x > y ? x - y : 0;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_floor.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * floor(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to floor(x).
+ */
+
+#include "libm.h"
+
+static const double huge = 1.0e300;
+
+double floor(double x)
+{
+ int32_t i0,i1,j0;
+ uint32_t i,j;
+
+ EXTRACT_WORDS(i0, i1, x);
+ // FIXME: signed shift
+ j0 = ((i0>>20)&0x7ff) - 0x3ff;
+ if (j0 < 20) {
+ if (j0 < 0) { /* |x| < 1 */
+ /* raise inexact if x != 0 */
+ if (huge+x > 0.0) {
+ if (i0 >= 0) { /* x >= 0 */
+ i0 = i1 = 0;
+ } else if (((i0&0x7fffffff)|i1) != 0) {
+ i0 = 0xbff00000;
+ i1 = 0;
+ }
+ }
+ } else {
+ i = 0x000fffff>>j0;
+ if (((i0&i)|i1) == 0)
+ return x; /* x is integral */
+ /* raise inexact flag */
+ if (huge+x > 0.0) {
+ if (i0 < 0)
+ i0 += 0x00100000>>j0;
+ i0 &= ~i;
+ i1=0;
+ }
+ }
+ } else if (j0 > 51) {
+ if (j0 == 0x400)
+ return x+x; /* inf or NaN */
+ else
+ return x; /* x is integral */
+ } else {
+ i = ((uint32_t)(0xffffffff))>>(j0-20);
+ if ((i1&i) == 0)
+ return x; /* x is integral */
+ /* raise inexact flag */
+ if (huge+x > 0.0) {
+ if (i0 < 0) {
+ if (j0 == 20)
+ i0+=1;
+ else {
+ j = i1+(1<<(52-j0));
+ if (j < i1)
+ i0 += 1; /* got a carry */
+ i1 = j;
+ }
+ }
+ i1 &= ~i;
+ }
+ }
+ INSERT_WORDS(x, i0, i1);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_floorf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * floorf(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to floorf(x).
+ */
+
+#include "libm.h"
+
+static const float huge = 1.0e30;
+
+float floorf(float x)
+{
+ int32_t i0,j0;
+ uint32_t i;
+
+ GET_FLOAT_WORD(i0, x);
+ // FIXME: signed shift
+ j0 = ((i0>>23)&0xff) - 0x7f;
+ if (j0 < 23) {
+ if (j0 < 0) { /* |x| < 1 */
+ /* raise inexact if x != 0 */
+ if (huge+x > (float)0.0) {
+ if (i0 >= 0) /* x >= 0 */
+ i0 = 0;
+ else if ((i0&0x7fffffff) != 0)
+ i0 = 0xbf800000;
+ }
+ } else {
+ i = 0x007fffff>>j0;
+ if ((i0&i) == 0)
+ return x; /* x is integral */
+ /* raise inexact flag */
+ if (huge+x > (float)0.0) {
+ if (i0 < 0)
+ i0 += 0x00800000>>j0;
+ i0 &= ~i;
+ }
+ }
+ } else {
+ if (j0 == 0x80) /* inf or NaN */
+ return x+x;
+ else
+ return x; /* x is integral */
+ }
+ SET_FLOAT_WORD(x, i0);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_floorl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * floorl(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to floorl(x).
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double floorl(long double x)
+{
+ return floor(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#ifdef LDBL_IMPLICIT_NBIT
+#define MANH_SIZE (LDBL_MANH_SIZE + 1)
+#define INC_MANH(u, c) do { \
+ uint64_t o = u.bits.manh; \
+ u.bits.manh += (c); \
+ if (u.bits.manh < o) \
+ u.bits.exp++; \
+} while (0)
+#else
+#define MANH_SIZE LDBL_MANH_SIZE
+#define INC_MANH(u, c) do { \
+ uint64_t o = u.bits.manh; \
+ u.bits.manh += (c); \
+ if (u.bits.manh < o) { \
+ u.bits.exp++; \
+ u.bits.manh |= 1llu << (LDBL_MANH_SIZE - 1); \
+ } \
+} while (0)
+#endif
+
+static const long double huge = 1.0e300;
+
+long double floorl(long double x)
+{
+ union IEEEl2bits u = { .e = x };
+ int e = u.bits.exp - LDBL_MAX_EXP + 1;
+
+ if (e < MANH_SIZE - 1) {
+ if (e < 0) {
+ /* raise inexact if x != 0 */
+ if (huge + x > 0.0)
+ if (u.bits.exp > 0 ||
+ (u.bits.manh | u.bits.manl) != 0)
+ u.e = u.bits.sign ? -1.0 : 0.0;
+ } else {
+ uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1);
+ if (((u.bits.manh & m) | u.bits.manl) == 0)
+ return x; /* x is integral */
+ if (u.bits.sign) {
+#ifdef LDBL_IMPLICIT_NBIT
+ if (e == 0)
+ u.bits.exp++;
+ else
+#endif
+ INC_MANH(u, 1llu << (MANH_SIZE - e - 1));
+ }
+ /* raise inexact flag */
+ if (huge + x > 0.0) {
+ u.bits.manh &= ~m;
+ u.bits.manl = 0;
+ }
+ }
+ } else if (e < LDBL_MANT_DIG - 1) {
+ uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1);
+ if ((u.bits.manl & m) == 0)
+ return x; /* x is integral */
+ if (u.bits.sign) {
+ if (e == MANH_SIZE - 1)
+ INC_MANH(u, 1);
+ else {
+ uint64_t o = u.bits.manl;
+ u.bits.manl += 1llu << (LDBL_MANT_DIG - e - 1);
+ if (u.bits.manl < o) /* got a carry */
+ INC_MANH(u, 1);
+ }
+ }
+ /* raise inexact flag */
+ if (huge + x > 0.0)
+ u.bits.manl &= ~m;
+ }
+ return (u.e);
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_fma.c */
+/*-
+ * Copyright (c) 2005-2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <fenv.h>
+#include "libm.h"
+
+/*
+ * A struct dd represents a floating-point number with twice the precision
+ * of a double. We maintain the invariant that "hi" stores the 53 high-order
+ * bits of the result.
+ */
+struct dd {
+ double hi;
+ double lo;
+};
+
+/*
+ * Compute a+b exactly, returning the exact result in a struct dd. We assume
+ * that both a and b are finite, but make no assumptions about their relative
+ * magnitudes.
+ */
+static inline struct dd dd_add(double a, double b)
+{
+ struct dd ret;
+ double s;
+
+ ret.hi = a + b;
+ s = ret.hi - a;
+ ret.lo = (a - (ret.hi - s)) + (b - s);
+ return (ret);
+}
+
+/*
+ * Compute a+b, with a small tweak: The least significant bit of the
+ * result is adjusted into a sticky bit summarizing all the bits that
+ * were lost to rounding. This adjustment negates the effects of double
+ * rounding when the result is added to another number with a higher
+ * exponent. For an explanation of round and sticky bits, see any reference
+ * on FPU design, e.g.,
+ *
+ * J. Coonen. An Implementation Guide to a Proposed Standard for
+ * Floating-Point Arithmetic. Computer, vol. 13, no. 1, Jan 1980.
+ */
+static inline double add_adjusted(double a, double b)
+{
+ struct dd sum;
+ uint64_t hibits, lobits;
+
+ sum = dd_add(a, b);
+ if (sum.lo != 0) {
+ EXTRACT_WORD64(hibits, sum.hi);
+ if ((hibits & 1) == 0) {
+ /* hibits += (int)copysign(1.0, sum.hi * sum.lo) */
+ EXTRACT_WORD64(lobits, sum.lo);
+ hibits += 1 - ((hibits ^ lobits) >> 62);
+ INSERT_WORD64(sum.hi, hibits);
+ }
+ }
+ return (sum.hi);
+}
+
+/*
+ * 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 double add_and_denormalize(double a, double b, int scale)
+{
+ struct dd sum;
+ uint64_t hibits, lobits;
+ int bits_lost;
+
+ 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) {
+ EXTRACT_WORD64(hibits, sum.hi);
+ bits_lost = -((int)(hibits >> 52) & 0x7ff) - scale + 1;
+ if (bits_lost != 1 ^ (int)(hibits & 1)) {
+ /* hibits += (int)copysign(1.0, sum.hi * sum.lo) */
+ EXTRACT_WORD64(lobits, sum.lo);
+ hibits += 1 - (((hibits ^ lobits) >> 62) & 2);
+ INSERT_WORD64(sum.hi, hibits);
+ }
+ }
+ return (ldexp(sum.hi, scale));
+}
+
+/*
+ * Compute a*b exactly, returning the exact result in a struct dd. We assume
+ * that both a and b are normalized, so no underflow or overflow will occur.
+ * The current rounding mode must be round-to-nearest.
+ */
+static inline struct dd dd_mul(double a, double b)
+{
+ static const double split = 0x1p27 + 1.0;
+ struct dd ret;
+ double ha, hb, la, lb, p, q;
+
+ p = a * split;
+ ha = a - p;
+ ha += p;
+ la = a - ha;
+
+ p = b * split;
+ hb = b - p;
+ hb += p;
+ lb = b - hb;
+
+ p = ha * hb;
+ q = ha * lb + la * hb;
+
+ ret.hi = p + q;
+ ret.lo = p - ret.hi + q + la * lb;
+ return (ret);
+}
+
+/*
+ * Fused multiply-add: Compute x * y + z with a single rounding error.
+ *
+ * We use scaling to avoid overflow/underflow, along with the
+ * canonical precision-doubling technique adapted from:
+ *
+ * Dekker, T. A Floating-Point Technique for Extending the
+ * Available Precision. Numer. Math. 18, 224-242 (1971).
+ *
+ * This algorithm is sensitive to the rounding precision. FPUs such
+ * as the i387 must be set in double-precision mode if variables are
+ * to be stored in FP registers in order to avoid incorrect results.
+ * This is the default on FreeBSD, but not on many other systems.
+ *
+ * Hardware instructions should be used on architectures that support it,
+ * since this implementation will likely be several times slower.
+ */
+double fma(double x, double y, double z)
+{
+ double xs, ys, zs, adj;
+ struct dd xy, r;
+ int oround;
+ int ex, ey, ez;
+ int spread;
+
+ /*
+ * Handle special cases. The order of operations and the particular
+ * return values here are crucial in handling special cases involving
+ * infinities, NaNs, overflows, and signed zeroes correctly.
+ */
+ if (x == 0.0 || y == 0.0)
+ return (x * y + z);
+ if (z == 0.0)
+ return (x * y);
+ if (!isfinite(x) || !isfinite(y))
+ return (x * y + z);
+ if (!isfinite(z))
+ return (z);
+
+ xs = frexp(x, &ex);
+ ys = frexp(y, &ey);
+ zs = frexp(z, &ez);
+ oround = fegetround();
+ spread = ex + ey - ez;
+
+ /*
+ * If x * y and z are many orders of magnitude apart, the scaling
+ * will overflow, so we handle these cases specially. Rounding
+ * modes other than FE_TONEAREST are painful.
+ */
+ if (spread < -DBL_MANT_DIG) {
+ feraiseexcept(FE_INEXACT);
+ if (!isnormal(z))
+ feraiseexcept(FE_UNDERFLOW);
+ switch (oround) {
+ case FE_TONEAREST:
+ return (z);
+ case FE_TOWARDZERO:
+ if (x > 0.0 ^ y < 0.0 ^ z < 0.0)
+ return (z);
+ else
+ return (nextafter(z, 0));
+ case FE_DOWNWARD:
+ if (x > 0.0 ^ y < 0.0)
+ return (z);
+ else
+ return (nextafter(z, -INFINITY));
+ default: /* FE_UPWARD */
+ if (x > 0.0 ^ y < 0.0)
+ return (nextafter(z, INFINITY));
+ else
+ return (z);
+ }
+ }
+ if (spread <= DBL_MANT_DIG * 2)
+ zs = ldexp(zs, -spread);
+ else
+ zs = copysign(DBL_MIN, zs);
+
+ fesetround(FE_TONEAREST);
+
+ /*
+ * Basic approach for round-to-nearest:
+ *
+ * (xy.hi, xy.lo) = x * y (exact)
+ * (r.hi, r.lo) = xy.hi + z (exact)
+ * adj = xy.lo + r.lo (inexact; low bit is sticky)
+ * result = r.hi + adj (correctly rounded)
+ */
+ xy = dd_mul(xs, ys);
+ r = dd_add(xy.hi, zs);
+
+ spread = ex + ey;
+
+ if (r.hi == 0.0) {
+ /*
+ * When the addends cancel to 0, ensure that the result has
+ * the correct sign.
+ */
+ fesetround(oround);
+ volatile double vzs = zs; /* XXX gcc CSE bug workaround */
+ return (xy.hi + vzs + ldexp(xy.lo, spread));
+ }
+
+ if (oround != FE_TONEAREST) {
+ /*
+ * There is no need to worry about double rounding in directed
+ * rounding modes.
+ */
+ fesetround(oround);
+ adj = r.lo + xy.lo;
+ return (ldexp(r.hi + adj, spread));
+ }
+
+ adj = add_adjusted(r.lo, xy.lo);
+ if (spread + ilogb(r.hi) > -1023)
+ return (ldexp(r.hi + adj, spread));
+ else
+ return (add_and_denormalize(r.hi, adj, spread));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_fmaf.c */
+/*-
+ * Copyright (c) 2005-2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <fenv.h>
+#include "libm.h"
+
+/*
+ * Fused multiply-add: Compute x * y + z with a single rounding error.
+ *
+ * A double has more than twice as much precision than a float, so
+ * direct double-precision arithmetic suffices, except where double
+ * rounding occurs.
+ */
+float fmaf(float x, float y, float z)
+{
+ double xy, result;
+ uint32_t hr, lr;
+
+ xy = (double)x * y;
+ result = xy + z;
+ EXTRACT_WORDS(hr, lr, result);
+ /* Common case: The double precision result is fine. */
+ if ((lr & 0x1fffffff) != 0x10000000 || /* not a halfway case */
+ (hr & 0x7ff00000) == 0x7ff00000 || /* NaN */
+ result - xy == z || /* exact */
+ fegetround() != FE_TONEAREST) /* not round-to-nearest */
+ return (result);
+
+ /*
+ * If result is inexact, and exactly halfway between two float values,
+ * we need to adjust the low-order bit in the direction of the error.
+ */
+ fesetround(FE_TOWARDZERO);
+ volatile double vxy = xy; /* XXX work around gcc CSE bug */
+ double adjusted_result = vxy + z;
+ fesetround(FE_TONEAREST);
+ if (result == adjusted_result)
+ SET_LOW_WORD(adjusted_result, lr + 1);
+ return (adjusted_result);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_fmal.c */
+/*-
+ * Copyright (c) 2005-2011 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double fmal(long double x, long double y, long double z)
+{
+ return fma(x, y, z);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include <fenv.h>
+
+/*
+ * A struct dd represents a floating-point number with twice the precision
+ * of a long double. We maintain the invariant that "hi" stores the high-order
+ * bits of the result.
+ */
+struct dd {
+ long double hi;
+ long double lo;
+};
+
+/*
+ * Compute a+b exactly, returning the exact result in a struct dd. We assume
+ * that both a and b are finite, but make no assumptions about their relative
+ * magnitudes.
+ */
+static inline struct dd dd_add(long double a, long double b)
+{
+ struct dd ret;
+ long double s;
+
+ ret.hi = a + b;
+ s = ret.hi - a;
+ ret.lo = (a - (ret.hi - s)) + (b - s);
+ return (ret);
+}
+
+/*
+ * Compute a+b, with a small tweak: The least significant bit of the
+ * result is adjusted into a sticky bit summarizing all the bits that
+ * were lost to rounding. This adjustment negates the effects of double
+ * rounding when the result is added to another number with a higher
+ * exponent. For an explanation of round and sticky bits, see any reference
+ * on FPU design, e.g.,
+ *
+ * J. Coonen. An Implementation Guide to a Proposed Standard for
+ * Floating-Point Arithmetic. Computer, vol. 13, no. 1, Jan 1980.
+ */
+static inline long double add_adjusted(long double a, long double b)
+{
+ struct dd sum;
+ union IEEEl2bits u;
+
+ sum = dd_add(a, b);
+ if (sum.lo != 0) {
+ u.e = sum.hi;
+ if ((u.bits.manl & 1) == 0)
+ sum.hi = nextafterl(sum.hi, INFINITY * sum.lo);
+ }
+ return (sum.hi);
+}
+
+/*
+ * 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 IEEEl2bits 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.e = sum.hi;
+ bits_lost = -u.bits.exp - scale + 1;
+ if (bits_lost != 1 ^ (int)(u.bits.manl & 1))
+ sum.hi = nextafterl(sum.hi, INFINITY * sum.lo);
+ }
+ return (ldexp(sum.hi, scale));
+}
+
+/*
+ * Compute a*b exactly, returning the exact result in a struct dd. We assume
+ * that both a and b are normalized, so no underflow or overflow will occur.
+ * The current rounding mode must be round-to-nearest.
+ */
+static inline struct dd dd_mul(long double a, long double b)
+{
+#if LDBL_MANT_DIG == 64
+ static const long double split = 0x1p32L + 1.0;
+#elif LDBL_MANT_DIG == 113
+ static const long double split = 0x1p57L + 1.0;
+#endif
+ struct dd ret;
+ long double ha, hb, la, lb, p, q;
+
+ p = a * split;
+ ha = a - p;
+ ha += p;
+ la = a - ha;
+
+ p = b * split;
+ hb = b - p;
+ hb += p;
+ lb = b - hb;
+
+ p = ha * hb;
+ q = ha * lb + la * hb;
+
+ ret.hi = p + q;
+ ret.lo = p - ret.hi + q + la * lb;
+ return (ret);
+}
+
+/*
+ * Fused multiply-add: Compute x * y + z with a single rounding error.
+ *
+ * We use scaling to avoid overflow/underflow, along with the
+ * canonical precision-doubling technique adapted from:
+ *
+ * Dekker, T. A Floating-Point Technique for Extending the
+ * Available Precision. Numer. Math. 18, 224-242 (1971).
+ */
+long double fmal(long double x, long double y, long double z)
+{
+ long double xs, ys, zs, adj;
+ struct dd xy, r;
+ int oround;
+ int ex, ey, ez;
+ int spread;
+
+ /*
+ * Handle special cases. The order of operations and the particular
+ * return values here are crucial in handling special cases involving
+ * infinities, NaNs, overflows, and signed zeroes correctly.
+ */
+ if (x == 0.0 || y == 0.0)
+ return (x * y + z);
+ if (z == 0.0)
+ return (x * y);
+ if (!isfinite(x) || !isfinite(y))
+ return (x * y + z);
+ if (!isfinite(z))
+ return (z);
+
+ xs = frexpl(x, &ex);
+ ys = frexpl(y, &ey);
+ zs = frexpl(z, &ez);
+ oround = fegetround();
+ spread = ex + ey - ez;
+
+ /*
+ * If x * y and z are many orders of magnitude apart, the scaling
+ * will overflow, so we handle these cases specially. Rounding
+ * modes other than FE_TONEAREST are painful.
+ */
+ if (spread < -LDBL_MANT_DIG) {
+ feraiseexcept(FE_INEXACT);
+ if (!isnormal(z))
+ feraiseexcept(FE_UNDERFLOW);
+ switch (oround) {
+ case FE_TONEAREST:
+ return (z);
+ case FE_TOWARDZERO:
+ if (x > 0.0 ^ y < 0.0 ^ z < 0.0)
+ return (z);
+ else
+ return (nextafterl(z, 0));
+ case FE_DOWNWARD:
+ if (x > 0.0 ^ y < 0.0)
+ return (z);
+ else
+ return (nextafterl(z, -INFINITY));
+ default: /* FE_UPWARD */
+ if (x > 0.0 ^ y < 0.0)
+ return (nextafterl(z, INFINITY));
+ else
+ return (z);
+ }
+ }
+ if (spread <= LDBL_MANT_DIG * 2)
+ zs = ldexpl(zs, -spread);
+ else
+ zs = copysignl(LDBL_MIN, zs);
+
+ fesetround(FE_TONEAREST);
+
+ /*
+ * Basic approach for round-to-nearest:
+ *
+ * (xy.hi, xy.lo) = x * y (exact)
+ * (r.hi, r.lo) = xy.hi + z (exact)
+ * adj = xy.lo + r.lo (inexact; low bit is sticky)
+ * result = r.hi + adj (correctly rounded)
+ */
+ xy = dd_mul(xs, ys);
+ r = dd_add(xy.hi, zs);
+
+ spread = ex + ey;
+
+ if (r.hi == 0.0) {
+ /*
+ * When the addends cancel to 0, ensure that the result has
+ * the correct sign.
+ */
+ fesetround(oround);
+ volatile long double vzs = zs; /* XXX gcc CSE bug workaround */
+ return (xy.hi + vzs + ldexpl(xy.lo, spread));
+ }
+
+ if (oround != FE_TONEAREST) {
+ /*
+ * There is no need to worry about double rounding in directed
+ * rounding modes.
+ */
+ fesetround(oround);
+ adj = r.lo + xy.lo;
+ return (ldexpl(r.hi + adj, spread));
+ }
+
+ adj = add_adjusted(r.lo, xy.lo);
+ if (spread + ilogbl(r.hi) > -16383)
+ return (ldexpl(r.hi + adj, spread));
+ else
+ return (add_and_denormalize(r.hi, adj, spread));
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double fmax(double x, double y)
+{
+ if (isnan(x))
+ return y;
+ if (isnan(y))
+ return x;
+ /* handle signed zeros, see C99 Annex F.9.9.2 */
+ if (signbit(x) != signbit(y))
+ return signbit(x) ? y : x;
+ return x < y ? y : x;
+}
--- /dev/null
+#include "libm.h"
+
+float fmaxf(float x, float y)
+{
+ if (isnan(x))
+ return y;
+ if (isnan(y))
+ return x;
+ /* handle signed zeroes, see C99 Annex F.9.9.2 */
+ if (signbit(x) != signbit(y))
+ return signbit(x) ? y : x;
+ return x < y ? y : x;
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double fmaxl(long double x, long double y)
+{
+ return fmax(x, y);
+}
+#else
+long double fmaxl(long double x, long double y)
+{
+ if (isnan(x))
+ return y;
+ if (isnan(y))
+ return x;
+ /* handle signed zeros, see C99 Annex F.9.9.2 */
+ if (signbit(x) != signbit(y))
+ return signbit(x) ? y : x;
+ return x < y ? y : x;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+double fmin(double x, double y)
+{
+ if (isnan(x))
+ return y;
+ if (isnan(y))
+ return x;
+ /* handle signed zeros, see C99 Annex F.9.9.2 */
+ if (signbit(x) != signbit(y))
+ return signbit(x) ? x : y;
+ return x < y ? x : y;
+}
--- /dev/null
+#include "libm.h"
+
+float fminf(float x, float y)
+{
+ if (isnan(x))
+ return y;
+ if (isnan(y))
+ return x;
+ /* handle signed zeros, see C99 Annex F.9.9.2 */
+ if (signbit(x) != signbit(y))
+ return signbit(x) ? x : y;
+ return x < y ? x : y;
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double fminl(long double x, long double y)
+{
+ return fmin(x, y);
+}
+#else
+long double fminl(long double x, long double y)
+{
+ if (isnan(x))
+ return y;
+ if (isnan(y))
+ return x;
+ /* handle signed zeros, see C99 Annex F.9.9.2 */
+ if (signbit(x) != signbit(y))
+ return signbit(x) ? x : y;
+ return x < y ? x : y;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_fmod.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * fmod(x,y)
+ * Return x mod y in exact arithmetic
+ * Method: shift and subtract
+ */
+
+#include "libm.h"
+
+static const double one = 1.0, Zero[] = {0.0, -0.0,};
+
+double fmod(double x, double y)
+{
+ int32_t n,hx,hy,hz,ix,iy,sx,i;
+ uint32_t lx,ly,lz;
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hy, ly, y);
+ sx = hx & 0x80000000; /* sign of x */
+ hx ^= sx; /* |x| */
+ hy &= 0x7fffffff; /* |y| */
+
+ /* purge off exception values */
+ if ((hy|ly) == 0 || hx >= 0x7ff00000 || /* y=0,or x not finite */
+ (hy|((ly|-ly)>>31)) > 0x7ff00000) /* or y is NaN */
+ return (x*y)/(x*y);
+ if (hx <= hy) {
+ if (hx < hy || lx < ly) /* |x| < |y| */
+ return x;
+ if (lx == ly) /* |x| = |y|, return x*0 */
+ return Zero[(uint32_t)sx>>31];
+ }
+
+ /* determine ix = ilogb(x) */
+ if (hx < 0x00100000) { /* subnormal x */
+ if (hx == 0) {
+ for (ix = -1043, i = lx; i > 0; i <<= 1)
+ ix -= 1;
+ } else {
+ for (ix = -1022, i = hx<<11; i > 0; i <<= 1)
+ ix -= 1;
+ }
+ } else
+ ix = (hx>>20) - 1023;
+
+ /* determine iy = ilogb(y) */
+ if (hy < 0x00100000) { /* subnormal y */
+ if (hy == 0) {
+ for (iy = -1043, i = ly; i > 0; i <<= 1)
+ iy -= 1;
+ } else {
+ for (iy = -1022, i = hy<<11; i > 0; i <<= 1)
+ iy -= 1;
+ }
+ } else
+ iy = (hy>>20) - 1023;
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ if (ix >= -1022)
+ hx = 0x00100000|(0x000fffff&hx);
+ else { /* subnormal x, shift x to normal */
+ n = -1022-ix;
+ if (n <= 31) {
+ hx = (hx<<n)|(lx>>(32-n));
+ lx <<= n;
+ } else {
+ hx = lx<<(n-32);
+ lx = 0;
+ }
+ }
+ if(iy >= -1022)
+ hy = 0x00100000|(0x000fffff&hy);
+ else { /* subnormal y, shift y to normal */
+ n = -1022-iy;
+ if (n <= 31) {
+ hy = (hy<<n)|(ly>>(32-n));
+ ly <<= n;
+ } else {
+ hy = ly<<(n-32);
+ ly = 0;
+ }
+ }
+
+ /* fix point fmod */
+ n = ix - iy;
+ while (n--) {
+ hz = hx-hy;
+ lz = lx-ly;
+ if (lx < ly)
+ hz -= 1;
+ if (hz < 0) {
+ hx = hx+hx+(lx>>31);
+ lx = lx+lx;
+ } else {
+ if ((hz|lz) == 0) /* return sign(x)*0 */
+ return Zero[(uint32_t)sx>>31];
+ hx = hz+hz+(lz>>31);
+ lx = lz+lz;
+ }
+ }
+ hz = hx-hy;
+ lz = lx-ly;
+ if (lx < ly)
+ hz -= 1;
+ if (hz >= 0) {
+ hx = hz;
+ lx = lz;
+ }
+
+ /* convert back to floating value and restore the sign */
+ if ((hx|lx) == 0) /* return sign(x)*0 */
+ return Zero[(uint32_t)sx>>31];
+ while (hx < 0x00100000) { /* normalize x */
+ hx = hx+hx+(lx>>31);
+ lx = lx+lx;
+ iy -= 1;
+ }
+ if (iy >= -1022) { /* normalize output */
+ hx = ((hx-0x00100000)|((iy+1023)<<20));
+ INSERT_WORDS(x, hx|sx, lx);
+ } else { /* subnormal output */
+ n = -1022 - iy;
+ if (n <= 20) {
+ lx = (lx>>n)|((uint32_t)hx<<(32-n));
+ hx >>= n;
+ } else if (n <= 31) {
+ lx = (hx<<(32-n))|(lx>>n);
+ hx = sx;
+ } else {
+ lx = hx>>(n-32); hx = sx;
+ }
+ INSERT_WORDS(x, hx|sx, lx);
+ x *= one; /* create necessary signal */
+ }
+ return x; /* exact output */
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_fmodf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * fmodf(x,y)
+ * Return x mod y in exact arithmetic
+ * Method: shift and subtract
+ */
+
+#include "libm.h"
+
+static const float one = 1.0, Zero[] = {0.0, -0.0,};
+
+float fmodf(float x, float y)
+{
+ int32_t n,hx,hy,hz,ix,iy,sx,i;
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hy, y);
+ sx = hx & 0x80000000; /* sign of x */
+ hx ^= sx; /* |x| */
+ hy &= 0x7fffffff; /* |y| */
+
+ /* purge off exception values */
+ if (hy == 0 || hx >= 0x7f800000 || /* y=0,or x not finite */
+ hy > 0x7f800000) /* or y is NaN */
+ return (x*y)/(x*y);
+ if (hx < hy) /* |x| < |y| */
+ return x;
+ if (hx == hy) /* |x| = |y|, return x*0 */
+ return Zero[(uint32_t)sx>>31];
+
+ /* determine ix = ilogb(x) */
+ if (hx < 0x00800000) { /* subnormal x */
+ for (ix = -126, i = hx<<8; i > 0; i <<= 1)
+ ix -= 1;
+ } else
+ ix = (hx>>23) - 127;
+
+ /* determine iy = ilogb(y) */
+ if (hy < 0x00800000) { /* subnormal y */
+ for (iy = -126, i = hy<<8; i >= 0; i <<= 1)
+ iy -= 1;
+ } else
+ iy = (hy>>23) - 127;
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ if (ix >= -126)
+ hx = 0x00800000|(0x007fffff&hx);
+ else { /* subnormal x, shift x to normal */
+ n = -126-ix;
+ hx = hx<<n;
+ }
+ if (iy >= -126)
+ hy = 0x00800000|(0x007fffff&hy);
+ else { /* subnormal y, shift y to normal */
+ n = -126-iy;
+ hy = hy<<n;
+ }
+
+ /* fix point fmod */
+ n = ix - iy;
+ while (n--) {
+ hz = hx-hy;
+ if (hz<0)
+ hx = hx+hx;
+ else {
+ if(hz == 0) /* return sign(x)*0 */
+ return Zero[(uint32_t)sx>>31];
+ hx = hz+hz;
+ }
+ }
+ hz = hx-hy;
+ if (hz >= 0)
+ hx = hz;
+
+ /* convert back to floating value and restore the sign */
+ if (hx == 0) /* return sign(x)*0 */
+ return Zero[(uint32_t)sx>>31];
+ while (hx < 0x00800000) { /* normalize x */
+ hx = hx+hx;
+ iy -= 1;
+ }
+ if (iy >= -126) { /* normalize output */
+ hx = ((hx-0x00800000)|((iy+127)<<23));
+ SET_FLOAT_WORD(x, hx|sx);
+ } else { /* subnormal output */
+ n = -126 - iy;
+ hx >>= n;
+ SET_FLOAT_WORD(x, hx|sx);
+ x *= one; /* create necessary signal */
+ }
+ return x; /* exact output */
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_fmodl.c */
+/*-
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double fmodl(long double x, long double y)
+{
+ return fmod(x, y);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#define BIAS (LDBL_MAX_EXP - 1)
+
+#if LDBL_MANL_SIZE > 32
+typedef uint64_t manl_t;
+#else
+typedef uint32_t manl_t;
+#endif
+
+#if LDBL_MANH_SIZE > 32
+typedef uint64_t manh_t;
+#else
+typedef uint32_t manh_t;
+#endif
+
+/*
+ * These macros add and remove an explicit integer bit in front of the
+ * fractional mantissa, if the architecture doesn't have such a bit by
+ * default already.
+ */
+#ifdef LDBL_IMPLICIT_NBIT
+#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE))
+#define HFRAC_BITS LDBL_MANH_SIZE
+#else
+#define SET_NBIT(hx) (hx)
+#define HFRAC_BITS (LDBL_MANH_SIZE - 1)
+#endif
+
+#define MANL_SHIFT (LDBL_MANL_SIZE - 1)
+
+static const long double one = 1.0, Zero[] = {0.0, -0.0,};
+
+/*
+ * fmodl(x,y)
+ * Return x mod y in exact arithmetic
+ * Method: shift and subtract
+ *
+ * Assumptions:
+ * - The low part of the mantissa fits in a manl_t exactly.
+ * - The high part of the mantissa fits in an int64_t with enough room
+ * for an explicit integer bit in front of the fractional bits.
+ */
+long double fmodl(long double x, long double y)
+{
+ union IEEEl2bits ux, uy;
+ int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */
+ manh_t hy;
+ manl_t lx,ly,lz;
+ int ix,iy,n,sx;
+
+ ux.e = x;
+ uy.e = y;
+ sx = ux.bits.sign;
+
+ /* purge off exception values */
+ if ((uy.bits.exp|uy.bits.manh|uy.bits.manl) == 0 || /* y=0 */
+ ux.bits.exp == BIAS + LDBL_MAX_EXP || /* or x not finite */
+ (uy.bits.exp == BIAS + LDBL_MAX_EXP &&
+ ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) /* or y is NaN */
+ return (x*y)/(x*y);
+ if (ux.bits.exp <= uy.bits.exp) {
+ if (ux.bits.exp < uy.bits.exp ||
+ (ux.bits.manh<=uy.bits.manh &&
+ (ux.bits.manh<uy.bits.manh ||
+ ux.bits.manl<uy.bits.manl))) /* |x|<|y| return x or x-y */
+ return x;
+ if (ux.bits.manh==uy.bits.manh && ux.bits.manl==uy.bits.manl)
+ return Zero[sx]; /* |x| = |y| return x*0 */
+ }
+
+ /* determine ix = ilogb(x) */
+ if (ux.bits.exp == 0) { /* subnormal x */
+ ux.e *= 0x1.0p512;
+ ix = ux.bits.exp - (BIAS + 512);
+ } else {
+ ix = ux.bits.exp - BIAS;
+ }
+
+ /* determine iy = ilogb(y) */
+ if (uy.bits.exp == 0) { /* subnormal y */
+ uy.e *= 0x1.0p512;
+ iy = uy.bits.exp - (BIAS + 512);
+ } else {
+ iy = uy.bits.exp - BIAS;
+ }
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ hx = SET_NBIT(ux.bits.manh);
+ hy = SET_NBIT(uy.bits.manh);
+ lx = ux.bits.manl;
+ ly = uy.bits.manl;
+
+ /* fix point fmod */
+ n = ix - iy;
+
+ while (n--) {
+ hz = hx-hy;
+ lz = lx-ly;
+ if (lx < ly)
+ hz -= 1;
+ if (hz < 0) {
+ hx = hx+hx+(lx>>MANL_SHIFT);
+ lx = lx+lx;
+ } else {
+ if ((hz|lz)==0) /* return sign(x)*0 */
+ return Zero[sx];
+ hx = hz+hz+(lz>>MANL_SHIFT);
+ lx = lz+lz;
+ }
+ }
+ hz = hx-hy;
+ lz = lx-ly;
+ if (lx < ly)
+ hz -= 1;
+ if (hz >= 0) {
+ hx = hz;
+ lx = lz;
+ }
+
+ /* convert back to floating value and restore the sign */
+ if ((hx|lx) == 0) /* return sign(x)*0 */
+ return Zero[sx];
+ while (hx < (1ULL<<HFRAC_BITS)) { /* normalize x */
+ hx = hx+hx+(lx>>MANL_SHIFT);
+ lx = lx+lx;
+ iy -= 1;
+ }
+ ux.bits.manh = hx; /* The mantissa is truncated here if needed. */
+ ux.bits.manl = lx;
+ if (iy < LDBL_MIN_EXP) {
+ ux.bits.exp = iy + (BIAS + 512);
+ ux.e *= 0x1p-512;
+ } else {
+ ux.bits.exp = iy + BIAS;
+ }
+ x = ux.e * one; /* create necessary signal */
+ return x; /* exact output */
+}
+#endif
--- /dev/null
+#include <math.h>
+#include <stdint.h>
+
+double frexp(double x, int *e)
+{
+ union { double d; uint64_t i; } y = { x };
+ int ee = y.i>>52 & 0x7ff;
+
+ if (!ee) {
+ if (x) {
+ x = frexp(x*0x1p64, e);
+ *e -= 64;
+ } else *e = 0;
+ return x;
+ } else if (ee == 0x7ff) {
+ return x;
+ }
+
+ *e = ee - 0x3fe;
+ y.i &= 0x800fffffffffffffull;
+ y.i |= 0x3fe0000000000000ull;
+ return y.d;
+}
--- /dev/null
+#include <math.h>
+#include <stdint.h>
+
+float frexpf(float x, int *e)
+{
+ union { float f; uint32_t i; } y = { x };
+ int ee = y.i>>23 & 0xff;
+
+ if (!ee) {
+ if (x) {
+ x = frexpf(x*0x1p64, e);
+ *e -= 64;
+ } else *e = 0;
+ return x;
+ } else if (ee == 0xff) {
+ return x;
+ }
+
+ *e = ee - 0x7e;
+ y.i &= 0x807ffffful;
+ y.i |= 0x3f000000ul;
+ return y.f;
+}
--- /dev/null
+#include <math.h>
+#include <stdint.h>
+#include <float.h>
+
+#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+
+/* This version is for 80-bit little endian long double */
+
+long double frexpl(long double x, int *e)
+{
+ union { long double ld; uint16_t hw[5]; } y = { x };
+ int ee = y.hw[4]&0x7fff;
+
+ if (!ee) {
+ if (x) {
+ x = frexpl(x*0x1p64, e);
+ *e -= 64;
+ } else *e = 0;
+ return x;
+ } else if (ee == 0x7fff) {
+ return x;
+ }
+
+ *e = ee - 0x3ffe;
+ y.hw[4] &= 0x8000;
+ y.hw[4] |= 0x3ffe;
+ return y.ld;
+}
+
+#else
+
+long double frexpl(long double x, int *e)
+{
+ return frexp(x, e);
+}
+
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_hypot.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* hypot(x,y)
+ *
+ * Method :
+ * If (assume round-to-nearest) z=x*x+y*y
+ * has error less than sqrt(2)/2 ulp, then
+ * sqrt(z) has error less than 1 ulp (exercise).
+ *
+ * So, compute sqrt(x*x+y*y) with some care as
+ * follows to get the error below 1 ulp:
+ *
+ * Assume x>y>0;
+ * (if possible, set rounding to round-to-nearest)
+ * 1. if x > 2y use
+ * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y
+ * where x1 = x with lower 32 bits cleared, x2 = x-x1; else
+ * 2. if x <= 2y use
+ * t1*y1+((x-y)*(x-y)+(t1*y2+t2*y))
+ * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1,
+ * y1= y with lower 32 bits chopped, y2 = y-y1.
+ *
+ * NOTE: scaling may be necessary if some argument is too
+ * large or too tiny
+ *
+ * Special cases:
+ * hypot(x,y) is INF if x or y is +INF or -INF; else
+ * hypot(x,y) is NAN if x or y is NAN.
+ *
+ * Accuracy:
+ * hypot(x,y) returns sqrt(x^2+y^2) with error less
+ * than 1 ulps (units in the last place)
+ */
+
+#include "libm.h"
+
+double 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;
+ }
+ a = fabs(a);
+ b = fabs(b);
+ if (ha - hb > 0x3c00000) /* x/y > 2**60 */
+ return a+b;
+ k = 0;
+ if (ha > 0x5f300000) { /* a > 2**500 */
+ if(ha >= 0x7ff00000) { /* Inf or NaN */
+ uint32_t low;
+ /* Use original arg order iff result is NaN; quieten sNaNs. */
+ w = fabs(x+0.0) - fabs(y+0.0);
+ 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 (hb < 0x20b00000) { /* b < 2**-500 */
+ if (hb <= 0x000fffff) { /* subnormal b or 0 */
+ uint32_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;
+ } 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 = 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 = sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b)));
+ }
+ if (k != 0) {
+ uint32_t high;
+ t1 = 1.0;
+ GET_HIGH_WORD(high, t1);
+ SET_HIGH_WORD(t1, high+(k<<20));
+ return t1*w;
+ }
+ return w;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_hypotf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+float hypotf(float x, float y)
+{
+ float a,b,t1,t2,y1,y2,w;
+ int32_t j,k,ha,hb;
+
+ GET_FLOAT_WORD(ha,x);
+ ha &= 0x7fffffff;
+ GET_FLOAT_WORD(hb,y);
+ hb &= 0x7fffffff;
+ if (hb > ha) {
+ a = y;
+ b = x;
+ j=ha; ha=hb; hb=j;
+ } else {
+ a = x;
+ b = y;
+ }
+ a = fabsf(a);
+ b = fabsf(b);
+ if (ha - hb > 0xf000000) /* x/y > 2**30 */
+ return a+b;
+ k = 0;
+ if (ha > 0x58800000) { /* a > 2**50 */
+ if(ha >= 0x7f800000) { /* Inf or NaN */
+ /* Use original arg order iff result is NaN; quieten sNaNs. */
+ w = fabsf(x+0.0F) - fabsf(y+0.0F);
+ if (ha == 0x7f800000) w = a;
+ if (hb == 0x7f800000) w = b;
+ return w;
+ }
+ /* scale a and b by 2**-68 */
+ ha -= 0x22000000; hb -= 0x22000000; k += 68;
+ SET_FLOAT_WORD(a, ha);
+ SET_FLOAT_WORD(b, hb);
+ }
+ if (hb < 0x26800000) { /* b < 2**-50 */
+ if (hb <= 0x007fffff) { /* subnormal b or 0 */
+ if (hb == 0)
+ return a;
+ SET_FLOAT_WORD(t1, 0x7e800000); /* t1 = 2^126 */
+ b *= t1;
+ a *= t1;
+ k -= 126;
+ } else { /* scale a and b by 2^68 */
+ ha += 0x22000000; /* a *= 2^68 */
+ hb += 0x22000000; /* b *= 2^68 */
+ k -= 68;
+ SET_FLOAT_WORD(a, ha);
+ SET_FLOAT_WORD(b, hb);
+ }
+ }
+ /* medium size a and b */
+ w = a - b;
+ if (w > b) {
+ SET_FLOAT_WORD(t1, ha&0xfffff000);
+ t2 = a - t1;
+ w = sqrtf(t1*t1-(b*(-b)-t2*(a+t1)));
+ } else {
+ a = a + a;
+ SET_FLOAT_WORD(y1, hb&0xfffff000);
+ y2 = b - y1;
+ SET_FLOAT_WORD(t1,(ha+0x00800000)&0xfffff000);
+ t2 = a - t1;
+ w = sqrtf(t1*y1-(w*(-w)-(t1*y2+t2*b)));
+ }
+ if (k != 0) {
+ SET_FLOAT_WORD(t1, 0x3f800000+(k<<23));
+ return t1*w;
+ }
+ return w;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_hypotl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* long double version of hypot(). See comments in hypot.c. */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double hypotl(long double x, long double y)
+{
+ return hypot(x, y);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#define GET_LDBL_EXPSIGN(i, v) do { \
+ union IEEEl2bits uv; \
+ \
+ uv.e = v; \
+ i = uv.xbits.expsign; \
+} while (0)
+
+#define GET_LDBL_MAN(h, l, v) do { \
+ union IEEEl2bits uv; \
+ \
+ uv.e = v; \
+ h = uv.bits.manh; \
+ l = uv.bits.manl; \
+} while (0)
+
+#define SET_LDBL_EXPSIGN(v, i) do { \
+ union IEEEl2bits uv; \
+ \
+ uv.e = v; \
+ uv.xbits.expsign = i; \
+ v = uv.e; \
+} while (0)
+
+#undef GET_HIGH_WORD
+#define GET_HIGH_WORD(i, v) GET_LDBL_EXPSIGN(i, v)
+#undef SET_HIGH_WORD
+#define SET_HIGH_WORD(v, i) SET_LDBL_EXPSIGN(v, i)
+
+#define DESW(exp) (exp) /* delta expsign word */
+#define ESW(exp) (MAX_EXP - 1 + (exp)) /* expsign word */
+#define MANT_DIG LDBL_MANT_DIG
+#define MAX_EXP LDBL_MAX_EXP
+
+#if LDBL_MANL_SIZE > 32
+typedef uint64_t man_t;
+#else
+typedef uint32_t man_t;
+#endif
+
+long double hypotl(long double x, long double y)
+{
+ long double a=x,b=y,t1,t2,y1,y2,w;
+ int32_t j,k,ha,hb;
+
+ GET_HIGH_WORD(ha, x);
+ ha &= 0x7fff;
+ GET_HIGH_WORD(hb, y);
+ hb &= 0x7fff;
+ if (hb > ha) {
+ a = y;
+ b = x;
+ j=ha; ha=hb; hb=j;
+ } else {
+ a = x;
+ b = y;
+ }
+ a = fabsl(a);
+ b = fabsl(b);
+ if (ha - hb > DESW(MANT_DIG+7)) /* x/y > 2**(MANT_DIG+7) */
+ return a+b;
+ k = 0;
+ if (ha > ESW(MAX_EXP/2-12)) { /* a>2**(MAX_EXP/2-12) */
+ if (ha >= ESW(MAX_EXP)) { /* Inf or NaN */
+ man_t manh, manl;
+ /* Use original arg order iff result is NaN; quieten sNaNs. */
+ w = fabsl(x+0.0)-fabsl(y+0.0);
+ GET_LDBL_MAN(manh,manl,a);
+ if (manh == LDBL_NBIT && manl == 0) w = a;
+ GET_LDBL_MAN(manh,manl,b);
+ if (hb >= ESW(MAX_EXP) && manh == LDBL_NBIT && manl == 0) w = b;
+ return w;
+ }
+ /* scale a and b by 2**-(MAX_EXP/2+88) */
+ ha -= DESW(MAX_EXP/2+88); hb -= DESW(MAX_EXP/2+88);
+ k += MAX_EXP/2+88;
+ SET_HIGH_WORD(a, ha);
+ SET_HIGH_WORD(b, hb);
+ }
+ if (hb < ESW(-(MAX_EXP/2-12))) { /* b < 2**-(MAX_EXP/2-12) */
+ if (hb <= 0) { /* subnormal b or 0 */
+ man_t manh, manl;
+ GET_LDBL_MAN(manh,manl,b);
+ if ((manh|manl) == 0)
+ return a;
+ t1 = 0;
+ SET_HIGH_WORD(t1, ESW(MAX_EXP-2)); /* t1 = 2^(MAX_EXP-2) */
+ b *= t1;
+ a *= t1;
+ k -= MAX_EXP-2;
+ } else { /* scale a and b by 2^(MAX_EXP/2+88) */
+ ha += DESW(MAX_EXP/2+88);
+ hb += DESW(MAX_EXP/2+88);
+ k -= MAX_EXP/2+88;
+ SET_HIGH_WORD(a, ha);
+ SET_HIGH_WORD(b, hb);
+ }
+ }
+ /* medium size a and b */
+ w = a - b;
+ if (w > b) {
+ t1 = a;
+ union IEEEl2bits uv;
+ uv.e = t1; uv.bits.manl = 0; t1 = uv.e;
+ t2 = a-t1;
+ w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1)));
+ } else {
+ a = a+a;
+ y1 = b;
+ union IEEEl2bits uv;
+ uv.e = y1; uv.bits.manl = 0; y1 = uv.e;
+ y2 = b - y1;
+ t1 = a;
+ uv.e = t1; uv.bits.manl = 0; t1 = uv.e;
+ t2 = a - t1;
+ w = sqrtl(t1*y1-(w*(-w)-(t1*y2+t2*b)));
+ }
+ if(k!=0) {
+ uint32_t high;
+ t1 = 1.0;
+ GET_HIGH_WORD(high, t1);
+ SET_HIGH_WORD(t1, high+DESW(k));
+ return t1*w;
+ }
+ return w;
+}
+#endif
+++ /dev/null
-.global expf
-.type expf,@function
-expf:
- mov 4(%esp),%eax
- flds 4(%esp)
- shr $23,%eax
- inc %al
- jz 1f
- jmp 0f
-
-.global exp
-.type exp,@function
-exp:
- mov 8(%esp),%eax
- fldl 4(%esp)
- shl %eax
- cmp $0xffe00000,%eax
- jae 1f
-
-0: fldl2e
- fmulp
- fst %st(1)
- frndint
- fst %st(2)
- fsubrp
- f2xm1
- fld1
- faddp
- fscale
- fstp %st(1)
- ret
-
-1: fsts 4(%esp)
- cmpl $0xff800000,4(%esp)
- jnz 1f
- fstp %st(0)
- fldz
-1: ret
+++ /dev/null
-.global log
-.type log,@function
-log:
- fldln2
- fldl 4(%esp)
- fyl2x
- ret
+++ /dev/null
-.global log10
-.type log10,@function
-log10:
- fldlg2
- fldl 4(%esp)
- fyl2x
- ret
+++ /dev/null
-.global log10f
-.type log10f,@function
-log10f:
- fldlg2
- flds 4(%esp)
- fyl2x
- ret
+++ /dev/null
-.global logf
-.type logf,@function
-logf:
- fldln2
- flds 4(%esp)
- fyl2x
- ret
+++ /dev/null
-.global remainderf
-.type remainderf,@function
-remainderf:
- flds 8(%esp)
- flds 4(%esp)
- jmp 1f
-
-.global remainder
-.type remainder,@function
-remainder:
- fldl 12(%esp)
- fldl 4(%esp)
-1: fprem1
- fstsw %ax
- sahf
- jp 1b
- fstp %st(1)
- ret
+++ /dev/null
-.global sqrt
-.type sqrt,@function
-sqrt: fldl 4(%esp)
- fsqrt
- ret
+++ /dev/null
-.global sqrtf
-.type sqrtf,@function
-sqrtf: flds 4(%esp)
- fsqrt
- ret
+++ /dev/null
-.global fabs
-.type fabs,@function
-fabs:
- fldl 4(%esp)
- fabs
- ret
+++ /dev/null
-.global fabsf
-.type fabsf,@function
-fabsf:
- flds 4(%esp)
- fabs
- ret
+++ /dev/null
-.global rint
-.type rint,@function
-rint:
- fldl 4(%esp)
- frndint
- ret
+++ /dev/null
-.global rintf
-.type rintf,@function
-rintf:
- flds 4(%esp)
- frndint
- ret
+++ /dev/null
-.global ldexp
-.global scalbn
-.global scalbln
-.type ldexp,@function
-.type scalbn,@function
-.type scalbln,@function
-ldexp:
-scalbn:
-scalbln:
- fildl 12(%esp)
- fldl 4(%esp)
- fscale
- fstp %st(1)
- ret
+++ /dev/null
-.global ldexpf
-.global scalbnf
-.global scalblnf
-.type ldexpf,@function
-.type scalbnf,@function
-.type scalblnf,@function
-ldexpf:
-scalbnf:
-scalblnf:
- fildl 8(%esp)
- flds 4(%esp)
- fscale
- fstp %st(1)
- ret
+++ /dev/null
-.global ceilf
-.type ceilf,@function
-ceilf: flds 4(%esp)
- jmp 1f
-
-.global ceil
-.type ceil,@function
-ceil: fldl 4(%esp)
-1: mov $0x08fb,%edx
- jmp 0f
-
-.global floorf
-.type floorf,@function
-floorf: flds 4(%esp)
- jmp 1f
-
-.global floor
-.type floor,@function
-floor: fldl 4(%esp)
-1: mov $0x04f7,%edx
- jmp 0f
-
-.global truncf
-.type truncf,@function
-truncf: flds 4(%esp)
- jmp 1f
-
-.global trunc
-.type trunc,@function
-trunc: fldl 4(%esp)
-1: mov $0x0cff,%edx
-
-0: fstcw 4(%esp)
- mov 5(%esp),%ah
- or %dh,%ah
- and %dl,%ah
- xchg %ah,5(%esp)
- fldcw 4(%esp)
- frndint
- mov %ah,5(%esp)
- fldcw 4(%esp)
- ret
--- /dev/null
+.global sqrt
+.type sqrt,@function
+sqrt: fldl 4(%esp)
+ fsqrt
+ ret
--- /dev/null
+.global sqrtf
+.type sqrtf,@function
+sqrtf: flds 4(%esp)
+ fsqrt
+ ret
--- /dev/null
+.global sqrtl
+.type sqrtl,@function
+sqrtl: fldt 4(%esp)
+ fsqrt
+ ret
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+int ilogb(double x)
+{
+ union dshape u = {x};
+ int e = u.bits>>52 & 0x7ff;
+
+ if (!e) {
+ u.bits <<= 12;
+ if (u.bits == 0)
+ return FP_ILOGB0;
+ /* subnormal x */
+ // FIXME: scale up subnormals with a *0x1p53 or find top set bit with a better method
+ for (e = -0x3ff; u.bits < (uint64_t)1<<63; e--, u.bits<<=1);
+ return e;
+ }
+ if (e == 0x7ff)
+ return u.bits<<12 ? FP_ILOGBNAN : INT_MAX;
+ return e - 0x3ff;
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+int ilogbf(float x)
+{
+ union fshape u = {x};
+ int e = u.bits>>23 & 0xff;
+
+ if (!e) {
+ u.bits <<= 9;
+ if (u.bits == 0)
+ return FP_ILOGB0;
+ /* subnormal x */
+ for (e = -0x7f; u.bits < (uint32_t)1<<31; e--, u.bits<<=1);
+ return e;
+ }
+ if (e == 0xff)
+ return u.bits<<9 ? FP_ILOGBNAN : INT_MAX;
+ return e - 0x7f;
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+int ilogbl(long double x)
+{
+ return ilogb(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+int ilogbl(long double x)
+{
+ union ldshape u = {x};
+ uint64_t m = u.bits.m;
+ int e = u.bits.exp;
+
+ if (!e) {
+ if (m == 0)
+ return FP_ILOGB0;
+ /* subnormal x */
+ for (e = -0x3fff+1; m < (uint64_t)1<<63; e--, m<<=1);
+ return e;
+ }
+ if (e == 0x7fff)
+ /* in ld80 msb is set in inf */
+ return m & (uint64_t)-1>>1 ? FP_ILOGBNAN : INT_MAX;
+ return e - 0x3fff;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_j0.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* j0(x), y0(x)
+ * Bessel function of the first and second kinds of order zero.
+ * Method -- j0(x):
+ * 1. For tiny x, we use j0(x) = 1 - x^2/4 + x^4/64 - ...
+ * 2. Reduce x to |x| since j0(x)=j0(-x), and
+ * for x in (0,2)
+ * j0(x) = 1-z/4+ z^2*R0/S0, where z = x*x;
+ * (precision: |j0-1+z/4-z^2R0/S0 |<2**-63.67 )
+ * for x in (2,inf)
+ * j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0))
+ * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0)
+ * as follow:
+ * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
+ * = 1/sqrt(2) * (cos(x) + sin(x))
+ * sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * (To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.)
+ *
+ * 3 Special cases
+ * j0(nan)= nan
+ * j0(0) = 1
+ * j0(inf) = 0
+ *
+ * Method -- y0(x):
+ * 1. For x<2.
+ * Since
+ * y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...)
+ * therefore y0(x)-2/pi*j0(x)*ln(x) is an even function.
+ * We use the following function to approximate y0,
+ * y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2
+ * where
+ * U(z) = u00 + u01*z + ... + u06*z^6
+ * V(z) = 1 + v01*z + ... + v04*z^4
+ * with absolute approximation error bounded by 2**-72.
+ * Note: For tiny x, U/V = u0 and j0(x)~1, hence
+ * y0(tiny) = u0 + (2/pi)*ln(tiny), (choose tiny<2**-27)
+ * 2. For x>=2.
+ * y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0))
+ * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0)
+ * by the method mentioned above.
+ * 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0.
+ */
+
+#include "libm.h"
+
+static double pzero(double), qzero(double);
+
+static const double
+huge = 1e300,
+one = 1.0,
+invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
+tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+/* R0/S0 on [0, 2.00] */
+R02 = 1.56249999999999947958e-02, /* 0x3F8FFFFF, 0xFFFFFFFD */
+R03 = -1.89979294238854721751e-04, /* 0xBF28E6A5, 0xB61AC6E9 */
+R04 = 1.82954049532700665670e-06, /* 0x3EBEB1D1, 0x0C503919 */
+R05 = -4.61832688532103189199e-09, /* 0xBE33D5E7, 0x73D63FCE */
+S01 = 1.56191029464890010492e-02, /* 0x3F8FFCE8, 0x82C8C2A4 */
+S02 = 1.16926784663337450260e-04, /* 0x3F1EA6D2, 0xDD57DBF4 */
+S03 = 5.13546550207318111446e-07, /* 0x3EA13B54, 0xCE84D5A9 */
+S04 = 1.16614003333790000205e-09; /* 0x3E1408BC, 0xF4745D8F */
+
+static const double zero = 0.0;
+
+double j0(double x)
+{
+ double z, s,c,ss,cc,r,u,v;
+ int32_t hx,ix;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7ff00000)
+ return one/(x*x);
+ x = fabs(x);
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sin(x);
+ c = cos(x);
+ ss = s-c;
+ cc = s+c;
+ if (ix < 0x7fe00000) { /* make sure x+x does not overflow */
+ z = -cos(x+x);
+ if ((s*c) < zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ /*
+ * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
+ * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
+ */
+ if (ix > 0x48000000)
+ z = (invsqrtpi*cc)/sqrt(x);
+ else {
+ u = pzero(x);
+ v = qzero(x);
+ z = invsqrtpi*(u*cc-v*ss)/sqrt(x);
+ }
+ return z;
+ }
+ if (ix < 0x3f200000) { /* |x| < 2**-13 */
+ /* raise inexact if x != 0 */
+ if (huge+x > one) {
+ if (ix < 0x3e400000) /* |x| < 2**-27 */
+ return one;
+ return one - 0.25*x*x;
+ }
+ }
+ z = x*x;
+ r = z*(R02+z*(R03+z*(R04+z*R05)));
+ s = one+z*(S01+z*(S02+z*(S03+z*S04)));
+ if (ix < 0x3FF00000) { /* |x| < 1.00 */
+ return one + z*(-0.25+(r/s));
+ } else {
+ u = 0.5*x;
+ return (one+u)*(one-u) + z*(r/s);
+ }
+}
+
+static const double
+u00 = -7.38042951086872317523e-02, /* 0xBFB2E4D6, 0x99CBD01F */
+u01 = 1.76666452509181115538e-01, /* 0x3FC69D01, 0x9DE9E3FC */
+u02 = -1.38185671945596898896e-02, /* 0xBF8C4CE8, 0xB16CFA97 */
+u03 = 3.47453432093683650238e-04, /* 0x3F36C54D, 0x20B29B6B */
+u04 = -3.81407053724364161125e-06, /* 0xBECFFEA7, 0x73D25CAD */
+u05 = 1.95590137035022920206e-08, /* 0x3E550057, 0x3B4EABD4 */
+u06 = -3.98205194132103398453e-11, /* 0xBDC5E43D, 0x693FB3C8 */
+v01 = 1.27304834834123699328e-02, /* 0x3F8A1270, 0x91C9C71A */
+v02 = 7.60068627350353253702e-05, /* 0x3F13ECBB, 0xF578C6C1 */
+v03 = 2.59150851840457805467e-07, /* 0x3E91642D, 0x7FF202FD */
+v04 = 4.41110311332675467403e-10; /* 0x3DFE5018, 0x3BD6D9EF */
+
+double y0(double x)
+{
+ double z,s,c,ss,cc,u,v;
+ int32_t hx,ix,lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+ ix = 0x7fffffff & hx;
+ /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */
+ if (ix >= 0x7ff00000)
+ return one/(x+x*x);
+ if ((ix|lx) == 0)
+ return -one/zero;
+ if (hx < 0)
+ return zero/zero;
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0))
+ * where x0 = x-pi/4
+ * Better formula:
+ * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
+ * = 1/sqrt(2) * (sin(x) + cos(x))
+ * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.
+ */
+ s = sin(x);
+ c = cos(x);
+ ss = s-c;
+ cc = s+c;
+ /*
+ * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
+ * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
+ */
+ if (ix < 0x7fe00000) { /* make sure x+x does not overflow */
+ z = -cos(x+x);
+ if (s*c < zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ if (ix > 0x48000000)
+ z = (invsqrtpi*ss)/sqrt(x);
+ else {
+ u = pzero(x);
+ v = qzero(x);
+ z = invsqrtpi*(u*ss+v*cc)/sqrt(x);
+ }
+ return z;
+ }
+ if (ix <= 0x3e400000) { /* x < 2**-27 */
+ return u00 + tpi*log(x);
+ }
+ z = x*x;
+ u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06)))));
+ v = one+z*(v01+z*(v02+z*(v03+z*v04)));
+ return u/v + tpi*(j0(x)*log(x));
+}
+
+/* The asymptotic expansions of pzero is
+ * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x.
+ * For x >= 2, We approximate pzero by
+ * pzero(x) = 1 + (R/S)
+ * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10
+ * S = 1 + pS0*s^2 + ... + pS4*s^10
+ * and
+ * | pzero(x)-1-R/S | <= 2 ** ( -60.26)
+ */
+static const double pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ -7.03124999999900357484e-02, /* 0xBFB1FFFF, 0xFFFFFD32 */
+ -8.08167041275349795626e+00, /* 0xC02029D0, 0xB44FA779 */
+ -2.57063105679704847262e+02, /* 0xC0701102, 0x7B19E863 */
+ -2.48521641009428822144e+03, /* 0xC0A36A6E, 0xCD4DCAFC */
+ -5.25304380490729545272e+03, /* 0xC0B4850B, 0x36CC643D */
+};
+static const double pS8[5] = {
+ 1.16534364619668181717e+02, /* 0x405D2233, 0x07A96751 */
+ 3.83374475364121826715e+03, /* 0x40ADF37D, 0x50596938 */
+ 4.05978572648472545552e+04, /* 0x40E3D2BB, 0x6EB6B05F */
+ 1.16752972564375915681e+05, /* 0x40FC810F, 0x8F9FA9BD */
+ 4.76277284146730962675e+04, /* 0x40E74177, 0x4F2C49DC */
+};
+
+static const double pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ -1.14125464691894502584e-11, /* 0xBDA918B1, 0x47E495CC */
+ -7.03124940873599280078e-02, /* 0xBFB1FFFF, 0xE69AFBC6 */
+ -4.15961064470587782438e+00, /* 0xC010A370, 0xF90C6BBF */
+ -6.76747652265167261021e+01, /* 0xC050EB2F, 0x5A7D1783 */
+ -3.31231299649172967747e+02, /* 0xC074B3B3, 0x6742CC63 */
+ -3.46433388365604912451e+02, /* 0xC075A6EF, 0x28A38BD7 */
+};
+static const double pS5[5] = {
+ 6.07539382692300335975e+01, /* 0x404E6081, 0x0C98C5DE */
+ 1.05125230595704579173e+03, /* 0x40906D02, 0x5C7E2864 */
+ 5.97897094333855784498e+03, /* 0x40B75AF8, 0x8FBE1D60 */
+ 9.62544514357774460223e+03, /* 0x40C2CCB8, 0xFA76FA38 */
+ 2.40605815922939109441e+03, /* 0x40A2CC1D, 0xC70BE864 */
+};
+
+static const double pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
+ -2.54704601771951915620e-09, /* 0xBE25E103, 0x6FE1AA86 */
+ -7.03119616381481654654e-02, /* 0xBFB1FFF6, 0xF7C0E24B */
+ -2.40903221549529611423e+00, /* 0xC00345B2, 0xAEA48074 */
+ -2.19659774734883086467e+01, /* 0xC035F74A, 0x4CB94E14 */
+ -5.80791704701737572236e+01, /* 0xC04D0A22, 0x420A1A45 */
+ -3.14479470594888503854e+01, /* 0xC03F72AC, 0xA892D80F */
+};
+static const double pS3[5] = {
+ 3.58560338055209726349e+01, /* 0x4041ED92, 0x84077DD3 */
+ 3.61513983050303863820e+02, /* 0x40769839, 0x464A7C0E */
+ 1.19360783792111533330e+03, /* 0x4092A66E, 0x6D1061D6 */
+ 1.12799679856907414432e+03, /* 0x40919FFC, 0xB8C39B7E */
+ 1.73580930813335754692e+02, /* 0x4065B296, 0xFC379081 */
+};
+
+static const double pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ -8.87534333032526411254e-08, /* 0xBE77D316, 0xE927026D */
+ -7.03030995483624743247e-02, /* 0xBFB1FF62, 0x495E1E42 */
+ -1.45073846780952986357e+00, /* 0xBFF73639, 0x8A24A843 */
+ -7.63569613823527770791e+00, /* 0xC01E8AF3, 0xEDAFA7F3 */
+ -1.11931668860356747786e+01, /* 0xC02662E6, 0xC5246303 */
+ -3.23364579351335335033e+00, /* 0xC009DE81, 0xAF8FE70F */
+};
+static const double pS2[5] = {
+ 2.22202997532088808441e+01, /* 0x40363865, 0x908B5959 */
+ 1.36206794218215208048e+02, /* 0x4061069E, 0x0EE8878F */
+ 2.70470278658083486789e+02, /* 0x4070E786, 0x42EA079B */
+ 1.53875394208320329881e+02, /* 0x40633C03, 0x3AB6FAFF */
+ 1.46576176948256193810e+01, /* 0x402D50B3, 0x44391809 */
+};
+
+static double pzero(double x)
+{
+ const double *p,*q;
+ double z,r,s;
+ int32_t ix;
+
+ GET_HIGH_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x40200000){p = pR8; q = pS8;}
+ else if (ix >= 0x40122E8B){p = pR5; q = pS5;}
+ else if (ix >= 0x4006DB6D){p = pR3; q = pS3;}
+ else if (ix >= 0x40000000){p = pR2; q = pS2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4]))));
+ return one + r/s;
+}
+
+
+/* For x >= 8, the asymptotic expansions of qzero is
+ * -1/8 s + 75/1024 s^3 - ..., where s = 1/x.
+ * We approximate pzero by
+ * qzero(x) = s*(-1.25 + (R/S))
+ * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10
+ * S = 1 + qS0*s^2 + ... + qS5*s^12
+ * and
+ * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22)
+ */
+static const double qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ 7.32421874999935051953e-02, /* 0x3FB2BFFF, 0xFFFFFE2C */
+ 1.17682064682252693899e+01, /* 0x40278952, 0x5BB334D6 */
+ 5.57673380256401856059e+02, /* 0x40816D63, 0x15301825 */
+ 8.85919720756468632317e+03, /* 0x40C14D99, 0x3E18F46D */
+ 3.70146267776887834771e+04, /* 0x40E212D4, 0x0E901566 */
+};
+static const double qS8[6] = {
+ 1.63776026895689824414e+02, /* 0x406478D5, 0x365B39BC */
+ 8.09834494656449805916e+03, /* 0x40BFA258, 0x4E6B0563 */
+ 1.42538291419120476348e+05, /* 0x41016652, 0x54D38C3F */
+ 8.03309257119514397345e+05, /* 0x412883DA, 0x83A52B43 */
+ 8.40501579819060512818e+05, /* 0x4129A66B, 0x28DE0B3D */
+ -3.43899293537866615225e+05, /* 0xC114FD6D, 0x2C9530C5 */
+};
+
+static const double qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ 1.84085963594515531381e-11, /* 0x3DB43D8F, 0x29CC8CD9 */
+ 7.32421766612684765896e-02, /* 0x3FB2BFFF, 0xD172B04C */
+ 5.83563508962056953777e+00, /* 0x401757B0, 0xB9953DD3 */
+ 1.35111577286449829671e+02, /* 0x4060E392, 0x0A8788E9 */
+ 1.02724376596164097464e+03, /* 0x40900CF9, 0x9DC8C481 */
+ 1.98997785864605384631e+03, /* 0x409F17E9, 0x53C6E3A6 */
+};
+static const double qS5[6] = {
+ 8.27766102236537761883e+01, /* 0x4054B1B3, 0xFB5E1543 */
+ 2.07781416421392987104e+03, /* 0x40A03BA0, 0xDA21C0CE */
+ 1.88472887785718085070e+04, /* 0x40D267D2, 0x7B591E6D */
+ 5.67511122894947329769e+04, /* 0x40EBB5E3, 0x97E02372 */
+ 3.59767538425114471465e+04, /* 0x40E19118, 0x1F7A54A0 */
+ -5.35434275601944773371e+03, /* 0xC0B4EA57, 0xBEDBC609 */
+};
+
+static const double qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
+ 4.37741014089738620906e-09, /* 0x3E32CD03, 0x6ADECB82 */
+ 7.32411180042911447163e-02, /* 0x3FB2BFEE, 0x0E8D0842 */
+ 3.34423137516170720929e+00, /* 0x400AC0FC, 0x61149CF5 */
+ 4.26218440745412650017e+01, /* 0x40454F98, 0x962DAEDD */
+ 1.70808091340565596283e+02, /* 0x406559DB, 0xE25EFD1F */
+ 1.66733948696651168575e+02, /* 0x4064D77C, 0x81FA21E0 */
+};
+static const double qS3[6] = {
+ 4.87588729724587182091e+01, /* 0x40486122, 0xBFE343A6 */
+ 7.09689221056606015736e+02, /* 0x40862D83, 0x86544EB3 */
+ 3.70414822620111362994e+03, /* 0x40ACF04B, 0xE44DFC63 */
+ 6.46042516752568917582e+03, /* 0x40B93C6C, 0xD7C76A28 */
+ 2.51633368920368957333e+03, /* 0x40A3A8AA, 0xD94FB1C0 */
+ -1.49247451836156386662e+02, /* 0xC062A7EB, 0x201CF40F */
+};
+
+static const double qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ 1.50444444886983272379e-07, /* 0x3E84313B, 0x54F76BDB */
+ 7.32234265963079278272e-02, /* 0x3FB2BEC5, 0x3E883E34 */
+ 1.99819174093815998816e+00, /* 0x3FFFF897, 0xE727779C */
+ 1.44956029347885735348e+01, /* 0x402CFDBF, 0xAAF96FE5 */
+ 3.16662317504781540833e+01, /* 0x403FAA8E, 0x29FBDC4A */
+ 1.62527075710929267416e+01, /* 0x403040B1, 0x71814BB4 */
+};
+static const double qS2[6] = {
+ 3.03655848355219184498e+01, /* 0x403E5D96, 0xF7C07AED */
+ 2.69348118608049844624e+02, /* 0x4070D591, 0xE4D14B40 */
+ 8.44783757595320139444e+02, /* 0x408A6645, 0x22B3BF22 */
+ 8.82935845112488550512e+02, /* 0x408B977C, 0x9C5CC214 */
+ 2.12666388511798828631e+02, /* 0x406A9553, 0x0E001365 */
+ -5.31095493882666946917e+00, /* 0xC0153E6A, 0xF8B32931 */
+};
+
+static double qzero(double x)
+{
+ const double *p,*q;
+ double s,r,z;
+ int32_t ix;
+
+ GET_HIGH_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x40200000){p = qR8; q = qS8;}
+ else if (ix >= 0x40122E8B){p = qR5; q = qS5;}
+ else if (ix >= 0x4006DB6D){p = qR3; q = qS3;}
+ else if (ix >= 0x40000000){p = qR2; q = qS2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5])))));
+ return (-.125 + r/s)/x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_j0f.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static float pzerof(float), qzerof(float);
+
+static const float
+huge = 1e30,
+one = 1.0,
+invsqrtpi = 5.6418961287e-01, /* 0x3f106ebb */
+tpi = 6.3661974669e-01, /* 0x3f22f983 */
+/* R0/S0 on [0, 2.00] */
+R02 = 1.5625000000e-02, /* 0x3c800000 */
+R03 = -1.8997929874e-04, /* 0xb947352e */
+R04 = 1.8295404516e-06, /* 0x35f58e88 */
+R05 = -4.6183270541e-09, /* 0xb19eaf3c */
+S01 = 1.5619102865e-02, /* 0x3c7fe744 */
+S02 = 1.1692678527e-04, /* 0x38f53697 */
+S03 = 5.1354652442e-07, /* 0x3509daa6 */
+S04 = 1.1661400734e-09; /* 0x30a045e8 */
+
+static const float zero = 0.0;
+
+float j0f(float x)
+{
+ float z, s,c,ss,cc,r,u,v;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7f800000)
+ return one/(x*x);
+ x = fabsf(x);
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sinf(x);
+ c = cosf(x);
+ ss = s-c;
+ cc = s+c;
+ if (ix < 0x7f000000) { /* make sure x+x does not overflow */
+ z = -cosf(x+x);
+ if (s*c < zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ /*
+ * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
+ * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
+ */
+ if (ix > 0x80000000)
+ z = (invsqrtpi*cc)/sqrtf(x);
+ else {
+ u = pzerof(x);
+ v = qzerof(x);
+ z = invsqrtpi*(u*cc-v*ss)/sqrtf(x);
+ }
+ return z;
+ }
+ if (ix < 0x39000000) { /* |x| < 2**-13 */
+ /* raise inexact if x != 0 */
+ if (huge+x > one) {
+ if (ix < 0x32000000) /* |x| < 2**-27 */
+ return one;
+ return one - (float)0.25*x*x;
+ }
+ }
+ z = x*x;
+ r = z*(R02+z*(R03+z*(R04+z*R05)));
+ s = one+z*(S01+z*(S02+z*(S03+z*S04)));
+ if(ix < 0x3F800000) { /* |x| < 1.00 */
+ return one + z*((float)-0.25+(r/s));
+ } else {
+ u = (float)0.5*x;
+ return (one+u)*(one-u) + z*(r/s);
+ }
+}
+
+static const float
+u00 = -7.3804296553e-02, /* 0xbd9726b5 */
+u01 = 1.7666645348e-01, /* 0x3e34e80d */
+u02 = -1.3818567619e-02, /* 0xbc626746 */
+u03 = 3.4745343146e-04, /* 0x39b62a69 */
+u04 = -3.8140706238e-06, /* 0xb67ff53c */
+u05 = 1.9559013964e-08, /* 0x32a802ba */
+u06 = -3.9820518410e-11, /* 0xae2f21eb */
+v01 = 1.2730483897e-02, /* 0x3c509385 */
+v02 = 7.6006865129e-05, /* 0x389f65e0 */
+v03 = 2.5915085189e-07, /* 0x348b216c */
+v04 = 4.4111031494e-10; /* 0x2ff280c2 */
+
+float y0f(float x)
+{
+ float z,s,c,ss,cc,u,v;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = 0x7fffffff & hx;
+ /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */
+ if (ix >= 0x7f800000)
+ return one/(x+x*x);
+ if (ix == 0)
+ return -one/zero;
+ if (hx < 0)
+ return zero/zero;
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0))
+ * where x0 = x-pi/4
+ * Better formula:
+ * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
+ * = 1/sqrt(2) * (sin(x) + cos(x))
+ * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.
+ */
+ s = sinf(x);
+ c = cosf(x);
+ ss = s-c;
+ cc = s+c;
+ /*
+ * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
+ * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
+ */
+ if (ix < 0x7f000000) { /* make sure x+x not overflow */
+ z = -cosf(x+x);
+ if (s*c < zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ if (ix > 0x80000000)
+ z = (invsqrtpi*ss)/sqrtf(x);
+ else {
+ u = pzerof(x);
+ v = qzerof(x);
+ z = invsqrtpi*(u*ss+v*cc)/sqrtf(x);
+ }
+ return z;
+ }
+ if (ix <= 0x32000000) { /* x < 2**-27 */
+ return u00 + tpi*logf(x);
+ }
+ z = x*x;
+ u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06)))));
+ v = one+z*(v01+z*(v02+z*(v03+z*v04)));
+ return u/v + tpi*(j0f(x)*logf(x));
+}
+
+/* The asymptotic expansions of pzero is
+ * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x.
+ * For x >= 2, We approximate pzero by
+ * pzero(x) = 1 + (R/S)
+ * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10
+ * S = 1 + pS0*s^2 + ... + pS4*s^10
+ * and
+ * | pzero(x)-1-R/S | <= 2 ** ( -60.26)
+ */
+static const float pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.0000000000e+00, /* 0x00000000 */
+ -7.0312500000e-02, /* 0xbd900000 */
+ -8.0816707611e+00, /* 0xc1014e86 */
+ -2.5706311035e+02, /* 0xc3808814 */
+ -2.4852163086e+03, /* 0xc51b5376 */
+ -5.2530439453e+03, /* 0xc5a4285a */
+};
+static const float pS8[5] = {
+ 1.1653436279e+02, /* 0x42e91198 */
+ 3.8337448730e+03, /* 0x456f9beb */
+ 4.0597855469e+04, /* 0x471e95db */
+ 1.1675296875e+05, /* 0x47e4087c */
+ 4.7627726562e+04, /* 0x473a0bba */
+};
+static const float pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ -1.1412546255e-11, /* 0xad48c58a */
+ -7.0312492549e-02, /* 0xbd8fffff */
+ -4.1596107483e+00, /* 0xc0851b88 */
+ -6.7674766541e+01, /* 0xc287597b */
+ -3.3123129272e+02, /* 0xc3a59d9b */
+ -3.4643338013e+02, /* 0xc3ad3779 */
+};
+static const float pS5[5] = {
+ 6.0753936768e+01, /* 0x42730408 */
+ 1.0512523193e+03, /* 0x44836813 */
+ 5.9789707031e+03, /* 0x45bad7c4 */
+ 9.6254453125e+03, /* 0x461665c8 */
+ 2.4060581055e+03, /* 0x451660ee */
+};
+
+static const float pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
+ -2.5470459075e-09, /* 0xb12f081b */
+ -7.0311963558e-02, /* 0xbd8fffb8 */
+ -2.4090321064e+00, /* 0xc01a2d95 */
+ -2.1965976715e+01, /* 0xc1afba52 */
+ -5.8079170227e+01, /* 0xc2685112 */
+ -3.1447946548e+01, /* 0xc1fb9565 */
+};
+static const float pS3[5] = {
+ 3.5856033325e+01, /* 0x420f6c94 */
+ 3.6151397705e+02, /* 0x43b4c1ca */
+ 1.1936077881e+03, /* 0x44953373 */
+ 1.1279968262e+03, /* 0x448cffe6 */
+ 1.7358093262e+02, /* 0x432d94b8 */
+};
+
+static const float pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ -8.8753431271e-08, /* 0xb3be98b7 */
+ -7.0303097367e-02, /* 0xbd8ffb12 */
+ -1.4507384300e+00, /* 0xbfb9b1cc */
+ -7.6356959343e+00, /* 0xc0f4579f */
+ -1.1193166733e+01, /* 0xc1331736 */
+ -3.2336456776e+00, /* 0xc04ef40d */
+};
+static const float pS2[5] = {
+ 2.2220300674e+01, /* 0x41b1c32d */
+ 1.3620678711e+02, /* 0x430834f0 */
+ 2.7047027588e+02, /* 0x43873c32 */
+ 1.5387539673e+02, /* 0x4319e01a */
+ 1.4657617569e+01, /* 0x416a859a */
+};
+
+static float pzerof(float x)
+{
+ const float *p,*q;
+ float z,r,s;
+ int32_t ix;
+
+ GET_FLOAT_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x41000000){p = pR8; q = pS8;}
+ else if (ix >= 0x40f71c58){p = pR5; q = pS5;}
+ else if (ix >= 0x4036db68){p = pR3; q = pS3;}
+ else if (ix >= 0x40000000){p = pR2; q = pS2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4]))));
+ return one + r/s;
+}
+
+
+/* For x >= 8, the asymptotic expansions of qzero is
+ * -1/8 s + 75/1024 s^3 - ..., where s = 1/x.
+ * We approximate pzero by
+ * qzero(x) = s*(-1.25 + (R/S))
+ * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10
+ * S = 1 + qS0*s^2 + ... + qS5*s^12
+ * and
+ * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22)
+ */
+static const float qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.0000000000e+00, /* 0x00000000 */
+ 7.3242187500e-02, /* 0x3d960000 */
+ 1.1768206596e+01, /* 0x413c4a93 */
+ 5.5767340088e+02, /* 0x440b6b19 */
+ 8.8591972656e+03, /* 0x460a6cca */
+ 3.7014625000e+04, /* 0x471096a0 */
+};
+static const float qS8[6] = {
+ 1.6377603149e+02, /* 0x4323c6aa */
+ 8.0983447266e+03, /* 0x45fd12c2 */
+ 1.4253829688e+05, /* 0x480b3293 */
+ 8.0330925000e+05, /* 0x49441ed4 */
+ 8.4050156250e+05, /* 0x494d3359 */
+ -3.4389928125e+05, /* 0xc8a7eb69 */
+};
+
+static const float qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ 1.8408595828e-11, /* 0x2da1ec79 */
+ 7.3242180049e-02, /* 0x3d95ffff */
+ 5.8356351852e+00, /* 0x40babd86 */
+ 1.3511157227e+02, /* 0x43071c90 */
+ 1.0272437744e+03, /* 0x448067cd */
+ 1.9899779053e+03, /* 0x44f8bf4b */
+};
+static const float qS5[6] = {
+ 8.2776611328e+01, /* 0x42a58da0 */
+ 2.0778142090e+03, /* 0x4501dd07 */
+ 1.8847289062e+04, /* 0x46933e94 */
+ 5.6751113281e+04, /* 0x475daf1d */
+ 3.5976753906e+04, /* 0x470c88c1 */
+ -5.3543427734e+03, /* 0xc5a752be */
+};
+
+static const float qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
+ 4.3774099900e-09, /* 0x3196681b */
+ 7.3241114616e-02, /* 0x3d95ff70 */
+ 3.3442313671e+00, /* 0x405607e3 */
+ 4.2621845245e+01, /* 0x422a7cc5 */
+ 1.7080809021e+02, /* 0x432acedf */
+ 1.6673394775e+02, /* 0x4326bbe4 */
+};
+static const float qS3[6] = {
+ 4.8758872986e+01, /* 0x42430916 */
+ 7.0968920898e+02, /* 0x44316c1c */
+ 3.7041481934e+03, /* 0x4567825f */
+ 6.4604252930e+03, /* 0x45c9e367 */
+ 2.5163337402e+03, /* 0x451d4557 */
+ -1.4924745178e+02, /* 0xc3153f59 */
+};
+
+static const float qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ 1.5044444979e-07, /* 0x342189db */
+ 7.3223426938e-02, /* 0x3d95f62a */
+ 1.9981917143e+00, /* 0x3fffc4bf */
+ 1.4495602608e+01, /* 0x4167edfd */
+ 3.1666231155e+01, /* 0x41fd5471 */
+ 1.6252708435e+01, /* 0x4182058c */
+};
+static const float qS2[6] = {
+ 3.0365585327e+01, /* 0x41f2ecb8 */
+ 2.6934811401e+02, /* 0x4386ac8f */
+ 8.4478375244e+02, /* 0x44533229 */
+ 8.8293585205e+02, /* 0x445cbbe5 */
+ 2.1266638184e+02, /* 0x4354aa98 */
+ -5.3109550476e+00, /* 0xc0a9f358 */
+};
+
+static float qzerof(float x)
+{
+ const float *p,*q;
+ float s,r,z;
+ int32_t ix;
+
+ GET_FLOAT_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x41000000){p = qR8; q = qS8;}
+ else if (ix >= 0x40f71c58){p = qR5; q = qS5;}
+ else if (ix >= 0x4036db68){p = qR3; q = qS3;}
+ else if (ix >= 0x40000000){p = qR2; q = qS2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5])))));
+ return (-(float).125 + r/s)/x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_j1.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* j1(x), y1(x)
+ * Bessel function of the first and second kinds of order zero.
+ * Method -- j1(x):
+ * 1. For tiny x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ...
+ * 2. Reduce x to |x| since j1(x)=-j1(-x), and
+ * for x in (0,2)
+ * j1(x) = x/2 + x*z*R0/S0, where z = x*x;
+ * (precision: |j1/x - 1/2 - R0/S0 |<2**-61.51 )
+ * for x in (2,inf)
+ * j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1))
+ * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1))
+ * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1)
+ * as follow:
+ * cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = -1/sqrt(2) * (sin(x) + cos(x))
+ * (To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.)
+ *
+ * 3 Special cases
+ * j1(nan)= nan
+ * j1(0) = 0
+ * j1(inf) = 0
+ *
+ * Method -- y1(x):
+ * 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN
+ * 2. For x<2.
+ * Since
+ * y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...)
+ * therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function.
+ * We use the following function to approximate y1,
+ * y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2
+ * where for x in [0,2] (abs err less than 2**-65.89)
+ * U(z) = U0[0] + U0[1]*z + ... + U0[4]*z^4
+ * V(z) = 1 + v0[0]*z + ... + v0[4]*z^5
+ * Note: For tiny x, 1/x dominate y1 and hence
+ * y1(tiny) = -2/pi/tiny, (choose tiny<2**-54)
+ * 3. For x>=2.
+ * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1))
+ * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1)
+ * by method mentioned above.
+ */
+
+#include "libm.h"
+
+static double pone(double), qone(double);
+
+static const double
+huge = 1e300,
+one = 1.0,
+invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
+tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+/* R0/S0 on [0,2] */
+r00 = -6.25000000000000000000e-02, /* 0xBFB00000, 0x00000000 */
+r01 = 1.40705666955189706048e-03, /* 0x3F570D9F, 0x98472C61 */
+r02 = -1.59955631084035597520e-05, /* 0xBEF0C5C6, 0xBA169668 */
+r03 = 4.96727999609584448412e-08, /* 0x3E6AAAFA, 0x46CA0BD9 */
+s01 = 1.91537599538363460805e-02, /* 0x3F939D0B, 0x12637E53 */
+s02 = 1.85946785588630915560e-04, /* 0x3F285F56, 0xB9CDF664 */
+s03 = 1.17718464042623683263e-06, /* 0x3EB3BFF8, 0x333F8498 */
+s04 = 5.04636257076217042715e-09, /* 0x3E35AC88, 0xC97DFF2C */
+s05 = 1.23542274426137913908e-11; /* 0x3DAB2ACF, 0xCFB97ED8 */
+
+static const double zero = 0.0;
+
+double j1(double x)
+{
+ double z,s,c,ss,cc,r,u,v,y;
+ int32_t hx,ix;
+
+ GET_HIGH_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7ff00000)
+ return one/x;
+ y = fabs(x);
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sin(y);
+ c = cos(y);
+ ss = -s-c;
+ cc = s-c;
+ if (ix < 0x7fe00000) { /* make sure y+y not overflow */
+ z = cos(y+y);
+ if (s*c > zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ /*
+ * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x)
+ * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x)
+ */
+ if (ix > 0x48000000)
+ z = (invsqrtpi*cc)/sqrt(y);
+ else {
+ u = pone(y);
+ v = qone(y);
+ z = invsqrtpi*(u*cc-v*ss)/sqrt(y);
+ }
+ if (hx < 0)
+ return -z;
+ else
+ return z;
+ }
+ if (ix < 0x3e400000) { /* |x| < 2**-27 */
+ /* raise inexact if x!=0 */
+ if (huge+x > one)
+ return 0.5*x;
+ }
+ z = x*x;
+ r = z*(r00+z*(r01+z*(r02+z*r03)));
+ s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05))));
+ r *= x;
+ return x*0.5 + r/s;
+}
+
+static const double U0[5] = {
+ -1.96057090646238940668e-01, /* 0xBFC91866, 0x143CBC8A */
+ 5.04438716639811282616e-02, /* 0x3FA9D3C7, 0x76292CD1 */
+ -1.91256895875763547298e-03, /* 0xBF5F55E5, 0x4844F50F */
+ 2.35252600561610495928e-05, /* 0x3EF8AB03, 0x8FA6B88E */
+ -9.19099158039878874504e-08, /* 0xBE78AC00, 0x569105B8 */
+};
+static const double V0[5] = {
+ 1.99167318236649903973e-02, /* 0x3F94650D, 0x3F4DA9F0 */
+ 2.02552581025135171496e-04, /* 0x3F2A8C89, 0x6C257764 */
+ 1.35608801097516229404e-06, /* 0x3EB6C05A, 0x894E8CA6 */
+ 6.22741452364621501295e-09, /* 0x3E3ABF1D, 0x5BA69A86 */
+ 1.66559246207992079114e-11, /* 0x3DB25039, 0xDACA772A */
+};
+
+
+double y1(double x)
+{
+ double z,s,c,ss,cc,u,v;
+ int32_t hx,ix,lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+ ix = 0x7fffffff & hx;
+ /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */
+ if (ix >= 0x7ff00000)
+ return one/(x+x*x);
+ if ((ix|lx) == 0)
+ return -one/zero;
+ if (hx < 0)
+ return zero/zero;
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sin(x);
+ c = cos(x);
+ ss = -s-c;
+ cc = s-c;
+ if (ix < 0x7fe00000) { /* make sure x+x not overflow */
+ z = cos(x+x);
+ if (s*c > zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0))
+ * where x0 = x-3pi/4
+ * Better formula:
+ * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = -1/sqrt(2) * (cos(x) + sin(x))
+ * To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.
+ */
+ if (ix > 0x48000000)
+ z = (invsqrtpi*ss)/sqrt(x);
+ else {
+ u = pone(x);
+ v = qone(x);
+ z = invsqrtpi*(u*ss+v*cc)/sqrt(x);
+ }
+ return z;
+ }
+ if (ix <= 0x3c900000) /* x < 2**-54 */
+ return -tpi/x;
+ z = x*x;
+ u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4])));
+ v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4]))));
+ return x*(u/v) + tpi*(j1(x)*log(x)-one/x);
+}
+
+/* For x >= 8, the asymptotic expansions of pone is
+ * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x.
+ * We approximate pone by
+ * pone(x) = 1 + (R/S)
+ * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10
+ * S = 1 + ps0*s^2 + ... + ps4*s^10
+ * and
+ * | pone(x)-1-R/S | <= 2 ** ( -60.06)
+ */
+
+static const double pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ 1.17187499999988647970e-01, /* 0x3FBDFFFF, 0xFFFFFCCE */
+ 1.32394806593073575129e+01, /* 0x402A7A9D, 0x357F7FCE */
+ 4.12051854307378562225e+02, /* 0x4079C0D4, 0x652EA590 */
+ 3.87474538913960532227e+03, /* 0x40AE457D, 0xA3A532CC */
+ 7.91447954031891731574e+03, /* 0x40BEEA7A, 0xC32782DD */
+};
+static const double ps8[5] = {
+ 1.14207370375678408436e+02, /* 0x405C8D45, 0x8E656CAC */
+ 3.65093083420853463394e+03, /* 0x40AC85DC, 0x964D274F */
+ 3.69562060269033463555e+04, /* 0x40E20B86, 0x97C5BB7F */
+ 9.76027935934950801311e+04, /* 0x40F7D42C, 0xB28F17BB */
+ 3.08042720627888811578e+04, /* 0x40DE1511, 0x697A0B2D */
+};
+
+static const double pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ 1.31990519556243522749e-11, /* 0x3DAD0667, 0xDAE1CA7D */
+ 1.17187493190614097638e-01, /* 0x3FBDFFFF, 0xE2C10043 */
+ 6.80275127868432871736e+00, /* 0x401B3604, 0x6E6315E3 */
+ 1.08308182990189109773e+02, /* 0x405B13B9, 0x452602ED */
+ 5.17636139533199752805e+02, /* 0x40802D16, 0xD052D649 */
+ 5.28715201363337541807e+02, /* 0x408085B8, 0xBB7E0CB7 */
+};
+static const double ps5[5] = {
+ 5.92805987221131331921e+01, /* 0x404DA3EA, 0xA8AF633D */
+ 9.91401418733614377743e+02, /* 0x408EFB36, 0x1B066701 */
+ 5.35326695291487976647e+03, /* 0x40B4E944, 0x5706B6FB */
+ 7.84469031749551231769e+03, /* 0x40BEA4B0, 0xB8A5BB15 */
+ 1.50404688810361062679e+03, /* 0x40978030, 0x036F5E51 */
+};
+
+static const double pr3[6] = {
+ 3.02503916137373618024e-09, /* 0x3E29FC21, 0xA7AD9EDD */
+ 1.17186865567253592491e-01, /* 0x3FBDFFF5, 0x5B21D17B */
+ 3.93297750033315640650e+00, /* 0x400F76BC, 0xE85EAD8A */
+ 3.51194035591636932736e+01, /* 0x40418F48, 0x9DA6D129 */
+ 9.10550110750781271918e+01, /* 0x4056C385, 0x4D2C1837 */
+ 4.85590685197364919645e+01, /* 0x4048478F, 0x8EA83EE5 */
+};
+static const double ps3[5] = {
+ 3.47913095001251519989e+01, /* 0x40416549, 0xA134069C */
+ 3.36762458747825746741e+02, /* 0x40750C33, 0x07F1A75F */
+ 1.04687139975775130551e+03, /* 0x40905B7C, 0x5037D523 */
+ 8.90811346398256432622e+02, /* 0x408BD67D, 0xA32E31E9 */
+ 1.03787932439639277504e+02, /* 0x4059F26D, 0x7C2EED53 */
+};
+
+static const double pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ 1.07710830106873743082e-07, /* 0x3E7CE9D4, 0xF65544F4 */
+ 1.17176219462683348094e-01, /* 0x3FBDFF42, 0xBE760D83 */
+ 2.36851496667608785174e+00, /* 0x4002F2B7, 0xF98FAEC0 */
+ 1.22426109148261232917e+01, /* 0x40287C37, 0x7F71A964 */
+ 1.76939711271687727390e+01, /* 0x4031B1A8, 0x177F8EE2 */
+ 5.07352312588818499250e+00, /* 0x40144B49, 0xA574C1FE */
+};
+static const double ps2[5] = {
+ 2.14364859363821409488e+01, /* 0x40356FBD, 0x8AD5ECDC */
+ 1.25290227168402751090e+02, /* 0x405F5293, 0x14F92CD5 */
+ 2.32276469057162813669e+02, /* 0x406D08D8, 0xD5A2DBD9 */
+ 1.17679373287147100768e+02, /* 0x405D6B7A, 0xDA1884A9 */
+ 8.36463893371618283368e+00, /* 0x4020BAB1, 0xF44E5192 */
+};
+
+static double pone(double x)
+{
+ const double *p,*q;
+ double z,r,s;
+ int32_t ix;
+
+ GET_HIGH_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x40200000){p = pr8; q = ps8;}
+ else if (ix >= 0x40122E8B){p = pr5; q = ps5;}
+ else if (ix >= 0x4006DB6D){p = pr3; q = ps3;}
+ else if (ix >= 0x40000000){p = pr2; q = ps2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4]))));
+ return one+ r/s;
+}
+
+/* For x >= 8, the asymptotic expansions of qone is
+ * 3/8 s - 105/1024 s^3 - ..., where s = 1/x.
+ * We approximate pone by
+ * qone(x) = s*(0.375 + (R/S))
+ * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10
+ * S = 1 + qs1*s^2 + ... + qs6*s^12
+ * and
+ * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13)
+ */
+
+static const double qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ -1.02539062499992714161e-01, /* 0xBFBA3FFF, 0xFFFFFDF3 */
+ -1.62717534544589987888e+01, /* 0xC0304591, 0xA26779F7 */
+ -7.59601722513950107896e+02, /* 0xC087BCD0, 0x53E4B576 */
+ -1.18498066702429587167e+04, /* 0xC0C724E7, 0x40F87415 */
+ -4.84385124285750353010e+04, /* 0xC0E7A6D0, 0x65D09C6A */
+};
+static const double qs8[6] = {
+ 1.61395369700722909556e+02, /* 0x40642CA6, 0xDE5BCDE5 */
+ 7.82538599923348465381e+03, /* 0x40BE9162, 0xD0D88419 */
+ 1.33875336287249578163e+05, /* 0x4100579A, 0xB0B75E98 */
+ 7.19657723683240939863e+05, /* 0x4125F653, 0x72869C19 */
+ 6.66601232617776375264e+05, /* 0x412457D2, 0x7719AD5C */
+ -2.94490264303834643215e+05, /* 0xC111F969, 0x0EA5AA18 */
+};
+
+static const double qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ -2.08979931141764104297e-11, /* 0xBDB6FA43, 0x1AA1A098 */
+ -1.02539050241375426231e-01, /* 0xBFBA3FFF, 0xCB597FEF */
+ -8.05644828123936029840e+00, /* 0xC0201CE6, 0xCA03AD4B */
+ -1.83669607474888380239e+02, /* 0xC066F56D, 0x6CA7B9B0 */
+ -1.37319376065508163265e+03, /* 0xC09574C6, 0x6931734F */
+ -2.61244440453215656817e+03, /* 0xC0A468E3, 0x88FDA79D */
+};
+static const double qs5[6] = {
+ 8.12765501384335777857e+01, /* 0x405451B2, 0xFF5A11B2 */
+ 1.99179873460485964642e+03, /* 0x409F1F31, 0xE77BF839 */
+ 1.74684851924908907677e+04, /* 0x40D10F1F, 0x0D64CE29 */
+ 4.98514270910352279316e+04, /* 0x40E8576D, 0xAABAD197 */
+ 2.79480751638918118260e+04, /* 0x40DB4B04, 0xCF7C364B */
+ -4.71918354795128470869e+03, /* 0xC0B26F2E, 0xFCFFA004 */
+};
+
+static const double qr3[6] = {
+ -5.07831226461766561369e-09, /* 0xBE35CFA9, 0xD38FC84F */
+ -1.02537829820837089745e-01, /* 0xBFBA3FEB, 0x51AEED54 */
+ -4.61011581139473403113e+00, /* 0xC01270C2, 0x3302D9FF */
+ -5.78472216562783643212e+01, /* 0xC04CEC71, 0xC25D16DA */
+ -2.28244540737631695038e+02, /* 0xC06C87D3, 0x4718D55F */
+ -2.19210128478909325622e+02, /* 0xC06B66B9, 0x5F5C1BF6 */
+};
+static const double qs3[6] = {
+ 4.76651550323729509273e+01, /* 0x4047D523, 0xCCD367E4 */
+ 6.73865112676699709482e+02, /* 0x40850EEB, 0xC031EE3E */
+ 3.38015286679526343505e+03, /* 0x40AA684E, 0x448E7C9A */
+ 5.54772909720722782367e+03, /* 0x40B5ABBA, 0xA61D54A6 */
+ 1.90311919338810798763e+03, /* 0x409DBC7A, 0x0DD4DF4B */
+ -1.35201191444307340817e+02, /* 0xC060E670, 0x290A311F */
+};
+
+static const double qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ -1.78381727510958865572e-07, /* 0xBE87F126, 0x44C626D2 */
+ -1.02517042607985553460e-01, /* 0xBFBA3E8E, 0x9148B010 */
+ -2.75220568278187460720e+00, /* 0xC0060484, 0x69BB4EDA */
+ -1.96636162643703720221e+01, /* 0xC033A9E2, 0xC168907F */
+ -4.23253133372830490089e+01, /* 0xC04529A3, 0xDE104AAA */
+ -2.13719211703704061733e+01, /* 0xC0355F36, 0x39CF6E52 */
+};
+static const double qs2[6] = {
+ 2.95333629060523854548e+01, /* 0x403D888A, 0x78AE64FF */
+ 2.52981549982190529136e+02, /* 0x406F9F68, 0xDB821CBA */
+ 7.57502834868645436472e+02, /* 0x4087AC05, 0xCE49A0F7 */
+ 7.39393205320467245656e+02, /* 0x40871B25, 0x48D4C029 */
+ 1.55949003336666123687e+02, /* 0x40637E5E, 0x3C3ED8D4 */
+ -4.95949898822628210127e+00, /* 0xC013D686, 0xE71BE86B */
+};
+
+static double qone(double x)
+{
+ const double *p,*q;
+ double s,r,z;
+ int32_t ix;
+
+ GET_HIGH_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x40200000){p = qr8; q = qs8;}
+ else if (ix >= 0x40122E8B){p = qr5; q = qs5;}
+ else if (ix >= 0x4006DB6D){p = qr3; q = qs3;}
+ else if (ix >= 0x40000000){p = qr2; q = qs2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5])))));
+ return (.375 + r/s)/x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_j1f.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static float ponef(float), qonef(float);
+
+static const float
+huge = 1e30,
+one = 1.0,
+invsqrtpi = 5.6418961287e-01, /* 0x3f106ebb */
+tpi = 6.3661974669e-01, /* 0x3f22f983 */
+/* R0/S0 on [0,2] */
+r00 = -6.2500000000e-02, /* 0xbd800000 */
+r01 = 1.4070566976e-03, /* 0x3ab86cfd */
+r02 = -1.5995563444e-05, /* 0xb7862e36 */
+r03 = 4.9672799207e-08, /* 0x335557d2 */
+s01 = 1.9153760746e-02, /* 0x3c9ce859 */
+s02 = 1.8594678841e-04, /* 0x3942fab6 */
+s03 = 1.1771846857e-06, /* 0x359dffc2 */
+s04 = 5.0463624390e-09, /* 0x31ad6446 */
+s05 = 1.2354227016e-11; /* 0x2d59567e */
+
+static const float zero = 0.0;
+
+float j1f(float x)
+{
+ float z,s,c,ss,cc,r,u,v,y;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7f800000)
+ return one/x;
+ y = fabsf(x);
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sinf(y);
+ c = cosf(y);
+ ss = -s-c;
+ cc = s-c;
+ if (ix < 0x7f000000) { /* make sure y+y not overflow */
+ z = cosf(y+y);
+ if (s*c > zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ /*
+ * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x)
+ * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x)
+ */
+ if (ix > 0x80000000)
+ z = (invsqrtpi*cc)/sqrtf(y);
+ else {
+ u = ponef(y);
+ v = qonef(y);
+ z = invsqrtpi*(u*cc-v*ss)/sqrtf(y);
+ }
+ if (hx < 0)
+ return -z;
+ return z;
+ }
+ if (ix < 0x32000000) { /* |x| < 2**-27 */
+ /* raise inexact if x!=0 */
+ if (huge+x > one)
+ return (float)0.5*x;
+ }
+ z = x*x;
+ r = z*(r00+z*(r01+z*(r02+z*r03)));
+ s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05))));
+ r *= x;
+ return x*(float)0.5 + r/s;
+}
+
+static const float U0[5] = {
+ -1.9605709612e-01, /* 0xbe48c331 */
+ 5.0443872809e-02, /* 0x3d4e9e3c */
+ -1.9125689287e-03, /* 0xbafaaf2a */
+ 2.3525259166e-05, /* 0x37c5581c */
+ -9.1909917899e-08, /* 0xb3c56003 */
+};
+static const float V0[5] = {
+ 1.9916731864e-02, /* 0x3ca3286a */
+ 2.0255257550e-04, /* 0x3954644b */
+ 1.3560879779e-06, /* 0x35b602d4 */
+ 6.2274145840e-09, /* 0x31d5f8eb */
+ 1.6655924903e-11, /* 0x2d9281cf */
+};
+
+float y1f(float x)
+{
+ float z,s,c,ss,cc,u,v;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = 0x7fffffff & hx;
+ /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */
+ if (ix >= 0x7f800000)
+ return one/(x+x*x);
+ if (ix == 0)
+ return -one/zero;
+ if (hx < 0)
+ return zero/zero;
+ if (ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sinf(x);
+ c = cosf(x);
+ ss = -s-c;
+ cc = s-c;
+ if (ix < 0x7f000000) { /* make sure x+x not overflow */
+ z = cosf(x+x);
+ if (s*c > zero)
+ cc = z/ss;
+ else
+ ss = z/cc;
+ }
+ /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0))
+ * where x0 = x-3pi/4
+ * Better formula:
+ * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = -1/sqrt(2) * (cos(x) + sin(x))
+ * To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.
+ */
+ if (ix > 0x48000000)
+ z = (invsqrtpi*ss)/sqrtf(x);
+ else {
+ u = ponef(x);
+ v = qonef(x);
+ z = invsqrtpi*(u*ss+v*cc)/sqrtf(x);
+ }
+ return z;
+ }
+ if (ix <= 0x24800000) /* x < 2**-54 */
+ return -tpi/x;
+ z = x*x;
+ u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4])));
+ v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4]))));
+ return x*(u/v) + tpi*(j1f(x)*logf(x)-one/x);
+}
+
+/* For x >= 8, the asymptotic expansions of pone is
+ * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x.
+ * We approximate pone by
+ * pone(x) = 1 + (R/S)
+ * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10
+ * S = 1 + ps0*s^2 + ... + ps4*s^10
+ * and
+ * | pone(x)-1-R/S | <= 2 ** ( -60.06)
+ */
+
+static const float pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.0000000000e+00, /* 0x00000000 */
+ 1.1718750000e-01, /* 0x3df00000 */
+ 1.3239480972e+01, /* 0x4153d4ea */
+ 4.1205184937e+02, /* 0x43ce06a3 */
+ 3.8747453613e+03, /* 0x45722bed */
+ 7.9144794922e+03, /* 0x45f753d6 */
+};
+static const float ps8[5] = {
+ 1.1420736694e+02, /* 0x42e46a2c */
+ 3.6509309082e+03, /* 0x45642ee5 */
+ 3.6956207031e+04, /* 0x47105c35 */
+ 9.7602796875e+04, /* 0x47bea166 */
+ 3.0804271484e+04, /* 0x46f0a88b */
+};
+
+static const float pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ 1.3199052094e-11, /* 0x2d68333f */
+ 1.1718749255e-01, /* 0x3defffff */
+ 6.8027510643e+00, /* 0x40d9b023 */
+ 1.0830818176e+02, /* 0x42d89dca */
+ 5.1763616943e+02, /* 0x440168b7 */
+ 5.2871520996e+02, /* 0x44042dc6 */
+};
+static const float ps5[5] = {
+ 5.9280597687e+01, /* 0x426d1f55 */
+ 9.9140142822e+02, /* 0x4477d9b1 */
+ 5.3532670898e+03, /* 0x45a74a23 */
+ 7.8446904297e+03, /* 0x45f52586 */
+ 1.5040468750e+03, /* 0x44bc0180 */
+};
+
+static const float pr3[6] = {
+ 3.0250391081e-09, /* 0x314fe10d */
+ 1.1718686670e-01, /* 0x3defffab */
+ 3.9329774380e+00, /* 0x407bb5e7 */
+ 3.5119403839e+01, /* 0x420c7a45 */
+ 9.1055007935e+01, /* 0x42b61c2a */
+ 4.8559066772e+01, /* 0x42423c7c */
+};
+static const float ps3[5] = {
+ 3.4791309357e+01, /* 0x420b2a4d */
+ 3.3676245117e+02, /* 0x43a86198 */
+ 1.0468714600e+03, /* 0x4482dbe3 */
+ 8.9081134033e+02, /* 0x445eb3ed */
+ 1.0378793335e+02, /* 0x42cf936c */
+};
+
+static const float pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ 1.0771083225e-07, /* 0x33e74ea8 */
+ 1.1717621982e-01, /* 0x3deffa16 */
+ 2.3685150146e+00, /* 0x401795c0 */
+ 1.2242610931e+01, /* 0x4143e1bc */
+ 1.7693971634e+01, /* 0x418d8d41 */
+ 5.0735230446e+00, /* 0x40a25a4d */
+};
+static const float ps2[5] = {
+ 2.1436485291e+01, /* 0x41ab7dec */
+ 1.2529022980e+02, /* 0x42fa9499 */
+ 2.3227647400e+02, /* 0x436846c7 */
+ 1.1767937469e+02, /* 0x42eb5bd7 */
+ 8.3646392822e+00, /* 0x4105d590 */
+};
+
+static float ponef(float x)
+{
+ const float *p,*q;
+ float z,r,s;
+ int32_t ix;
+
+ GET_FLOAT_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x41000000){p = pr8; q = ps8;}
+ else if (ix >= 0x40f71c58){p = pr5; q = ps5;}
+ else if (ix >= 0x4036db68){p = pr3; q = ps3;}
+ else if (ix >= 0x40000000){p = pr2; q = ps2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4]))));
+ return one + r/s;
+}
+
+/* For x >= 8, the asymptotic expansions of qone is
+ * 3/8 s - 105/1024 s^3 - ..., where s = 1/x.
+ * We approximate pone by
+ * qone(x) = s*(0.375 + (R/S))
+ * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10
+ * S = 1 + qs1*s^2 + ... + qs6*s^12
+ * and
+ * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13)
+ */
+
+static const float qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.0000000000e+00, /* 0x00000000 */
+ -1.0253906250e-01, /* 0xbdd20000 */
+ -1.6271753311e+01, /* 0xc1822c8d */
+ -7.5960174561e+02, /* 0xc43de683 */
+ -1.1849806641e+04, /* 0xc639273a */
+ -4.8438511719e+04, /* 0xc73d3683 */
+};
+static const float qs8[6] = {
+ 1.6139537048e+02, /* 0x43216537 */
+ 7.8253862305e+03, /* 0x45f48b17 */
+ 1.3387534375e+05, /* 0x4802bcd6 */
+ 7.1965775000e+05, /* 0x492fb29c */
+ 6.6660125000e+05, /* 0x4922be94 */
+ -2.9449025000e+05, /* 0xc88fcb48 */
+};
+
+static const float qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ -2.0897993405e-11, /* 0xadb7d219 */
+ -1.0253904760e-01, /* 0xbdd1fffe */
+ -8.0564479828e+00, /* 0xc100e736 */
+ -1.8366960144e+02, /* 0xc337ab6b */
+ -1.3731937256e+03, /* 0xc4aba633 */
+ -2.6124443359e+03, /* 0xc523471c */
+};
+static const float qs5[6] = {
+ 8.1276550293e+01, /* 0x42a28d98 */
+ 1.9917987061e+03, /* 0x44f8f98f */
+ 1.7468484375e+04, /* 0x468878f8 */
+ 4.9851425781e+04, /* 0x4742bb6d */
+ 2.7948074219e+04, /* 0x46da5826 */
+ -4.7191835938e+03, /* 0xc5937978 */
+};
+
+static const float qr3[6] = {
+ -5.0783124372e-09, /* 0xb1ae7d4f */
+ -1.0253783315e-01, /* 0xbdd1ff5b */
+ -4.6101160049e+00, /* 0xc0938612 */
+ -5.7847221375e+01, /* 0xc267638e */
+ -2.2824453735e+02, /* 0xc3643e9a */
+ -2.1921012878e+02, /* 0xc35b35cb */
+};
+static const float qs3[6] = {
+ 4.7665153503e+01, /* 0x423ea91e */
+ 6.7386511230e+02, /* 0x4428775e */
+ 3.3801528320e+03, /* 0x45534272 */
+ 5.5477290039e+03, /* 0x45ad5dd5 */
+ 1.9031191406e+03, /* 0x44ede3d0 */
+ -1.3520118713e+02, /* 0xc3073381 */
+};
+
+static const float qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ -1.7838172539e-07, /* 0xb43f8932 */
+ -1.0251704603e-01, /* 0xbdd1f475 */
+ -2.7522056103e+00, /* 0xc0302423 */
+ -1.9663616180e+01, /* 0xc19d4f16 */
+ -4.2325313568e+01, /* 0xc2294d1f */
+ -2.1371921539e+01, /* 0xc1aaf9b2 */
+};
+static const float qs2[6] = {
+ 2.9533363342e+01, /* 0x41ec4454 */
+ 2.5298155212e+02, /* 0x437cfb47 */
+ 7.5750280762e+02, /* 0x443d602e */
+ 7.3939318848e+02, /* 0x4438d92a */
+ 1.5594900513e+02, /* 0x431bf2f2 */
+ -4.9594988823e+00, /* 0xc09eb437 */
+};
+
+static float qonef(float x)
+{
+ const float *p,*q;
+ float s,r,z;
+ int32_t ix;
+
+ GET_FLOAT_WORD(ix, x);
+ ix &= 0x7fffffff;
+ if (ix >= 0x40200000){p = qr8; q = qs8;}
+ else if (ix >= 0x40f71c58){p = qr5; q = qs5;}
+ else if (ix >= 0x4036db68){p = qr3; q = qs3;}
+ else if (ix >= 0x40000000){p = qr2; q = qs2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5])))));
+ return ((float).375 + r/s)/x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_jn.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * jn(n, x), yn(n, x)
+ * floating point Bessel's function of the 1st and 2nd kind
+ * of order n
+ *
+ * Special cases:
+ * y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal;
+ * y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal.
+ * Note 2. About jn(n,x), yn(n,x)
+ * For n=0, j0(x) is called,
+ * for n=1, j1(x) is called,
+ * for n<x, forward recursion us used starting
+ * from values of j0(x) and j1(x).
+ * for n>x, a continued fraction approximation to
+ * j(n,x)/j(n-1,x) is evaluated and then backward
+ * recursion is used starting from a supposed value
+ * for j(n,x). The resulting value of j(0,x) is
+ * compared with the actual value to correct the
+ * supposed value of j(n,x).
+ *
+ * yn(n,x) is similar in all respects, except
+ * that forward recursion is used for all
+ * values of n>1.
+ *
+ */
+
+#include "libm.h"
+
+static const double
+invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
+two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
+one = 1.00000000000000000000e+00; /* 0x3FF00000, 0x00000000 */
+
+static const double zero = 0.00000000000000000000e+00;
+
+double jn(int n, double x)
+{
+ int32_t i,hx,ix,lx,sgn;
+ double a, b, temp, di;
+ double z, w;
+
+ /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x)
+ * Thus, J(-n,x) = J(n,-x)
+ */
+ EXTRACT_WORDS(hx, lx, x);
+ ix = 0x7fffffff & hx;
+ /* if J(n,NaN) is NaN */
+ if ((ix|((uint32_t)(lx|-lx))>>31) > 0x7ff00000)
+ return x+x;
+ if (n < 0) {
+ n = -n;
+ x = -x;
+ hx ^= 0x80000000;
+ }
+ if (n == 0) return j0(x);
+ if (n == 1) return j1(x);
+
+ sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */
+ x = fabs(x);
+ if ((ix|lx) == 0 || ix >= 0x7ff00000) /* if x is 0 or inf */
+ b = zero;
+ else if ((double)n <= x) {
+ /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */
+ if (ix >= 0x52D00000) { /* x > 2**302 */
+ /* (x >> n**2)
+ * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Let s=sin(x), c=cos(x),
+ * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then
+ *
+ * n sin(xn)*sqt2 cos(xn)*sqt2
+ * ----------------------------------
+ * 0 s-c c+s
+ * 1 -s-c -c+s
+ * 2 -s+c -c-s
+ * 3 s+c c-s
+ */
+ switch(n&3) {
+ case 0: temp = cos(x)+sin(x); break;
+ case 1: temp = -cos(x)+sin(x); break;
+ case 2: temp = -cos(x)-sin(x); break;
+ case 3: temp = cos(x)-sin(x); break;
+ }
+ b = invsqrtpi*temp/sqrt(x);
+ } else {
+ a = j0(x);
+ b = j1(x);
+ for (i=1; i<n; i++){
+ temp = b;
+ b = b*((double)(i+i)/x) - a; /* avoid underflow */
+ a = temp;
+ }
+ }
+ } else {
+ if (ix < 0x3e100000) { /* x < 2**-29 */
+ /* x is tiny, return the first Taylor expansion of J(n,x)
+ * J(n,x) = 1/n!*(x/2)^n - ...
+ */
+ if (n > 33) /* underflow */
+ b = zero;
+ else {
+ temp = x*0.5;
+ b = temp;
+ for (a=one,i=2; i<=n; i++) {
+ a *= (double)i; /* a = n! */
+ b *= temp; /* b = (x/2)^n */
+ }
+ b = b/a;
+ }
+ } else {
+ /* use backward recurrence */
+ /* x x^2 x^2
+ * J(n,x)/J(n-1,x) = ---- ------ ------ .....
+ * 2n - 2(n+1) - 2(n+2)
+ *
+ * 1 1 1
+ * (for large x) = ---- ------ ------ .....
+ * 2n 2(n+1) 2(n+2)
+ * -- - ------ - ------ -
+ * x x x
+ *
+ * Let w = 2n/x and h=2/x, then the above quotient
+ * is equal to the continued fraction:
+ * 1
+ * = -----------------------
+ * 1
+ * w - -----------------
+ * 1
+ * w+h - ---------
+ * w+2h - ...
+ *
+ * To determine how many terms needed, let
+ * Q(0) = w, Q(1) = w(w+h) - 1,
+ * Q(k) = (w+k*h)*Q(k-1) - Q(k-2),
+ * When Q(k) > 1e4 good for single
+ * When Q(k) > 1e9 good for double
+ * When Q(k) > 1e17 good for quadruple
+ */
+ /* determine k */
+ double t,v;
+ double q0,q1,h,tmp;
+ int32_t k,m;
+
+ w = (n+n)/(double)x; h = 2.0/(double)x;
+ q0 = w;
+ z = w+h;
+ q1 = w*z - 1.0;
+ k = 1;
+ while (q1 < 1.0e9) {
+ k += 1;
+ z += h;
+ tmp = z*q1 - q0;
+ q0 = q1;
+ q1 = tmp;
+ }
+ m = n+n;
+ for (t=zero, i = 2*(n+k); i>=m; i -= 2)
+ t = one/(i/x-t);
+ a = t;
+ b = one;
+ /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n)
+ * Hence, if n*(log(2n/x)) > ...
+ * single 8.8722839355e+01
+ * double 7.09782712893383973096e+02
+ * long double 1.1356523406294143949491931077970765006170e+04
+ * then recurrent value may overflow and the result is
+ * likely underflow to zero
+ */
+ tmp = n;
+ v = two/x;
+ tmp = tmp*log(fabs(v*tmp));
+ if (tmp < 7.09782712893383973096e+02) {
+ for (i=n-1,di=(double)(i+i); i>0; i--) {
+ temp = b;
+ b *= di;
+ b = b/x - a;
+ a = temp;
+ di -= two;
+ }
+ } else {
+ for (i=n-1,di=(double)(i+i); i>0; i--) {
+ temp = b;
+ b *= di;
+ b = b/x - a;
+ a = temp;
+ di -= two;
+ /* scale b to avoid spurious overflow */
+ if (b > 1e100) {
+ a /= b;
+ t /= b;
+ b = one;
+ }
+ }
+ }
+ z = j0(x);
+ w = j1(x);
+ if (fabs(z) >= fabs(w))
+ b = t*z/b;
+ else
+ b = t*w/a;
+ }
+ }
+ if (sgn==1) return -b;
+ return b;
+}
+
+
+
+double yn(int n, double x)
+{
+ int32_t i,hx,ix,lx;
+ int32_t sign;
+ double a, b, temp;
+
+ EXTRACT_WORDS(hx, lx, x);
+ ix = 0x7fffffff & hx;
+ /* if Y(n,NaN) is NaN */
+ if ((ix|((uint32_t)(lx|-lx))>>31) > 0x7ff00000)
+ return x+x;
+ if ((ix|lx) == 0)
+ return -one/zero;
+ if (hx < 0)
+ return zero/zero;
+ sign = 1;
+ if (n < 0) {
+ n = -n;
+ sign = 1 - ((n&1)<<1);
+ }
+ if (n == 0)
+ return y0(x);
+ if (n == 1)
+ return sign*y1(x);
+ if (ix == 0x7ff00000)
+ return zero;
+ if (ix >= 0x52D00000) { /* x > 2**302 */
+ /* (x >> n**2)
+ * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Let s=sin(x), c=cos(x),
+ * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then
+ *
+ * n sin(xn)*sqt2 cos(xn)*sqt2
+ * ----------------------------------
+ * 0 s-c c+s
+ * 1 -s-c -c+s
+ * 2 -s+c -c-s
+ * 3 s+c c-s
+ */
+ switch(n&3) {
+ case 0: temp = sin(x)-cos(x); break;
+ case 1: temp = -sin(x)-cos(x); break;
+ case 2: temp = -sin(x)+cos(x); break;
+ case 3: temp = sin(x)+cos(x); break;
+ }
+ b = invsqrtpi*temp/sqrt(x);
+ } else {
+ uint32_t high;
+ a = y0(x);
+ b = y1(x);
+ /* quit if b is -inf */
+ GET_HIGH_WORD(high, b);
+ for (i=1; i<n && high!=0xfff00000; i++){
+ temp = b;
+ b = ((double)(i+i)/x)*b - a;
+ GET_HIGH_WORD(high, b);
+ a = temp;
+ }
+ }
+ if (sign > 0) return b;
+ return -b;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_jnf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+two = 2.0000000000e+00, /* 0x40000000 */
+one = 1.0000000000e+00; /* 0x3F800000 */
+
+static const float zero = 0.0000000000e+00;
+
+float jnf(int n, float x)
+{
+ int32_t i,hx,ix, sgn;
+ float a, b, temp, di;
+ float z, w;
+
+ /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x)
+ * Thus, J(-n,x) = J(n,-x)
+ */
+ GET_FLOAT_WORD(hx, x);
+ ix = 0x7fffffff & hx;
+ /* if J(n,NaN) is NaN */
+ if (ix > 0x7f800000)
+ return x+x;
+ if (n < 0) {
+ n = -n;
+ x = -x;
+ hx ^= 0x80000000;
+ }
+ if (n == 0) return j0f(x);
+ if (n == 1) return j1f(x);
+
+ sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */
+ x = fabsf(x);
+ if (ix == 0 || ix >= 0x7f800000) /* if x is 0 or inf */
+ b = zero;
+ else if((float)n <= x) {
+ /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */
+ a = j0f(x);
+ b = j1f(x);
+ for (i=1; i<n; i++){
+ temp = b;
+ b = b*((float)(i+i)/x) - a; /* avoid underflow */
+ a = temp;
+ }
+ } else {
+ if (ix < 0x30800000) { /* x < 2**-29 */
+ /* x is tiny, return the first Taylor expansion of J(n,x)
+ * J(n,x) = 1/n!*(x/2)^n - ...
+ */
+ if (n > 33) /* underflow */
+ b = zero;
+ else {
+ temp = x*(float)0.5;
+ b = temp;
+ for (a=one,i=2; i<=n; i++) {
+ a *= (float)i; /* a = n! */
+ b *= temp; /* b = (x/2)^n */
+ }
+ b = b/a;
+ }
+ } else {
+ /* use backward recurrence */
+ /* x x^2 x^2
+ * J(n,x)/J(n-1,x) = ---- ------ ------ .....
+ * 2n - 2(n+1) - 2(n+2)
+ *
+ * 1 1 1
+ * (for large x) = ---- ------ ------ .....
+ * 2n 2(n+1) 2(n+2)
+ * -- - ------ - ------ -
+ * x x x
+ *
+ * Let w = 2n/x and h=2/x, then the above quotient
+ * is equal to the continued fraction:
+ * 1
+ * = -----------------------
+ * 1
+ * w - -----------------
+ * 1
+ * w+h - ---------
+ * w+2h - ...
+ *
+ * To determine how many terms needed, let
+ * Q(0) = w, Q(1) = w(w+h) - 1,
+ * Q(k) = (w+k*h)*Q(k-1) - Q(k-2),
+ * When Q(k) > 1e4 good for single
+ * When Q(k) > 1e9 good for double
+ * When Q(k) > 1e17 good for quadruple
+ */
+ /* determine k */
+ float t,v;
+ float q0,q1,h,tmp;
+ int32_t k,m;
+
+ w = (n+n)/(float)x;
+ h = (float)2.0/(float)x;
+ z = w+h;
+ q0 = w;
+ q1 = w*z - (float)1.0;
+ k = 1;
+ while (q1 < (float)1.0e9) {
+ k += 1;
+ z += h;
+ tmp = z*q1 - q0;
+ q0 = q1;
+ q1 = tmp;
+ }
+ m = n+n;
+ for (t=zero, i = 2*(n+k); i>=m; i -= 2)
+ t = one/(i/x-t);
+ a = t;
+ b = one;
+ /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n)
+ * Hence, if n*(log(2n/x)) > ...
+ * single 8.8722839355e+01
+ * double 7.09782712893383973096e+02
+ * long double 1.1356523406294143949491931077970765006170e+04
+ * then recurrent value may overflow and the result is
+ * likely underflow to zero
+ */
+ tmp = n;
+ v = two/x;
+ tmp = tmp*logf(fabsf(v*tmp));
+ if (tmp < (float)8.8721679688e+01) {
+ for (i=n-1,di=(float)(i+i); i>0; i--) {
+ temp = b;
+ b *= di;
+ b = b/x - a;
+ a = temp;
+ di -= two;
+ }
+ } else {
+ for (i=n-1,di=(float)(i+i); i>0; i--){
+ temp = b;
+ b *= di;
+ b = b/x - a;
+ a = temp;
+ di -= two;
+ /* scale b to avoid spurious overflow */
+ if (b > (float)1e10) {
+ a /= b;
+ t /= b;
+ b = one;
+ }
+ }
+ }
+ z = j0f(x);
+ w = j1f(x);
+ if (fabsf(z) >= fabsf(w))
+ b = t*z/b;
+ else
+ b = t*w/a;
+ }
+ }
+ if (sgn == 1) return -b;
+ return b;
+}
+
+float ynf(int n, float x)
+{
+ int32_t i,hx,ix,ib;
+ int32_t sign;
+ float a, b, temp;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = 0x7fffffff & hx;
+ /* if Y(n,NaN) is NaN */
+ if (ix > 0x7f800000)
+ return x+x;
+ if (ix == 0)
+ return -one/zero;
+ if (hx < 0)
+ return zero/zero;
+ sign = 1;
+ if (n < 0) {
+ n = -n;
+ sign = 1 - ((n&1)<<1);
+ }
+ if (n == 0)
+ return y0f(x);
+ if (n == 1)
+ return sign*y1f(x);
+ if (ix == 0x7f800000)
+ return zero;
+
+ a = y0f(x);
+ b = y1f(x);
+ /* quit if b is -inf */
+ GET_FLOAT_WORD(ib,b);
+ for (i = 1; i < n && ib != 0xff800000; i++){
+ temp = b;
+ b = ((float)(i+i)/x)*b - a;
+ GET_FLOAT_WORD(ib, b);
+ a = temp;
+ }
+ if (sign > 0)
+ return b;
+ return -b;
+}
+++ /dev/null
-
-/* @(#)k_cos.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * __kernel_cos( x, y )
- * kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164
- * Input x is assumed to be bounded by ~pi/4 in magnitude.
- * Input y is the tail of x.
- *
- * Algorithm
- * 1. Since cos(-x) = cos(x), we need only to consider positive x.
- * 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0.
- * 3. cos(x) is approximated by a polynomial of degree 14 on
- * [0,pi/4]
- * 4 14
- * cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x
- * where the remez error is
- *
- * | 2 4 6 8 10 12 14 | -58
- * |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2
- * | |
- *
- * 4 6 8 10 12 14
- * 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then
- * cos(x) = 1 - x*x/2 + r
- * since cos(x+y) ~ cos(x) - sin(x)*y
- * ~ cos(x) - x*y,
- * a correction term is necessary in cos(x) and hence
- * cos(x+y) = 1 - (x*x/2 - (r - x*y))
- * For better accuracy when x > 0.3, let qx = |x|/4 with
- * the last 32 bits mask off, and if x > 0.78125, let qx = 0.28125.
- * Then
- * cos(x+y) = (1-qx) - ((x*x/2-qx) - (r-x*y)).
- * Note that 1-qx and (x*x/2-qx) is EXACT here, and the
- * magnitude of the latter is at least a quarter of x*x/2,
- * thus, reducing the rounding error in the subtraction.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
-C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */
-C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */
-C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */
-C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */
-C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */
-C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */
-
-double
-__kernel_cos(double x, double y)
-{
- double a,hz,z,r,qx;
- int32_t ix;
- GET_HIGH_WORD(ix,x);
- ix &= 0x7fffffff; /* ix = |x|'s high word*/
- if(ix<0x3e400000) { /* if x < 2**27 */
- if(((int)x)==0) return one; /* generate inexact */
- }
- z = x*x;
- r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6)))));
- if(ix < 0x3FD33333) /* if |x| < 0.3 */
- return one - (0.5*z - (z*r - x*y));
- else {
- if(ix > 0x3fe90000) { /* x > 0.78125 */
- qx = 0.28125;
- } else {
- INSERT_WORDS(qx,ix-0x00200000,0); /* x/4 */
- }
- hz = 0.5*z-qx;
- a = one-qx;
- return a - (hz - (z*r-x*y));
- }
-}
+++ /dev/null
-/* k_cosf.c -- float version of k_cos.c
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0000000000e+00, /* 0x3f800000 */
-C1 = 4.1666667908e-02, /* 0x3d2aaaab */
-C2 = -1.3888889225e-03, /* 0xbab60b61 */
-C3 = 2.4801587642e-05, /* 0x37d00d01 */
-C4 = -2.7557314297e-07, /* 0xb493f27c */
-C5 = 2.0875723372e-09, /* 0x310f74f6 */
-C6 = -1.1359647598e-11; /* 0xad47d74e */
-
-float
-__kernel_cosf(float x, float y)
-{
- float a,hz,z,r,qx;
- int32_t ix;
- GET_FLOAT_WORD(ix,x);
- ix &= 0x7fffffff; /* ix = |x|'s high word*/
- if(ix<0x32000000) { /* if x < 2**27 */
- if(((int)x)==0) return one; /* generate inexact */
- }
- z = x*x;
- r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6)))));
- if(ix < 0x3e99999a) /* if |x| < 0.3 */
- return one - ((float)0.5*z - (z*r - x*y));
- else {
- if(ix > 0x3f480000) { /* x > 0.78125 */
- qx = (float)0.28125;
- } else {
- SET_FLOAT_WORD(qx,ix-0x01000000); /* x/4 */
- }
- hz = (float)0.5*z-qx;
- a = one-qx;
- return a - (hz - (z*r-x*y));
- }
-}
+++ /dev/null
-
-/* @(#)k_rem_pio2.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * __kernel_rem_pio2(x,y,e0,nx,prec,ipio2)
- * double x[],y[]; int e0,nx,prec; int ipio2[];
- *
- * __kernel_rem_pio2 return the last three digits of N with
- * y = x - N*pi/2
- * so that |y| < pi/2.
- *
- * The method is to compute the integer (mod 8) and fraction parts of
- * (2/pi)*x without doing the full multiplication. In general we
- * skip the part of the product that are known to be a huge integer (
- * more accurately, = 0 mod 8 ). Thus the number of operations are
- * independent of the exponent of the input.
- *
- * (2/pi) is represented by an array of 24-bit integers in ipio2[].
- *
- * Input parameters:
- * x[] The input value (must be positive) is broken into nx
- * pieces of 24-bit integers in double precision format.
- * x[i] will be the i-th 24 bit of x. The scaled exponent
- * of x[0] is given in input parameter e0 (i.e., x[0]*2^e0
- * match x's up to 24 bits.
- *
- * Example of breaking a double positive z into x[0]+x[1]+x[2]:
- * e0 = ilogb(z)-23
- * z = scalbn(z,-e0)
- * for i = 0,1,2
- * x[i] = floor(z)
- * z = (z-x[i])*2**24
- *
- *
- * y[] ouput result in an array of double precision numbers.
- * The dimension of y[] is:
- * 24-bit precision 1
- * 53-bit precision 2
- * 64-bit precision 2
- * 113-bit precision 3
- * The actual value is the sum of them. Thus for 113-bit
- * precison, one may have to do something like:
- *
- * long double t,w,r_head, r_tail;
- * t = (long double)y[2] + (long double)y[1];
- * w = (long double)y[0];
- * r_head = t+w;
- * r_tail = w - (r_head - t);
- *
- * e0 The exponent of x[0]
- *
- * nx dimension of x[]
- *
- * prec an integer indicating the precision:
- * 0 24 bits (single)
- * 1 53 bits (double)
- * 2 64 bits (extended)
- * 3 113 bits (quad)
- *
- * ipio2[]
- * integer array, contains the (24*i)-th to (24*i+23)-th
- * bit of 2/pi after binary point. The corresponding
- * floating value is
- *
- * ipio2[i] * 2^(-24(i+1)).
- *
- * External function:
- * double scalbn(), floor();
- *
- *
- * Here is the description of some local variables:
- *
- * jk jk+1 is the initial number of terms of ipio2[] needed
- * in the computation. The recommended value is 2,3,4,
- * 6 for single, double, extended,and quad.
- *
- * jz local integer variable indicating the number of
- * terms of ipio2[] used.
- *
- * jx nx - 1
- *
- * jv index for pointing to the suitable ipio2[] for the
- * computation. In general, we want
- * ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8
- * is an integer. Thus
- * e0-3-24*jv >= 0 or (e0-3)/24 >= jv
- * Hence jv = max(0,(e0-3)/24).
- *
- * jp jp+1 is the number of terms in PIo2[] needed, jp = jk.
- *
- * q[] double array with integral value, representing the
- * 24-bits chunk of the product of x and 2/pi.
- *
- * q0 the corresponding exponent of q[0]. Note that the
- * exponent for q[i] would be q0-24*i.
- *
- * PIo2[] double precision array, obtained by cutting pi/2
- * into 24 bits chunks.
- *
- * f[] ipio2[] in floating point
- *
- * iq[] integer array by breaking up q[] in 24-bits chunk.
- *
- * fq[] final product of x*(2/pi) in fq[0],..,fq[jk]
- *
- * ih integer. If >0 it indicates q[] is >= 0.5, hence
- * it also indicates the *sign* of the result.
- *
- */
-
-
-/*
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const int init_jk[] = {2,3,4,6}; /* initial value for jk */
-
-static const double PIo2[] = {
- 1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */
- 7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */
- 5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */
- 3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */
- 1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */
- 1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */
- 2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */
- 2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */
-};
-
-static const double
-zero = 0.0,
-one = 1.0,
-two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
-twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */
-
- int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec, const int32_t *ipio2)
-{
- int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih;
- double z,fw,f[20],fq[20],q[20];
-
- /* initialize jk*/
- jk = init_jk[prec];
- jp = jk;
-
- /* determine jx,jv,q0, note that 3>q0 */
- jx = nx-1;
- jv = (e0-3)/24; if(jv<0) jv=0;
- q0 = e0-24*(jv+1);
-
- /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
- j = jv-jx; m = jx+jk;
- for(i=0;i<=m;i++,j++) f[i] = (j<0)? zero : (double) ipio2[j];
-
- /* compute q[0],q[1],...q[jk] */
- for (i=0;i<=jk;i++) {
- for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw;
- }
-
- jz = jk;
-recompute:
- /* distill q[] into iq[] reversingly */
- for(i=0,j=jz,z=q[jz];j>0;i++,j--) {
- fw = (double)((int32_t)(twon24* z));
- iq[i] = (int32_t)(z-two24*fw);
- z = q[j-1]+fw;
- }
-
- /* compute n */
- z = scalbn(z,q0); /* actual value of z */
- z -= 8.0*floor(z*0.125); /* trim off integer >= 8 */
- n = (int32_t) z;
- z -= (double)n;
- ih = 0;
- if(q0>0) { /* need iq[jz-1] to determine n */
- i = (iq[jz-1]>>(24-q0)); n += i;
- iq[jz-1] -= i<<(24-q0);
- ih = iq[jz-1]>>(23-q0);
- }
- else if(q0==0) ih = iq[jz-1]>>23;
- else if(z>=0.5) ih=2;
-
- if(ih>0) { /* q > 0.5 */
- n += 1; carry = 0;
- for(i=0;i<jz ;i++) { /* compute 1-q */
- j = iq[i];
- if(carry==0) {
- if(j!=0) {
- carry = 1; iq[i] = 0x1000000- j;
- }
- } else iq[i] = 0xffffff - j;
- }
- if(q0>0) { /* rare case: chance is 1 in 12 */
- switch(q0) {
- case 1:
- iq[jz-1] &= 0x7fffff; break;
- case 2:
- iq[jz-1] &= 0x3fffff; break;
- }
- }
- if(ih==2) {
- z = one - z;
- if(carry!=0) z -= scalbn(one,q0);
- }
- }
-
- /* check if recomputation is needed */
- if(z==zero) {
- j = 0;
- for (i=jz-1;i>=jk;i--) j |= iq[i];
- if(j==0) { /* need recomputation */
- for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */
-
- for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */
- f[jx+i] = (double) ipio2[jv+i];
- for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j];
- q[i] = fw;
- }
- jz += k;
- goto recompute;
- }
- }
-
- /* chop off zero terms */
- if(z==0.0) {
- jz -= 1; q0 -= 24;
- while(iq[jz]==0) { jz--; q0-=24;}
- } else { /* break z into 24-bit if necessary */
- z = scalbn(z,-q0);
- if(z>=two24) {
- fw = (double)((int32_t)(twon24*z));
- iq[jz] = (int32_t)(z-two24*fw);
- jz += 1; q0 += 24;
- iq[jz] = (int32_t) fw;
- } else iq[jz] = (int32_t) z ;
- }
-
- /* convert integer "bit" chunk to floating-point value */
- fw = scalbn(one,q0);
- for(i=jz;i>=0;i--) {
- q[i] = fw*(double)iq[i]; fw*=twon24;
- }
-
- /* compute PIo2[0,...,jp]*q[jz,...,0] */
- for(i=jz;i>=0;i--) {
- for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k];
- fq[jz-i] = fw;
- }
-
- /* compress fq[] into y[] */
- switch(prec) {
- case 0:
- fw = 0.0;
- for (i=jz;i>=0;i--) fw += fq[i];
- y[0] = (ih==0)? fw: -fw;
- break;
- case 1:
- case 2:
- fw = 0.0;
- for (i=jz;i>=0;i--) fw += fq[i];
- y[0] = (ih==0)? fw: -fw;
- fw = fq[0]-fw;
- for (i=1;i<=jz;i++) fw += fq[i];
- y[1] = (ih==0)? fw: -fw;
- break;
- case 3: /* painful */
- for (i=jz;i>0;i--) {
- fw = fq[i-1]+fq[i];
- fq[i] += fq[i-1]-fw;
- fq[i-1] = fw;
- }
- for (i=jz;i>1;i--) {
- fw = fq[i-1]+fq[i];
- fq[i] += fq[i-1]-fw;
- fq[i-1] = fw;
- }
- for (fw=0.0,i=jz;i>=2;i--) fw += fq[i];
- if(ih==0) {
- y[0] = fq[0]; y[1] = fq[1]; y[2] = fw;
- } else {
- y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw;
- }
- }
- return n&7;
-}
+++ /dev/null
-/* k_rem_pio2f.c -- float version of k_rem_pio2.c
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-/* In the float version, the input parameter x contains 8 bit
- integers, not 24 bit integers. 113 bit precision is not supported. */
-
-static const int init_jk[] = {4,7,9}; /* initial value for jk */
-
-static const float PIo2[] = {
- 1.5703125000e+00, /* 0x3fc90000 */
- 4.5776367188e-04, /* 0x39f00000 */
- 2.5987625122e-05, /* 0x37da0000 */
- 7.5437128544e-08, /* 0x33a20000 */
- 6.0026650317e-11, /* 0x2e840000 */
- 7.3896444519e-13, /* 0x2b500000 */
- 5.3845816694e-15, /* 0x27c20000 */
- 5.6378512969e-18, /* 0x22d00000 */
- 8.3009228831e-20, /* 0x1fc40000 */
- 3.2756352257e-22, /* 0x1bc60000 */
- 6.3331015649e-25, /* 0x17440000 */
-};
-
-static const float
-zero = 0.0,
-one = 1.0,
-two8 = 2.5600000000e+02, /* 0x43800000 */
-twon8 = 3.9062500000e-03; /* 0x3b800000 */
-
- int __kernel_rem_pio2f(float *x, float *y, int e0, int nx, int prec, const int32_t *ipio2)
-{
- int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih;
- float z,fw,f[20],fq[20],q[20];
-
- /* initialize jk*/
- jk = init_jk[prec];
- jp = jk;
-
- /* determine jx,jv,q0, note that 3>q0 */
- jx = nx-1;
- jv = (e0-3)/8; if(jv<0) jv=0;
- q0 = e0-8*(jv+1);
-
- /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
- j = jv-jx; m = jx+jk;
- for(i=0;i<=m;i++,j++) f[i] = (j<0)? zero : (float) ipio2[j];
-
- /* compute q[0],q[1],...q[jk] */
- for (i=0;i<=jk;i++) {
- for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw;
- }
-
- jz = jk;
-recompute:
- /* distill q[] into iq[] reversingly */
- for(i=0,j=jz,z=q[jz];j>0;i++,j--) {
- fw = (float)((int32_t)(twon8* z));
- iq[i] = (int32_t)(z-two8*fw);
- z = q[j-1]+fw;
- }
-
- /* compute n */
- z = scalbnf(z,q0); /* actual value of z */
- z -= (float)8.0*floorf(z*(float)0.125); /* trim off integer >= 8 */
- n = (int32_t) z;
- z -= (float)n;
- ih = 0;
- if(q0>0) { /* need iq[jz-1] to determine n */
- i = (iq[jz-1]>>(8-q0)); n += i;
- iq[jz-1] -= i<<(8-q0);
- ih = iq[jz-1]>>(7-q0);
- }
- else if(q0==0) ih = iq[jz-1]>>7;
- else if(z>=(float)0.5) ih=2;
-
- if(ih>0) { /* q > 0.5 */
- n += 1; carry = 0;
- for(i=0;i<jz ;i++) { /* compute 1-q */
- j = iq[i];
- if(carry==0) {
- if(j!=0) {
- carry = 1; iq[i] = 0x100- j;
- }
- } else iq[i] = 0xff - j;
- }
- if(q0>0) { /* rare case: chance is 1 in 12 */
- switch(q0) {
- case 1:
- iq[jz-1] &= 0x7f; break;
- case 2:
- iq[jz-1] &= 0x3f; break;
- }
- }
- if(ih==2) {
- z = one - z;
- if(carry!=0) z -= scalbnf(one,q0);
- }
- }
-
- /* check if recomputation is needed */
- if(z==zero) {
- j = 0;
- for (i=jz-1;i>=jk;i--) j |= iq[i];
- if(j==0) { /* need recomputation */
- for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */
-
- for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */
- f[jx+i] = (float) ipio2[jv+i];
- for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j];
- q[i] = fw;
- }
- jz += k;
- goto recompute;
- }
- }
-
- /* chop off zero terms */
- if(z==(float)0.0) {
- jz -= 1; q0 -= 8;
- while(iq[jz]==0) { jz--; q0-=8;}
- } else { /* break z into 8-bit if necessary */
- z = scalbnf(z,-q0);
- if(z>=two8) {
- fw = (float)((int32_t)(twon8*z));
- iq[jz] = (int32_t)(z-two8*fw);
- jz += 1; q0 += 8;
- iq[jz] = (int32_t) fw;
- } else iq[jz] = (int32_t) z ;
- }
-
- /* convert integer "bit" chunk to floating-point value */
- fw = scalbnf(one,q0);
- for(i=jz;i>=0;i--) {
- q[i] = fw*(float)iq[i]; fw*=twon8;
- }
-
- /* compute PIo2[0,...,jp]*q[jz,...,0] */
- for(i=jz;i>=0;i--) {
- for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k];
- fq[jz-i] = fw;
- }
-
- /* compress fq[] into y[] */
- switch(prec) {
- case 0:
- fw = 0.0;
- for (i=jz;i>=0;i--) fw += fq[i];
- y[0] = (ih==0)? fw: -fw;
- break;
- case 1:
- case 2:
- fw = 0.0;
- for (i=jz;i>=0;i--) fw += fq[i];
- y[0] = (ih==0)? fw: -fw;
- fw = fq[0]-fw;
- for (i=1;i<=jz;i++) fw += fq[i];
- y[1] = (ih==0)? fw: -fw;
- break;
- case 3: /* painful */
- for (i=jz;i>0;i--) {
- fw = fq[i-1]+fq[i];
- fq[i] += fq[i-1]-fw;
- fq[i-1] = fw;
- }
- for (i=jz;i>1;i--) {
- fw = fq[i-1]+fq[i];
- fq[i] += fq[i-1]-fw;
- fq[i-1] = fw;
- }
- for (fw=0.0,i=jz;i>=2;i--) fw += fq[i];
- if(ih==0) {
- y[0] = fq[0]; y[1] = fq[1]; y[2] = fw;
- } else {
- y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw;
- }
- }
- return n&7;
-}
+++ /dev/null
-
-/* @(#)k_sin.c 1.3 95/01/18 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* __kernel_sin( x, y, iy)
- * kernel sin function on [-pi/4, pi/4], pi/4 ~ 0.7854
- * Input x is assumed to be bounded by ~pi/4 in magnitude.
- * Input y is the tail of x.
- * Input iy indicates whether y is 0. (if iy=0, y assume to be 0).
- *
- * Algorithm
- * 1. Since sin(-x) = -sin(x), we need only to consider positive x.
- * 2. if x < 2^-27 (hx<0x3e400000 0), return x with inexact if x!=0.
- * 3. sin(x) is approximated by a polynomial of degree 13 on
- * [0,pi/4]
- * 3 13
- * sin(x) ~ x + S1*x + ... + S6*x
- * where
- *
- * |sin(x) 2 4 6 8 10 12 | -58
- * |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2
- * | x |
- *
- * 4. sin(x+y) = sin(x) + sin'(x')*y
- * ~ sin(x) + (1-x*x/2)*y
- * For better accuracy, let
- * 3 2 2 2 2
- * r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6))))
- * then 3 2
- * sin(x) = x + (S1*x + (x *(r-y/2)+y))
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
-S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */
-S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */
-S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */
-S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */
-S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */
-S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */
-
-double
-__kernel_sin(double x, double y, int iy)
-{
- double z,r,v;
- int32_t ix;
- GET_HIGH_WORD(ix,x);
- ix &= 0x7fffffff; /* high word of x */
- if(ix<0x3e400000) /* |x| < 2**-27 */
- {if((int)x==0) return x;} /* generate inexact */
- z = x*x;
- v = z*x;
- r = S2+z*(S3+z*(S4+z*(S5+z*S6)));
- if(iy==0) return x+v*(S1+z*r);
- else return x-((z*(half*y-v*r)-y)-v*S1);
-}
+++ /dev/null
-/* k_sinf.c -- float version of k_sin.c
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-half = 5.0000000000e-01,/* 0x3f000000 */
-S1 = -1.6666667163e-01, /* 0xbe2aaaab */
-S2 = 8.3333337680e-03, /* 0x3c088889 */
-S3 = -1.9841270114e-04, /* 0xb9500d01 */
-S4 = 2.7557314297e-06, /* 0x3638ef1b */
-S5 = -2.5050759689e-08, /* 0xb2d72f34 */
-S6 = 1.5896910177e-10; /* 0x2f2ec9d3 */
-
-float
-__kernel_sinf(float x, float y, int iy)
-{
- float z,r,v;
- int32_t ix;
- GET_FLOAT_WORD(ix,x);
- ix &= 0x7fffffff; /* high word of x */
- if(ix<0x32000000) /* |x| < 2**-27 */
- {if((int)x==0) return x;} /* generate inexact */
- z = x*x;
- v = z*x;
- r = S2+z*(S3+z*(S4+z*(S5+z*S6)));
- if(iy==0) return x+v*(S1+z*r);
- else return x-((z*(half*y-v*r)-y)-v*S1);
-}
+++ /dev/null
-/* @(#)k_tan.c 1.5 04/04/22 SMI */
-
-/*
- * ====================================================
- * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved.
- *
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* __kernel_tan( x, y, k )
- * kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854
- * Input x is assumed to be bounded by ~pi/4 in magnitude.
- * Input y is the tail of x.
- * Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned.
- *
- * Algorithm
- * 1. Since tan(-x) = -tan(x), we need only to consider positive x.
- * 2. if x < 2^-28 (hx<0x3e300000 0), return x with inexact if x!=0.
- * 3. tan(x) is approximated by a odd polynomial of degree 27 on
- * [0,0.67434]
- * 3 27
- * tan(x) ~ x + T1*x + ... + T13*x
- * where
- *
- * |tan(x) 2 4 26 | -59.2
- * |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2
- * | x |
- *
- * Note: tan(x+y) = tan(x) + tan'(x)*y
- * ~ tan(x) + (1+x*x)*y
- * Therefore, for better accuracy in computing tan(x+y), let
- * 3 2 2 2 2
- * r = x *(T2+x *(T3+x *(...+x *(T12+x *T13))))
- * then
- * 3 2
- * tan(x+y) = x + (T1*x + (x *(r+y)+y))
- *
- * 4. For x in [0.67434,pi/4], let y = pi/4 - x, then
- * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y))
- * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y)))
- */
-
-#include <math.h>
-#include "math_private.h"
-static const double xxx[] = {
- 3.33333333333334091986e-01, /* 3FD55555, 55555563 */
- 1.33333333333201242699e-01, /* 3FC11111, 1110FE7A */
- 5.39682539762260521377e-02, /* 3FABA1BA, 1BB341FE */
- 2.18694882948595424599e-02, /* 3F9664F4, 8406D637 */
- 8.86323982359930005737e-03, /* 3F8226E3, E96E8493 */
- 3.59207910759131235356e-03, /* 3F6D6D22, C9560328 */
- 1.45620945432529025516e-03, /* 3F57DBC8, FEE08315 */
- 5.88041240820264096874e-04, /* 3F4344D8, F2F26501 */
- 2.46463134818469906812e-04, /* 3F3026F7, 1A8D1068 */
- 7.81794442939557092300e-05, /* 3F147E88, A03792A6 */
- 7.14072491382608190305e-05, /* 3F12B80F, 32F0A7E9 */
- -1.85586374855275456654e-05, /* BEF375CB, DB605373 */
- 2.59073051863633712884e-05, /* 3EFB2A70, 74BF7AD4 */
-/* one */ 1.00000000000000000000e+00, /* 3FF00000, 00000000 */
-/* pio4 */ 7.85398163397448278999e-01, /* 3FE921FB, 54442D18 */
-/* pio4lo */ 3.06161699786838301793e-17 /* 3C81A626, 33145C07 */
-};
-#define one xxx[13]
-#define pio4 xxx[14]
-#define pio4lo xxx[15]
-#define T xxx
-/* INDENT ON */
-
-double
-__kernel_tan(double x, double y, int iy) {
- double z, r, v, w, s;
- int32_t ix, hx;
-
- GET_HIGH_WORD(hx,x);
- ix = hx & 0x7fffffff; /* high word of |x| */
- if (ix < 0x3e300000) { /* x < 2**-28 */
- if ((int) x == 0) { /* generate inexact */
- uint32_t low;
- GET_LOW_WORD(low,x);
- if (((ix | low) | (iy + 1)) == 0)
- return one / fabs(x);
- else {
- if (iy == 1)
- return x;
- else { /* compute -1 / (x+y) carefully */
- double a, t;
-
- z = w = x + y;
- SET_LOW_WORD(z, 0);
- v = y - (z - x);
- t = a = -one / w;
- SET_LOW_WORD(t, 0);
- s = one + t * z;
- return t + a * (s + t * v);
- }
- }
- }
- }
- if (ix >= 0x3FE59428) { /* |x| >= 0.6744 */
- if (hx < 0) {
- x = -x;
- y = -y;
- }
- z = pio4 - x;
- w = pio4lo - y;
- x = z + w;
- y = 0.0;
- }
- z = x * x;
- w = z * z;
- /*
- * Break x^5*(T[1]+x^2*T[2]+...) into
- * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) +
- * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12]))
- */
- r = T[1] + w * (T[3] + w * (T[5] + w * (T[7] + w * (T[9] +
- w * T[11]))));
- v = z * (T[2] + w * (T[4] + w * (T[6] + w * (T[8] + w * (T[10] +
- w * T[12])))));
- s = z * x;
- r = y + z * (s * (r + v) + y);
- r += T[0] * s;
- w = x + r;
- if (ix >= 0x3FE59428) {
- v = (double) iy;
- return (double) (1 - ((hx >> 30) & 2)) *
- (v - 2.0 * (x - (w * w / (w + v) - r)));
- }
- 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 */
- double a, t;
- z = w;
- SET_LOW_WORD(z,0);
- v = r - (z - x); /* z+v = r+x */
- t = a = -1.0 / w; /* a = -1.0/w */
- SET_LOW_WORD(t,0);
- s = 1.0 + t * z;
- return t + a * (s + t * v);
- }
-}
+++ /dev/null
-/* k_tanf.c -- float version of k_tan.c
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved.
- *
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-static const float
-one = 1.0000000000e+00, /* 0x3f800000 */
-pio4 = 7.8539812565e-01, /* 0x3f490fda */
-pio4lo= 3.7748947079e-08, /* 0x33222168 */
-T[] = {
- 3.3333334327e-01, /* 0x3eaaaaab */
- 1.3333334029e-01, /* 0x3e088889 */
- 5.3968254477e-02, /* 0x3d5d0dd1 */
- 2.1869488060e-02, /* 0x3cb327a4 */
- 8.8632395491e-03, /* 0x3c11371f */
- 3.5920790397e-03, /* 0x3b6b6916 */
- 1.4562094584e-03, /* 0x3abede48 */
- 5.8804126456e-04, /* 0x3a1a26c8 */
- 2.4646313977e-04, /* 0x398137b9 */
- 7.8179444245e-05, /* 0x38a3f445 */
- 7.1407252108e-05, /* 0x3895c07a */
- -1.8558637748e-05, /* 0xb79bae5f */
- 2.5907305826e-05, /* 0x37d95384 */
-};
-
-float
-__kernel_tanf(float x, float y, int iy)
-{
- float z,r,v,w,s;
- int32_t ix,hx;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff; /* high word of |x| */
- if(ix<0x31800000) { /* x < 2**-28 */
- if ((int) x == 0) { /* generate inexact */
- if ((ix | (iy + 1)) == 0)
- return one / fabsf(x);
- else {
- if (iy == 1)
- return x;
- else { /* compute -1 / (x+y) carefully */
- double a, t;
-
- z = w = x + y;
- GET_FLOAT_WORD(ix, z);
- SET_FLOAT_WORD(z, ix & 0xfffff000);
- v = y - (z - x);
- t = a = -one / w;
- GET_FLOAT_WORD(ix, t);
- SET_FLOAT_WORD(t, ix & 0xfffff000);
- s = one + t * z;
- return t + a * (s + t * v);
- }
- }
- }
- }
- if(ix>=0x3f2ca140) { /* |x|>=0.6744 */
- if(hx<0) {x = -x; y = -y;}
- z = pio4-x;
- w = pio4lo-y;
- x = z+w; y = 0.0;
- }
- z = x*x;
- w = z*z;
- /* Break x^5*(T[1]+x^2*T[2]+...) into
- * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) +
- * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12]))
- */
- r = T[1]+w*(T[3]+w*(T[5]+w*(T[7]+w*(T[9]+w*T[11]))));
- v = z*(T[2]+w*(T[4]+w*(T[6]+w*(T[8]+w*(T[10]+w*T[12])))));
- s = z*x;
- r = y + z*(s*(r+v)+y);
- r += T[0]*s;
- w = x+r;
- if(ix>=0x3f2ca140) {
- v = (float)iy;
- return (float)(1-((hx>>30)&2))*(v-(float)2.0*(x-(w*w/(w+v)-r)));
- }
- 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 */
- float a,t;
- int32_t i;
- z = w;
- GET_FLOAT_WORD(i,z);
- SET_FLOAT_WORD(z,i&0xfffff000);
- v = r-(z - x); /* z+v = r+x */
- t = a = -(float)1.0/w; /* a = -1.0/w */
- GET_FLOAT_WORD(i,t);
- SET_FLOAT_WORD(t,i&0xfffff000);
- s = (float)1.0+t*z;
- return t+a*(s+t*v);
- }
-}
--- /dev/null
+#include "libm.h"
+
+double ldexp(double x, int n)
+{
+ return scalbn(x, n);
+}
--- /dev/null
+#include "libm.h"
+
+float ldexpf(float x, int n)
+{
+ return scalbnf(x, n);
+}
--- /dev/null
+#include "libm.h"
+
+long double ldexpl(long double x, int n)
+{
+ return scalbnl(x, n);
+}
--- /dev/null
+#include "libm.h"
+
+double lgamma(double x)
+{
+ return lgamma_r(x, &signgam);
+}
+
+// FIXME
+//weak_alias(lgamma, gamma);
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_lgamma_r.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+/* lgamma_r(x, signgamp)
+ * Reentrant version of the logarithm of the Gamma function
+ * with user provide pointer for the sign of Gamma(x).
+ *
+ * Method:
+ * 1. Argument Reduction for 0 < x <= 8
+ * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may
+ * reduce x to a number in [1.5,2.5] by
+ * lgamma(1+s) = log(s) + lgamma(s)
+ * for example,
+ * lgamma(7.3) = log(6.3) + lgamma(6.3)
+ * = log(6.3*5.3) + lgamma(5.3)
+ * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3)
+ * 2. Polynomial approximation of lgamma around its
+ * minimun ymin=1.461632144968362245 to maintain monotonicity.
+ * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use
+ * Let z = x-ymin;
+ * lgamma(x) = -1.214862905358496078218 + z^2*poly(z)
+ * where
+ * poly(z) is a 14 degree polynomial.
+ * 2. Rational approximation in the primary interval [2,3]
+ * We use the following approximation:
+ * s = x-2.0;
+ * lgamma(x) = 0.5*s + s*P(s)/Q(s)
+ * with accuracy
+ * |P/Q - (lgamma(x)-0.5s)| < 2**-61.71
+ * Our algorithms are based on the following observation
+ *
+ * zeta(2)-1 2 zeta(3)-1 3
+ * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ...
+ * 2 3
+ *
+ * where Euler = 0.5771... is the Euler constant, which is very
+ * close to 0.5.
+ *
+ * 3. For x>=8, we have
+ * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+....
+ * (better formula:
+ * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...)
+ * Let z = 1/x, then we approximation
+ * f(z) = lgamma(x) - (x-0.5)(log(x)-1)
+ * by
+ * 3 5 11
+ * w = w0 + w1*z + w2*z + w3*z + ... + w6*z
+ * where
+ * |w - f(z)| < 2**-58.74
+ *
+ * 4. For negative x, since (G is gamma function)
+ * -x*G(-x)*G(x) = pi/sin(pi*x),
+ * we have
+ * G(x) = pi/(sin(pi*x)*(-x)*G(-x))
+ * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0
+ * Hence, for x<0, signgam = sign(sin(pi*x)) and
+ * lgamma(x) = log(|Gamma(x)|)
+ * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x);
+ * Note: one should avoid compute pi*(-x) directly in the
+ * computation of sin(pi*(-x)).
+ *
+ * 5. Special Cases
+ * lgamma(2+s) ~ s*(1-Euler) for tiny s
+ * lgamma(1) = lgamma(2) = 0
+ * lgamma(x) ~ -log(|x|) for tiny x
+ * lgamma(0) = lgamma(neg.integer) = inf and raise divide-by-zero
+ * lgamma(inf) = inf
+ * lgamma(-inf) = inf (bug for bug compatible with C99!?)
+ *
+ */
+
+#include "libm.h"
+
+static const double
+two52= 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
+half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
+a0 = 7.72156649015328655494e-02, /* 0x3FB3C467, 0xE37DB0C8 */
+a1 = 3.22467033424113591611e-01, /* 0x3FD4A34C, 0xC4A60FAD */
+a2 = 6.73523010531292681824e-02, /* 0x3FB13E00, 0x1A5562A7 */
+a3 = 2.05808084325167332806e-02, /* 0x3F951322, 0xAC92547B */
+a4 = 7.38555086081402883957e-03, /* 0x3F7E404F, 0xB68FEFE8 */
+a5 = 2.89051383673415629091e-03, /* 0x3F67ADD8, 0xCCB7926B */
+a6 = 1.19270763183362067845e-03, /* 0x3F538A94, 0x116F3F5D */
+a7 = 5.10069792153511336608e-04, /* 0x3F40B6C6, 0x89B99C00 */
+a8 = 2.20862790713908385557e-04, /* 0x3F2CF2EC, 0xED10E54D */
+a9 = 1.08011567247583939954e-04, /* 0x3F1C5088, 0x987DFB07 */
+a10 = 2.52144565451257326939e-05, /* 0x3EFA7074, 0x428CFA52 */
+a11 = 4.48640949618915160150e-05, /* 0x3F07858E, 0x90A45837 */
+tc = 1.46163214496836224576e+00, /* 0x3FF762D8, 0x6356BE3F */
+tf = -1.21486290535849611461e-01, /* 0xBFBF19B9, 0xBCC38A42 */
+/* tt = -(tail of tf) */
+tt = -3.63867699703950536541e-18, /* 0xBC50C7CA, 0xA48A971F */
+t0 = 4.83836122723810047042e-01, /* 0x3FDEF72B, 0xC8EE38A2 */
+t1 = -1.47587722994593911752e-01, /* 0xBFC2E427, 0x8DC6C509 */
+t2 = 6.46249402391333854778e-02, /* 0x3FB08B42, 0x94D5419B */
+t3 = -3.27885410759859649565e-02, /* 0xBFA0C9A8, 0xDF35B713 */
+t4 = 1.79706750811820387126e-02, /* 0x3F9266E7, 0x970AF9EC */
+t5 = -1.03142241298341437450e-02, /* 0xBF851F9F, 0xBA91EC6A */
+t6 = 6.10053870246291332635e-03, /* 0x3F78FCE0, 0xE370E344 */
+t7 = -3.68452016781138256760e-03, /* 0xBF6E2EFF, 0xB3E914D7 */
+t8 = 2.25964780900612472250e-03, /* 0x3F6282D3, 0x2E15C915 */
+t9 = -1.40346469989232843813e-03, /* 0xBF56FE8E, 0xBF2D1AF1 */
+t10 = 8.81081882437654011382e-04, /* 0x3F4CDF0C, 0xEF61A8E9 */
+t11 = -5.38595305356740546715e-04, /* 0xBF41A610, 0x9C73E0EC */
+t12 = 3.15632070903625950361e-04, /* 0x3F34AF6D, 0x6C0EBBF7 */
+t13 = -3.12754168375120860518e-04, /* 0xBF347F24, 0xECC38C38 */
+t14 = 3.35529192635519073543e-04, /* 0x3F35FD3E, 0xE8C2D3F4 */
+u0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */
+u1 = 6.32827064025093366517e-01, /* 0x3FE4401E, 0x8B005DFF */
+u2 = 1.45492250137234768737e+00, /* 0x3FF7475C, 0xD119BD6F */
+u3 = 9.77717527963372745603e-01, /* 0x3FEF4976, 0x44EA8450 */
+u4 = 2.28963728064692451092e-01, /* 0x3FCD4EAE, 0xF6010924 */
+u5 = 1.33810918536787660377e-02, /* 0x3F8B678B, 0xBF2BAB09 */
+v1 = 2.45597793713041134822e+00, /* 0x4003A5D7, 0xC2BD619C */
+v2 = 2.12848976379893395361e+00, /* 0x40010725, 0xA42B18F5 */
+v3 = 7.69285150456672783825e-01, /* 0x3FE89DFB, 0xE45050AF */
+v4 = 1.04222645593369134254e-01, /* 0x3FBAAE55, 0xD6537C88 */
+v5 = 3.21709242282423911810e-03, /* 0x3F6A5ABB, 0x57D0CF61 */
+s0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */
+s1 = 2.14982415960608852501e-01, /* 0x3FCB848B, 0x36E20878 */
+s2 = 3.25778796408930981787e-01, /* 0x3FD4D98F, 0x4F139F59 */
+s3 = 1.46350472652464452805e-01, /* 0x3FC2BB9C, 0xBEE5F2F7 */
+s4 = 2.66422703033638609560e-02, /* 0x3F9B481C, 0x7E939961 */
+s5 = 1.84028451407337715652e-03, /* 0x3F5E26B6, 0x7368F239 */
+s6 = 3.19475326584100867617e-05, /* 0x3F00BFEC, 0xDD17E945 */
+r1 = 1.39200533467621045958e+00, /* 0x3FF645A7, 0x62C4AB74 */
+r2 = 7.21935547567138069525e-01, /* 0x3FE71A18, 0x93D3DCDC */
+r3 = 1.71933865632803078993e-01, /* 0x3FC601ED, 0xCCFBDF27 */
+r4 = 1.86459191715652901344e-02, /* 0x3F9317EA, 0x742ED475 */
+r5 = 7.77942496381893596434e-04, /* 0x3F497DDA, 0xCA41A95B */
+r6 = 7.32668430744625636189e-06, /* 0x3EDEBAF7, 0xA5B38140 */
+w0 = 4.18938533204672725052e-01, /* 0x3FDACFE3, 0x90C97D69 */
+w1 = 8.33333333333329678849e-02, /* 0x3FB55555, 0x5555553B */
+w2 = -2.77777777728775536470e-03, /* 0xBF66C16C, 0x16B02E5C */
+w3 = 7.93650558643019558500e-04, /* 0x3F4A019F, 0x98CF38B6 */
+w4 = -5.95187557450339963135e-04, /* 0xBF4380CB, 0x8C0FE741 */
+w5 = 8.36339918996282139126e-04, /* 0x3F4B67BA, 0x4CDAD5D1 */
+w6 = -1.63092934096575273989e-03; /* 0xBF5AB89D, 0x0B9E43E4 */
+
+static const double zero = 0.00000000000000000000e+00;
+
+static double sin_pi(double x)
+{
+ double y,z;
+ int n,ix;
+
+ GET_HIGH_WORD(ix, x);
+ ix &= 0x7fffffff;
+
+ if (ix < 0x3fd00000)
+ return __sin(pi*x, zero, 0);
+
+ y = -x; /* negative x is assumed */
+
+ /*
+ * argument reduction, make sure inexact flag not raised if input
+ * is an integer
+ */
+ z = floor(y);
+ if (z != y) { /* inexact anyway */
+ y *= 0.5;
+ y = 2.0*(y - floor(y)); /* y = |x| mod 2.0 */
+ n = (int)(y*4.0);
+ } else {
+ if (ix >= 0x43400000) {
+ y = zero; /* y must be even */
+ n = 0;
+ } else {
+ if (ix < 0x43300000)
+ z = y + two52; /* exact */
+ GET_LOW_WORD(n, z);
+ n &= 1;
+ y = n;
+ n <<= 2;
+ }
+ }
+ switch (n) {
+ case 0: y = __sin(pi*y, zero, 0); break;
+ case 1:
+ case 2: y = __cos(pi*(0.5-y), zero); break;
+ case 3:
+ case 4: y = __sin(pi*(one-y), zero, 0); break;
+ case 5:
+ case 6: y = -__cos(pi*(y-1.5), zero); break;
+ default: y = __sin(pi*(y-2.0), zero, 0); break;
+ }
+ return -y;
+}
+
+
+double lgamma_r(double x, int *signgamp)
+{
+ double t,y,z,nadj,p,p1,p2,p3,q,r,w;
+ int32_t hx;
+ int i,lx,ix;
+
+ EXTRACT_WORDS(hx, lx, x);
+
+ /* purge off +-inf, NaN, +-0, tiny and negative arguments */
+ *signgamp = 1;
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7ff00000)
+ return x*x;
+ if ((ix|lx) == 0)
+ return one/zero;
+ if (ix < 0x3b900000) { /* |x|<2**-70, return -log(|x|) */
+ if(hx < 0) {
+ *signgamp = -1;
+ return -log(-x);
+ }
+ return -log(x);
+ }
+ if (hx < 0) {
+ if (ix >= 0x43300000) /* |x|>=2**52, must be -integer */
+ return one/zero;
+ t = sin_pi(x);
+ if (t == zero) /* -integer */
+ return one/zero;
+ nadj = log(pi/fabs(t*x));
+ if (t < zero)
+ *signgamp = -1;
+ x = -x;
+ }
+
+ /* purge off 1 and 2 */
+ if (((ix - 0x3ff00000)|lx) == 0 || ((ix - 0x40000000)|lx) == 0)
+ r = 0;
+ /* for x < 2.0 */
+ else if (ix < 0x40000000) {
+ if (ix <= 0x3feccccc) { /* lgamma(x) = lgamma(x+1)-log(x) */
+ r = -log(x);
+ if (ix >= 0x3FE76944) {
+ y = one - x;
+ i = 0;
+ } else if (ix >= 0x3FCDA661) {
+ y = x - (tc-one);
+ i = 1;
+ } else {
+ y = x;
+ i = 2;
+ }
+ } else {
+ r = zero;
+ if (ix >= 0x3FFBB4C3) { /* [1.7316,2] */
+ y = 2.0 - x;
+ i = 0;
+ } else if(ix >= 0x3FF3B4C4) { /* [1.23,1.73] */
+ y = x - tc;
+ i = 1;
+ } else {
+ y = x - one;
+ i = 2;
+ }
+ }
+ switch (i) {
+ case 0:
+ z = y*y;
+ p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10))));
+ p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11)))));
+ p = y*p1+p2;
+ r += (p-0.5*y);
+ break;
+ case 1:
+ z = y*y;
+ w = z*y;
+ p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */
+ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13)));
+ p3 = t2+w*(t5+w*(t8+w*(t11+w*t14)));
+ p = z*p1-(tt-w*(p2+y*p3));
+ r += tf + p;
+ break;
+ case 2:
+ p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5)))));
+ p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5))));
+ r += -0.5*y + p1/p2;
+ }
+ } else if (ix < 0x40200000) { /* x < 8.0 */
+ i = (int)x;
+ y = x - (double)i;
+ p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6))))));
+ q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6)))));
+ r = half*y+p/q;
+ z = one; /* lgamma(1+s) = log(s) + lgamma(s) */
+ switch (i) {
+ case 7: z *= y + 6.0; /* FALLTHRU */
+ case 6: z *= y + 5.0; /* FALLTHRU */
+ case 5: z *= y + 4.0; /* FALLTHRU */
+ case 4: z *= y + 3.0; /* FALLTHRU */
+ case 3: z *= y + 2.0; /* FALLTHRU */
+ r += log(z);
+ break;
+ }
+ } else if (ix < 0x43900000) { /* 8.0 <= x < 2**58 */
+ t = log(x);
+ z = one/x;
+ y = z*z;
+ w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6)))));
+ r = (x-half)*(t-one)+w;
+ } else /* 2**58 <= x <= inf */
+ r = x*(log(x)-one);
+ if (hx < 0)
+ r = nadj - r;
+ return r;
+}
--- /dev/null
+#include "libm.h"
+
+float lgammaf(float x)
+{
+ return lgamma_r(x, &signgam);
+}
+
+// FIXME
+//weak_alias(lgammaf, gammaf);
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_lgammaf_r.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+two23= 8.3886080000e+06, /* 0x4b000000 */
+half= 5.0000000000e-01, /* 0x3f000000 */
+one = 1.0000000000e+00, /* 0x3f800000 */
+pi = 3.1415927410e+00, /* 0x40490fdb */
+a0 = 7.7215664089e-02, /* 0x3d9e233f */
+a1 = 3.2246702909e-01, /* 0x3ea51a66 */
+a2 = 6.7352302372e-02, /* 0x3d89f001 */
+a3 = 2.0580807701e-02, /* 0x3ca89915 */
+a4 = 7.3855509982e-03, /* 0x3bf2027e */
+a5 = 2.8905137442e-03, /* 0x3b3d6ec6 */
+a6 = 1.1927076848e-03, /* 0x3a9c54a1 */
+a7 = 5.1006977446e-04, /* 0x3a05b634 */
+a8 = 2.2086278477e-04, /* 0x39679767 */
+a9 = 1.0801156895e-04, /* 0x38e28445 */
+a10 = 2.5214456400e-05, /* 0x37d383a2 */
+a11 = 4.4864096708e-05, /* 0x383c2c75 */
+tc = 1.4616321325e+00, /* 0x3fbb16c3 */
+tf = -1.2148628384e-01, /* 0xbdf8cdcd */
+/* tt = -(tail of tf) */
+tt = 6.6971006518e-09, /* 0x31e61c52 */
+t0 = 4.8383611441e-01, /* 0x3ef7b95e */
+t1 = -1.4758771658e-01, /* 0xbe17213c */
+t2 = 6.4624942839e-02, /* 0x3d845a15 */
+t3 = -3.2788541168e-02, /* 0xbd064d47 */
+t4 = 1.7970675603e-02, /* 0x3c93373d */
+t5 = -1.0314224288e-02, /* 0xbc28fcfe */
+t6 = 6.1005386524e-03, /* 0x3bc7e707 */
+t7 = -3.6845202558e-03, /* 0xbb7177fe */
+t8 = 2.2596477065e-03, /* 0x3b141699 */
+t9 = -1.4034647029e-03, /* 0xbab7f476 */
+t10 = 8.8108185446e-04, /* 0x3a66f867 */
+t11 = -5.3859531181e-04, /* 0xba0d3085 */
+t12 = 3.1563205994e-04, /* 0x39a57b6b */
+t13 = -3.1275415677e-04, /* 0xb9a3f927 */
+t14 = 3.3552918467e-04, /* 0x39afe9f7 */
+u0 = -7.7215664089e-02, /* 0xbd9e233f */
+u1 = 6.3282704353e-01, /* 0x3f2200f4 */
+u2 = 1.4549225569e+00, /* 0x3fba3ae7 */
+u3 = 9.7771751881e-01, /* 0x3f7a4bb2 */
+u4 = 2.2896373272e-01, /* 0x3e6a7578 */
+u5 = 1.3381091878e-02, /* 0x3c5b3c5e */
+v1 = 2.4559779167e+00, /* 0x401d2ebe */
+v2 = 2.1284897327e+00, /* 0x4008392d */
+v3 = 7.6928514242e-01, /* 0x3f44efdf */
+v4 = 1.0422264785e-01, /* 0x3dd572af */
+v5 = 3.2170924824e-03, /* 0x3b52d5db */
+s0 = -7.7215664089e-02, /* 0xbd9e233f */
+s1 = 2.1498242021e-01, /* 0x3e5c245a */
+s2 = 3.2577878237e-01, /* 0x3ea6cc7a */
+s3 = 1.4635047317e-01, /* 0x3e15dce6 */
+s4 = 2.6642270386e-02, /* 0x3cda40e4 */
+s5 = 1.8402845599e-03, /* 0x3af135b4 */
+s6 = 3.1947532989e-05, /* 0x3805ff67 */
+r1 = 1.3920053244e+00, /* 0x3fb22d3b */
+r2 = 7.2193557024e-01, /* 0x3f38d0c5 */
+r3 = 1.7193385959e-01, /* 0x3e300f6e */
+r4 = 1.8645919859e-02, /* 0x3c98bf54 */
+r5 = 7.7794247773e-04, /* 0x3a4beed6 */
+r6 = 7.3266842264e-06, /* 0x36f5d7bd */
+w0 = 4.1893854737e-01, /* 0x3ed67f1d */
+w1 = 8.3333335817e-02, /* 0x3daaaaab */
+w2 = -2.7777778450e-03, /* 0xbb360b61 */
+w3 = 7.9365057172e-04, /* 0x3a500cfd */
+w4 = -5.9518753551e-04, /* 0xba1c065c */
+w5 = 8.3633989561e-04, /* 0x3a5b3dd2 */
+w6 = -1.6309292987e-03; /* 0xbad5c4e8 */
+
+static const float zero = 0.0000000000e+00;
+
+static float sin_pif(float x)
+{
+ float y,z;
+ int n,ix;
+
+ GET_FLOAT_WORD(ix, x);
+ ix &= 0x7fffffff;
+
+ if(ix < 0x3e800000)
+ return __sindf(pi*x);
+
+ y = -x; /* negative x is assumed */
+
+ /*
+ * argument reduction, make sure inexact flag not raised if input
+ * is an integer
+ */
+ z = floorf(y);
+ if (z != y) { /* inexact anyway */
+ y *= (float)0.5;
+ y = (float)2.0*(y - floorf(y)); /* y = |x| mod 2.0 */
+ n = (int) (y*(float)4.0);
+ } else {
+ if (ix >= 0x4b800000) {
+ y = zero; /* y must be even */
+ n = 0;
+ } else {
+ if (ix < 0x4b000000)
+ z = y + two23; /* exact */
+ GET_FLOAT_WORD(n, z);
+ n &= 1;
+ y = n;
+ n <<= 2;
+ }
+ }
+ switch (n) {
+ case 0: y = __sindf(pi*y); break;
+ case 1:
+ case 2: y = __cosdf(pi*((float)0.5-y)); break;
+ case 3:
+ case 4: y = __sindf(pi*(one-y)); break;
+ case 5:
+ case 6: y = -__cosdf(pi*(y-(float)1.5)); break;
+ default: y = __sindf(pi*(y-(float)2.0)); break;
+ }
+ return -y;
+}
+
+
+float lgammaf_r(float x, int *signgamp)
+{
+ float t,y,z,nadj,p,p1,p2,p3,q,r,w;
+ int32_t hx;
+ int i,ix;
+
+ GET_FLOAT_WORD(hx, x);
+
+ /* purge off +-inf, NaN, +-0, tiny and negative arguments */
+ *signgamp = 1;
+ ix = hx & 0x7fffffff;
+ if (ix >= 0x7f800000)
+ return x*x;
+ if (ix == 0)
+ return one/zero;
+ if (ix < 0x35000000) { /* |x| < 2**-21, return -log(|x|) */
+ if (hx < 0) {
+ *signgamp = -1;
+ return -logf(-x);
+ }
+ return -logf(x);
+ }
+ if (hx < 0) {
+ if (ix >= 0x4b000000) /* |x| >= 2**23, must be -integer */
+ return one/zero;
+ t = sin_pif(x);
+ if (t == zero) /* -integer */
+ return one/zero;
+ nadj = logf(pi/fabsf(t*x));
+ if (t < zero)
+ *signgamp = -1;
+ x = -x;
+ }
+
+ /* purge off 1 and 2 */
+ if (ix == 0x3f800000 || ix == 0x40000000)
+ r = 0;
+ /* for x < 2.0 */
+ else if (ix < 0x40000000) {
+ if (ix <= 0x3f666666) { /* lgamma(x) = lgamma(x+1)-log(x) */
+ r = -logf(x);
+ if (ix >= 0x3f3b4a20) {
+ y = one - x;
+ i = 0;
+ } else if (ix >= 0x3e6d3308) {
+ y = x - (tc-one);
+ i = 1;
+ } else {
+ y = x;
+ i = 2;
+ }
+ } else {
+ r = zero;
+ if (ix >= 0x3fdda618) { /* [1.7316,2] */
+ y = (float)2.0 - x;
+ i = 0;
+ } else if (ix >= 0x3F9da620) { /* [1.23,1.73] */
+ y = x - tc;
+ i = 1;
+ } else {
+ y = x - one;
+ i = 2;
+ }
+ }
+ switch(i) {
+ case 0:
+ z = y*y;
+ p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10))));
+ p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11)))));
+ p = y*p1+p2;
+ r += (p-(float)0.5*y);
+ break;
+ case 1:
+ z = y*y;
+ w = z*y;
+ p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */
+ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13)));
+ p3 = t2+w*(t5+w*(t8+w*(t11+w*t14)));
+ p = z*p1-(tt-w*(p2+y*p3));
+ r += (tf + p);
+ break;
+ case 2:
+ p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5)))));
+ p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5))));
+ r += (-(float)0.5*y + p1/p2);
+ }
+ } else if (ix < 0x41000000) { /* x < 8.0 */
+ i = (int)x;
+ y = x-(float)i;
+ p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6))))));
+ q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6)))));
+ r = half*y+p/q;
+ z = one; /* lgamma(1+s) = log(s) + lgamma(s) */
+ switch (i) {
+ case 7: z *= y + (float)6.0; /* FALLTHRU */
+ case 6: z *= y + (float)5.0; /* FALLTHRU */
+ case 5: z *= y + (float)4.0; /* FALLTHRU */
+ case 4: z *= y + (float)3.0; /* FALLTHRU */
+ case 3: z *= y + (float)2.0; /* FALLTHRU */
+ r += logf(z);
+ break;
+ }
+ } else if (ix < 0x5c800000) { /* 8.0 <= x < 2**58 */
+ t = logf(x);
+ z = one/x;
+ y = z*z;
+ w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6)))));
+ r = (x-half)*(t-one)+w;
+ } else /* 2**58 <= x <= inf */
+ r = x*(logf(x)-one);
+ if (hx < 0)
+ r = nadj - r;
+ return r;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_lgammal.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/* lgammal(x)
+ * Reentrant version of the logarithm of the Gamma function
+ * with user provide pointer for the sign of Gamma(x).
+ *
+ * Method:
+ * 1. Argument Reduction for 0 < x <= 8
+ * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may
+ * reduce x to a number in [1.5,2.5] by
+ * lgamma(1+s) = log(s) + lgamma(s)
+ * for example,
+ * lgamma(7.3) = log(6.3) + lgamma(6.3)
+ * = log(6.3*5.3) + lgamma(5.3)
+ * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3)
+ * 2. Polynomial approximation of lgamma around its
+ * minimun ymin=1.461632144968362245 to maintain monotonicity.
+ * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use
+ * Let z = x-ymin;
+ * lgamma(x) = -1.214862905358496078218 + z^2*poly(z)
+ * 2. Rational approximation in the primary interval [2,3]
+ * We use the following approximation:
+ * s = x-2.0;
+ * lgamma(x) = 0.5*s + s*P(s)/Q(s)
+ * Our algorithms are based on the following observation
+ *
+ * zeta(2)-1 2 zeta(3)-1 3
+ * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ...
+ * 2 3
+ *
+ * where Euler = 0.5771... is the Euler constant, which is very
+ * close to 0.5.
+ *
+ * 3. For x>=8, we have
+ * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+....
+ * (better formula:
+ * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...)
+ * Let z = 1/x, then we approximation
+ * f(z) = lgamma(x) - (x-0.5)(log(x)-1)
+ * by
+ * 3 5 11
+ * w = w0 + w1*z + w2*z + w3*z + ... + w6*z
+ *
+ * 4. For negative x, since (G is gamma function)
+ * -x*G(-x)*G(x) = pi/sin(pi*x),
+ * we have
+ * G(x) = pi/(sin(pi*x)*(-x)*G(-x))
+ * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0
+ * Hence, for x<0, signgam = sign(sin(pi*x)) and
+ * lgamma(x) = log(|Gamma(x)|)
+ * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x);
+ * Note: one should avoid compute pi*(-x) directly in the
+ * computation of sin(pi*(-x)).
+ *
+ * 5. Special Cases
+ * lgamma(2+s) ~ s*(1-Euler) for tiny s
+ * lgamma(1)=lgamma(2)=0
+ * lgamma(x) ~ -log(x) for tiny x
+ * lgamma(0) = lgamma(inf) = inf
+ * lgamma(-integer) = +-inf
+ *
+ */
+
+#include "libm.h"
+
+long double lgammal(long double x)
+{
+ return lgammal_r(x, &signgam);
+}
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double lgammal_r(long double x, int *sg)
+{
+ return lgamma_r(x, sg);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double
+half = 0.5L,
+one = 1.0L,
+pi = 3.14159265358979323846264L,
+two63 = 9.223372036854775808e18L,
+
+/* lgam(1+x) = 0.5 x + x a(x)/b(x)
+ -0.268402099609375 <= x <= 0
+ peak relative error 6.6e-22 */
+a0 = -6.343246574721079391729402781192128239938E2L,
+a1 = 1.856560238672465796768677717168371401378E3L,
+a2 = 2.404733102163746263689288466865843408429E3L,
+a3 = 8.804188795790383497379532868917517596322E2L,
+a4 = 1.135361354097447729740103745999661157426E2L,
+a5 = 3.766956539107615557608581581190400021285E0L,
+
+b0 = 8.214973713960928795704317259806842490498E3L,
+b1 = 1.026343508841367384879065363925870888012E4L,
+b2 = 4.553337477045763320522762343132210919277E3L,
+b3 = 8.506975785032585797446253359230031874803E2L,
+b4 = 6.042447899703295436820744186992189445813E1L,
+/* b5 = 1.000000000000000000000000000000000000000E0 */
+
+
+tc = 1.4616321449683623412626595423257213284682E0L,
+tf = -1.2148629053584961146050602565082954242826E-1, /* double precision */
+/* tt = (tail of tf), i.e. tf + tt has extended precision. */
+tt = 3.3649914684731379602768989080467587736363E-18L,
+/* lgam ( 1.4616321449683623412626595423257213284682E0 ) =
+-1.2148629053584960809551455717769158215135617312999903886372437313313530E-1 */
+
+/* lgam (x + tc) = tf + tt + x g(x)/h(x)
+ -0.230003726999612341262659542325721328468 <= x
+ <= 0.2699962730003876587373404576742786715318
+ peak relative error 2.1e-21 */
+g0 = 3.645529916721223331888305293534095553827E-18L,
+g1 = 5.126654642791082497002594216163574795690E3L,
+g2 = 8.828603575854624811911631336122070070327E3L,
+g3 = 5.464186426932117031234820886525701595203E3L,
+g4 = 1.455427403530884193180776558102868592293E3L,
+g5 = 1.541735456969245924860307497029155838446E2L,
+g6 = 4.335498275274822298341872707453445815118E0L,
+
+h0 = 1.059584930106085509696730443974495979641E4L,
+h1 = 2.147921653490043010629481226937850618860E4L,
+h2 = 1.643014770044524804175197151958100656728E4L,
+h3 = 5.869021995186925517228323497501767586078E3L,
+h4 = 9.764244777714344488787381271643502742293E2L,
+h5 = 6.442485441570592541741092969581997002349E1L,
+/* h6 = 1.000000000000000000000000000000000000000E0 */
+
+
+/* lgam (x+1) = -0.5 x + x u(x)/v(x)
+ -0.100006103515625 <= x <= 0.231639862060546875
+ peak relative error 1.3e-21 */
+u0 = -8.886217500092090678492242071879342025627E1L,
+u1 = 6.840109978129177639438792958320783599310E2L,
+u2 = 2.042626104514127267855588786511809932433E3L,
+u3 = 1.911723903442667422201651063009856064275E3L,
+u4 = 7.447065275665887457628865263491667767695E2L,
+u5 = 1.132256494121790736268471016493103952637E2L,
+u6 = 4.484398885516614191003094714505960972894E0L,
+
+v0 = 1.150830924194461522996462401210374632929E3L,
+v1 = 3.399692260848747447377972081399737098610E3L,
+v2 = 3.786631705644460255229513563657226008015E3L,
+v3 = 1.966450123004478374557778781564114347876E3L,
+v4 = 4.741359068914069299837355438370682773122E2L,
+v5 = 4.508989649747184050907206782117647852364E1L,
+/* v6 = 1.000000000000000000000000000000000000000E0 */
+
+
+/* lgam (x+2) = .5 x + x s(x)/r(x)
+ 0 <= x <= 1
+ peak relative error 7.2e-22 */
+s0 = 1.454726263410661942989109455292824853344E6L,
+s1 = -3.901428390086348447890408306153378922752E6L,
+s2 = -6.573568698209374121847873064292963089438E6L,
+s3 = -3.319055881485044417245964508099095984643E6L,
+s4 = -7.094891568758439227560184618114707107977E5L,
+s5 = -6.263426646464505837422314539808112478303E4L,
+s6 = -1.684926520999477529949915657519454051529E3L,
+
+r0 = -1.883978160734303518163008696712983134698E7L,
+r1 = -2.815206082812062064902202753264922306830E7L,
+r2 = -1.600245495251915899081846093343626358398E7L,
+r3 = -4.310526301881305003489257052083370058799E6L,
+r4 = -5.563807682263923279438235987186184968542E5L,
+r5 = -3.027734654434169996032905158145259713083E4L,
+r6 = -4.501995652861105629217250715790764371267E2L,
+/* r6 = 1.000000000000000000000000000000000000000E0 */
+
+
+/* lgam(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x w(1/x^2)
+ x >= 8
+ Peak relative error 1.51e-21
+w0 = LS2PI - 0.5 */
+w0 = 4.189385332046727417803e-1L,
+w1 = 8.333333333333331447505E-2L,
+w2 = -2.777777777750349603440E-3L,
+w3 = 7.936507795855070755671E-4L,
+w4 = -5.952345851765688514613E-4L,
+w5 = 8.412723297322498080632E-4L,
+w6 = -1.880801938119376907179E-3L,
+w7 = 4.885026142432270781165E-3L;
+
+static const long double zero = 0.0L;
+
+static long double sin_pi(long double x)
+{
+ long double y, z;
+ int n, ix;
+ uint32_t se, i0, i1;
+
+ GET_LDOUBLE_WORDS(se, i0, i1, x);
+ ix = se & 0x7fff;
+ ix = (ix << 16) | (i0 >> 16);
+ if (ix < 0x3ffd8000) /* 0.25 */
+ return sinl(pi * x);
+ y = -x; /* x is assume negative */
+
+ /*
+ * argument reduction, make sure inexact flag not raised if input
+ * is an integer
+ */
+ z = floorl(y);
+ if (z != y) { /* inexact anyway */
+ y *= 0.5;
+ y = 2.0*(y - floorl(y));/* y = |x| mod 2.0 */
+ n = (int) (y*4.0);
+ } else {
+ if (ix >= 0x403f8000) { /* 2^64 */
+ y = zero; /* y must be even */
+ n = 0;
+ } else {
+ if (ix < 0x403e8000) /* 2^63 */
+ z = y + two63; /* exact */
+ GET_LDOUBLE_WORDS(se, i0, i1, z);
+ n = i1 & 1;
+ y = n;
+ n <<= 2;
+ }
+ }
+
+ switch (n) {
+ case 0:
+ y = sinl(pi * y);
+ break;
+ case 1:
+ case 2:
+ y = cosl(pi * (half - y));
+ break;
+ case 3:
+ case 4:
+ y = sinl(pi * (one - y));
+ break;
+ case 5:
+ case 6:
+ y = -cosl(pi * (y - 1.5));
+ break;
+ default:
+ y = sinl(pi * (y - 2.0));
+ break;
+ }
+ return -y;
+}
+
+long double lgammal_r(long double x, int *sg) {
+ long double t, y, z, nadj, p, p1, p2, q, r, w;
+ int i, ix;
+ uint32_t se, i0, i1;
+
+ *sg = 1;
+ GET_LDOUBLE_WORDS(se, i0, i1, x);
+ ix = se & 0x7fff;
+
+ if ((ix | i0 | i1) == 0) {
+ if (se & 0x8000)
+ *sg = -1;
+ return one / fabsl(x);
+ }
+
+ ix = (ix << 16) | (i0 >> 16);
+
+ /* purge off +-inf, NaN, +-0, and negative arguments */
+ if (ix >= 0x7fff0000)
+ return x * x;
+
+ if (ix < 0x3fc08000) { /* |x|<2**-63, return -log(|x|) */
+ if (se & 0x8000) {
+ *sg = -1;
+ return -logl(-x);
+ }
+ return -logl(x);
+ }
+ if (se & 0x8000) {
+ t = sin_pi (x);
+ if (t == zero)
+ return one / fabsl(t); /* -integer */
+ nadj = logl(pi / fabsl(t * x));
+ if (t < zero)
+ *sg = -1;
+ x = -x;
+ }
+
+ /* purge off 1 and 2 */
+ if ((((ix - 0x3fff8000) | i0 | i1) == 0) ||
+ (((ix - 0x40008000) | i0 | i1) == 0))
+ r = 0;
+ else if (ix < 0x40008000) { /* x < 2.0 */
+ if (ix <= 0x3ffee666) { /* 8.99993896484375e-1 */
+ /* lgamma(x) = lgamma(x+1) - log(x) */
+ r = -logl (x);
+ if (ix >= 0x3ffebb4a) { /* 7.31597900390625e-1 */
+ y = x - one;
+ i = 0;
+ } else if (ix >= 0x3ffced33) { /* 2.31639862060546875e-1 */
+ y = x - (tc - one);
+ i = 1;
+ } else { /* x < 0.23 */
+ y = x;
+ i = 2;
+ }
+ } else {
+ r = zero;
+ if (ix >= 0x3fffdda6) { /* 1.73162841796875 */
+ /* [1.7316,2] */
+ y = x - 2.0;
+ i = 0;
+ } else if (ix >= 0x3fff9da6) { /* 1.23162841796875 */
+ /* [1.23,1.73] */
+ y = x - tc;
+ i = 1;
+ } else {
+ /* [0.9, 1.23] */
+ y = x - one;
+ i = 2;
+ }
+ }
+ switch (i) {
+ case 0:
+ p1 = a0 + y * (a1 + y * (a2 + y * (a3 + y * (a4 + y * a5))));
+ p2 = b0 + y * (b1 + y * (b2 + y * (b3 + y * (b4 + y))));
+ r += half * y + y * p1/p2;
+ break;
+ case 1:
+ p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6)))));
+ p2 = h0 + y * (h1 + y * (h2 + y * (h3 + y * (h4 + y * (h5 + y)))));
+ p = tt + y * p1/p2;
+ r += (tf + p);
+ break;
+ case 2:
+ p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * (u5 + y * u6))))));
+ p2 = v0 + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * (v5 + y)))));
+ r += (-half * y + p1 / p2);
+ }
+ } else if (ix < 0x40028000) { /* 8.0 */
+ /* x < 8.0 */
+ i = (int)x;
+ t = zero;
+ y = x - (double)i;
+ p = y * (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6))))));
+ q = r0 + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * (r6 + y))))));
+ r = half * y + p / q;
+ z = one;/* lgamma(1+s) = log(s) + lgamma(s) */
+ switch (i) {
+ case 7:
+ z *= (y + 6.0); /* FALLTHRU */
+ case 6:
+ z *= (y + 5.0); /* FALLTHRU */
+ case 5:
+ z *= (y + 4.0); /* FALLTHRU */
+ case 4:
+ z *= (y + 3.0); /* FALLTHRU */
+ case 3:
+ z *= (y + 2.0); /* FALLTHRU */
+ r += logl (z);
+ break;
+ }
+ } else if (ix < 0x40418000) { /* 2^66 */
+ /* 8.0 <= x < 2**66 */
+ t = logl (x);
+ z = one / x;
+ y = z * z;
+ w = w0 + z * (w1 + y * (w2 + y * (w3 + y * (w4 + y * (w5 + y * (w6 + y * w7))))));
+ r = (x - half) * (t - one) + w;
+ } else /* 2**66 <= x <= inf */
+ r = x * (logl (x) - one);
+ if (se & 0x8000)
+ r = nadj - r;
+ return r;
+}
+#endif
--- /dev/null
+#define type double
+#define roundit rint
+#define dtype long long
+#define fn llrint
+
+#include "lrint.c"
+
+
--- /dev/null
+#define type float
+#define roundit rintf
+#define dtype long long
+#define fn llrintf
+
+#include "lrint.c"
--- /dev/null
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long long llrintl(long double x)
+{
+ return llrint(x);
+}
+#else
+#define type long double
+#define roundit rintl
+#define dtype long long
+#define fn llrintl
+
+#include "lrint.c"
+#endif
--- /dev/null
+#define type double
+#define roundit round
+#define dtype long long
+#define DTYPE_MIN LLONG_MIN
+#define DTYPE_MAX LLONG_MAX
+#define fn llround
+
+#include "lround.c"
+
+
--- /dev/null
+#define type float
+#define roundit roundf
+#define dtype long long
+#define DTYPE_MIN LLONG_MIN
+#define DTYPE_MAX LLONG_MAX
+#define fn llroundf
+
+#include "lround.c"
--- /dev/null
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long long llroundl(long double x)
+{
+ return llround(x);
+}
+#else
+#define type long double
+#define roundit roundl
+#define dtype long long
+#define DTYPE_MIN LLONG_MIN
+#define DTYPE_MAX LLONG_MAX
+#define fn llroundl
+
+#include "lround.c"
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_log.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* log(x)
+ * Return the logrithm of x
+ *
+ * Method :
+ * 1. Argument Reduction: find k and f such that
+ * x = 2^k * (1+f),
+ * where sqrt(2)/2 < 1+f < sqrt(2) .
+ *
+ * 2. Approximation of log(1+f).
+ * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
+ * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
+ * = 2s + s*R
+ * We use a special Remez algorithm on [0,0.1716] to generate
+ * a polynomial of degree 14 to approximate R The maximum error
+ * of this polynomial approximation is bounded by 2**-58.45. In
+ * other words,
+ * 2 4 6 8 10 12 14
+ * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s
+ * (the values of Lg1 to Lg7 are listed in the program)
+ * and
+ * | 2 14 | -58.45
+ * | Lg1*s +...+Lg7*s - R(z) | <= 2
+ * | |
+ * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
+ * In order to guarantee error in log below 1ulp, we compute log
+ * by
+ * log(1+f) = f - s*(f - R) (if f is not too large)
+ * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy)
+ *
+ * 3. Finally, log(x) = k*ln2 + log(1+f).
+ * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
+ * Here ln2 is split into two floating point number:
+ * ln2_hi + ln2_lo,
+ * where n*ln2_hi is always exact for |n| < 2000.
+ *
+ * Special cases:
+ * log(x) is NaN with signal if x < 0 (including -INF) ;
+ * log(+INF) is +INF; log(0) is -INF with signal;
+ * log(NaN) is that NaN with no signal.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "libm.h"
+
+static const double
+ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
+ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
+two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
+Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
+Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
+Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
+Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
+Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
+Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
+Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
+
+static const double zero = 0.0;
+
+double log(double x)
+{
+ double hfsq,f,s,z,R,w,t1,t2,dk;
+ int32_t k,hx,i,j;
+ uint32_t lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+
+ k = 0;
+ if (hx < 0x00100000) { /* x < 2**-1022 */
+ if (((hx&0x7fffffff)|lx) == 0)
+ return -two54/zero; /* log(+-0)=-inf */
+ if (hx < 0)
+ return (x-x)/zero; /* log(-#) = NaN */
+ /* subnormal number, scale up x */
+ k -= 54;
+ x *= two54;
+ GET_HIGH_WORD(hx,x);
+ }
+ if (hx >= 0x7ff00000)
+ return x+x;
+ 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;
+ f = x - 1.0;
+ if ((0x000fffff&(2+hx)) < 3) { /* -2**-20 <= f < 2**-20 */
+ if (f == zero) {
+ if (k == 0) {
+ return zero;
+ }
+ dk = (double)k;
+ return dk*ln2_hi + dk*ln2_lo;
+ }
+ R = f*f*(0.5-0.33333333333333333*f);
+ if (k == 0)
+ return f - R;
+ dk = (double)k;
+ return dk*ln2_hi - ((R-dk*ln2_lo)-f);
+ }
+ s = f/(2.0+f);
+ dk = (double)k;
+ z = s*s;
+ i = hx - 0x6147a;
+ w = z*z;
+ j = 0x6b851 - hx;
+ t1 = w*(Lg2+w*(Lg4+w*Lg6));
+ t2 = z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7)));
+ i |= j;
+ R = t2 + t1;
+ if (i > 0) {
+ hfsq = 0.5*f*f;
+ if (k == 0)
+ return f - (hfsq-s*(hfsq+R));
+ return dk*ln2_hi - ((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f);
+ } else {
+ if (k == 0)
+ return f - s*(f-R);
+ return dk*ln2_hi - ((s*(f-R)-dk*ln2_lo)-f);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_log10.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * Return the base 10 logarithm of x. See e_log.c and k_log.h for most
+ * comments.
+ *
+ * log10(x) = (f - 0.5*f*f + k_log1p(f)) / ln10 + k * log10(2)
+ * in not-quite-routine extra precision.
+ */
+
+#include "libm.h"
+#include "__log1p.h"
+
+static const double
+two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
+ivln10hi = 4.34294481878168880939e-01, /* 0x3fdbcb7b, 0x15200000 */
+ivln10lo = 2.50829467116452752298e-11, /* 0x3dbb9438, 0xca9aadd5 */
+log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */
+log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */
+
+static const double zero = 0.0;
+
+double log10(double x)
+{
+ double f,hfsq,hi,lo,r,val_hi,val_lo,w,y,y2;
+ int32_t i,k,hx;
+ uint32_t lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+
+ k = 0;
+ if (hx < 0x00100000) { /* x < 2**-1022 */
+ if (((hx&0x7fffffff)|lx) == 0)
+ return -two54/zero; /* log(+-0)=-inf */
+ if (hx<0)
+ return (x-x)/zero; /* log(-#) = NaN */
+ /* subnormal number, scale up x */
+ k -= 54;
+ x *= two54;
+ 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 = __log1p(f);
+
+ /* See log2.c for details. */
+ hi = f - hfsq;
+ SET_LOW_WORD(hi, 0);
+ lo = (f - hi) - hfsq + r;
+ val_hi = hi*ivln10hi;
+ y2 = y*log10_2hi;
+ val_lo = y*log10_2lo + (lo+hi)*ivln10lo + lo*ivln10hi;
+
+ /*
+ * Extra precision in for adding y*log10_2hi is not strictly needed
+ * since there is no very large cancellation near x = sqrt(2) or
+ * x = 1/sqrt(2), but we do it anyway since it costs little on CPUs
+ * with some parallelism and it reduces the error for many args.
+ */
+ w = y2 + val_hi;
+ val_lo += (y2 - w) + val_hi;
+ val_hi = w;
+
+ return val_lo + val_hi;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_log10f.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * See comments in log10.c.
+ */
+
+#include "libm.h"
+#include "__log1pf.h"
+
+static const float
+two25 = 3.3554432000e+07, /* 0x4c000000 */
+ivln10hi = 4.3432617188e-01, /* 0x3ede6000 */
+ivln10lo = -3.1689971365e-05, /* 0xb804ead9 */
+log10_2hi = 3.0102920532e-01, /* 0x3e9a2080 */
+log10_2lo = 7.9034151668e-07; /* 0x355427db */
+
+static const float zero = 0.0;
+
+float log10f(float x)
+{
+ float f,hfsq,hi,lo,r,y;
+ int32_t i,k,hx;
+
+ GET_FLOAT_WORD(hx, x);
+
+ k = 0;
+ if (hx < 0x00800000) { /* x < 2**-126 */
+ if ((hx&0x7fffffff) == 0)
+ return -two25/zero; /* log(+-0)=-inf */
+ if (hx < 0)
+ return (x-x)/zero; /* log(-#) = NaN */
+ /* subnormal number, scale up x */
+ k -= 25;
+ x *= two25;
+ GET_FLOAT_WORD(hx, x);
+ }
+ if (hx >= 0x7f800000)
+ return x+x;
+ if (hx == 0x3f800000)
+ return zero; /* log(1) = +0 */
+ k += (hx>>23) - 127;
+ hx &= 0x007fffff;
+ i = (hx+(0x4afb0d))&0x800000;
+ SET_FLOAT_WORD(x, hx|(i^0x3f800000)); /* normalize x or x/2 */
+ k += i>>23;
+ y = (float)k;
+ f = x - (float)1.0;
+ hfsq = (float)0.5*f*f;
+ r = __log1pf(f);
+
+// FIXME
+// /* See log2f.c and log2.c for details. */
+// if (sizeof(float_t) > sizeof(float))
+// return (r - hfsq + f) * ((float_t)ivln10lo + ivln10hi) +
+// y * ((float_t)log10_2lo + log10_2hi);
+ hi = f - hfsq;
+ GET_FLOAT_WORD(hx, hi);
+ SET_FLOAT_WORD(hi, hx&0xfffff000);
+ lo = (f - hi) - hfsq + r;
+ return y*log10_2lo + (lo+hi)*ivln10lo + lo*ivln10hi +
+ hi*ivln10hi + y*log10_2hi;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_log10l.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Common logarithm, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log10l();
+ *
+ * y = log10l( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base 10 logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 9.0e-20 2.6e-20
+ * IEEE exp(+-10000) 30000 6.0e-20 2.3e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns MINLOG
+ * log domain: x < 0; returns MINLOG
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double log10l(long double x)
+{
+ return log10(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.2e-22
+ */
+static long double P[] = {
+ 4.9962495940332550844739E-1L,
+ 1.0767376367209449010438E1L,
+ 7.7671073698359539859595E1L,
+ 2.5620629828144409632571E2L,
+ 4.2401812743503691187826E2L,
+ 3.4258224542413922935104E2L,
+ 1.0747524399916215149070E2L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 2.3479774160285863271658E1L,
+ 1.9444210022760132894510E2L,
+ 7.7952888181207260646090E2L,
+ 1.6911722418503949084863E3L,
+ 2.0307734695595183428202E3L,
+ 1.2695660352705325274404E3L,
+ 3.2242573199748645407652E2L,
+};
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+/* log10(2) */
+#define L102A 0.3125L
+#define L102B -1.1470004336018804786261e-2L
+/* log10(e) */
+#define L10EA 0.5L
+#define L10EB -6.5705518096748172348871e-2L
+
+#define SQRTH 0.70710678118654752440L
+
+long double log10l(long double x)
+{
+ long double y;
+ volatile long double z;
+ int e;
+
+ if (isnan(x))
+ return x;
+ if(x <= 0.0L) {
+ if(x == 0.0L)
+ return -1.0L / (x - x);
+ return (x - x) / (x - x);
+ }
+ if (x == INFINITY)
+ return INFINITY;
+ /* 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 * __polevll(z, R, 3) / __p1evll(z, S, 3));
+ goto done;
+ }
+
+ /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+ if (x < SQRTH) {
+ e -= 1;
+ x = ldexpl(x, 1) - 1.0L; /* 2x - 1 */
+ } else {
+ x = x - 1.0L;
+ }
+ z = x*x;
+ y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 7));
+ y = y - ldexpl(z, -1); /* -0.5x^2 + ... */
+
+done:
+ /* Multiply log of fraction by log10(e)
+ * and base 2 exponent by log10(2).
+ *
+ * ***CAUTION***
+ *
+ * This sequence of operations is critical and it may
+ * be horribly defeated by some compiler optimizers.
+ */
+ z = y * (L10EB);
+ z += x * (L10EB);
+ z += e * (L102B);
+ z += y * (L10EA);
+ z += x * (L10EA);
+ z += e * (L102A);
+ return z;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_log1p.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* double log1p(double x)
+ *
+ * Method :
+ * 1. Argument Reduction: find k and f such that
+ * 1+x = 2^k * (1+f),
+ * where sqrt(2)/2 < 1+f < sqrt(2) .
+ *
+ * Note. If k=0, then f=x is exact. However, if k!=0, then f
+ * may not be representable exactly. In that case, a correction
+ * term is need. Let u=1+x rounded. Let c = (1+x)-u, then
+ * log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u),
+ * and add back the correction term c/u.
+ * (Note: when x > 2**53, one can simply return log(x))
+ *
+ * 2. Approximation of log1p(f).
+ * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
+ * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
+ * = 2s + s*R
+ * We use a special Reme algorithm on [0,0.1716] to generate
+ * a polynomial of degree 14 to approximate R The maximum error
+ * of this polynomial approximation is bounded by 2**-58.45. In
+ * other words,
+ * 2 4 6 8 10 12 14
+ * R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s
+ * (the values of Lp1 to Lp7 are listed in the program)
+ * and
+ * | 2 14 | -58.45
+ * | Lp1*s +...+Lp7*s - R(z) | <= 2
+ * | |
+ * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
+ * In order to guarantee error in log below 1ulp, we compute log
+ * by
+ * log1p(f) = f - (hfsq - s*(hfsq+R)).
+ *
+ * 3. Finally, log1p(x) = k*ln2 + log1p(f).
+ * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
+ * Here ln2 is split into two floating point number:
+ * ln2_hi + ln2_lo,
+ * where n*ln2_hi is always exact for |n| < 2000.
+ *
+ * Special cases:
+ * log1p(x) is NaN with signal if x < -1 (including -INF) ;
+ * log1p(+INF) is +INF; log1p(-1) is -INF with signal;
+ * log1p(NaN) is that NaN with no signal.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ *
+ * Note: Assuming log() return accurate answer, the following
+ * algorithm can be used to compute log1p(x) to within a few ULP:
+ *
+ * u = 1+x;
+ * if(u==1.0) return x ; else
+ * return log(u)*(x/(u-1.0));
+ *
+ * See HP-15C Advanced Functions Handbook, p.193.
+ */
+
+#include "libm.h"
+
+static const double
+ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
+ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
+two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
+Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
+Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
+Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
+Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
+Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
+Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
+Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
+
+static const double zero = 0.0;
+
+double log1p(double x)
+{
+ double hfsq,f,c,s,z,R,u;
+ int32_t k,hx,hu,ax;
+
+ GET_HIGH_WORD(hx, x);
+ ax = hx & 0x7fffffff;
+
+ k = 1;
+ if (hx < 0x3FDA827A) { /* 1+x < sqrt(2)+ */
+ if (ax >= 0x3ff00000) { /* x <= -1.0 */
+ if (x == -1.0)
+ return -two54/zero; /* log1p(-1)=+inf */
+ return (x-x)/(x-x); /* log1p(x<-1)=NaN */
+ }
+ if (ax < 0x3e200000) { /* |x| < 2**-29 */
+ /* raise inexact */
+ if (two54 + x > zero && ax < 0x3c900000) /* |x| < 2**-54 */
+ return x;
+ return x - x*x*0.5;
+ }
+ if (hx > 0 || hx <= (int32_t)0xbfd2bec4) { /* sqrt(2)/2- <= 1+x < sqrt(2)+ */
+ k = 0;
+ f = x;
+ hu = 1;
+ }
+ }
+ if (hx >= 0x7ff00000)
+ return x+x;
+ if (k != 0) {
+ if (hx < 0x43400000) {
+ STRICT_ASSIGN(double, u, 1.0 + x);
+ GET_HIGH_WORD(hu, u);
+ k = (hu>>20) - 1023;
+ c = k > 0 ? 1.0-(u-x) : x-(u-1.0); /* correction term */
+ c /= u;
+ } else {
+ u = x;
+ GET_HIGH_WORD(hu,u);
+ k = (hu>>20) - 1023;
+ c = 0;
+ }
+ hu &= 0x000fffff;
+ /*
+ * The approximation to sqrt(2) used in thresholds is not
+ * critical. However, the ones used above must give less
+ * strict bounds than the one here so that the k==0 case is
+ * never reached from here, since here we have committed to
+ * using the correction term but don't use it if k==0.
+ */
+ if (hu < 0x6a09e) { /* u ~< sqrt(2) */
+ SET_HIGH_WORD(u, hu|0x3ff00000); /* normalize u */
+ } else {
+ k += 1;
+ SET_HIGH_WORD(u, hu|0x3fe00000); /* normalize u/2 */
+ hu = (0x00100000-hu)>>2;
+ }
+ f = u - 1.0;
+ }
+ hfsq = 0.5*f*f;
+ if (hu == 0) { /* |f| < 2**-20 */
+ if (f == zero) {
+ if(k == 0)
+ return zero;
+ c += k*ln2_lo;
+ return k*ln2_hi + c;
+ }
+ R = hfsq*(1.0 - 0.66666666666666666*f);
+ if (k == 0)
+ return f - R;
+ return k*ln2_hi - ((R-(k*ln2_lo+c))-f);
+ }
+ s = f/(2.0+f);
+ z = s*s;
+ R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7))))));
+ if (k == 0)
+ return f - (hfsq-s*(hfsq+R));
+ return k*ln2_hi - ((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_log1pf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+ln2_hi = 6.9313812256e-01, /* 0x3f317180 */
+ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */
+two25 = 3.355443200e+07, /* 0x4c000000 */
+Lp1 = 6.6666668653e-01, /* 3F2AAAAB */
+Lp2 = 4.0000000596e-01, /* 3ECCCCCD */
+Lp3 = 2.8571429849e-01, /* 3E924925 */
+Lp4 = 2.2222198546e-01, /* 3E638E29 */
+Lp5 = 1.8183572590e-01, /* 3E3A3325 */
+Lp6 = 1.5313838422e-01, /* 3E1CD04F */
+Lp7 = 1.4798198640e-01; /* 3E178897 */
+
+static const float zero = 0.0;
+
+float log1pf(float x)
+{
+ float hfsq,f,c,s,z,R,u;
+ int32_t k,hx,hu,ax;
+
+ GET_FLOAT_WORD(hx, x);
+ ax = hx & 0x7fffffff;
+
+ k = 1;
+ if (hx < 0x3ed413d0) { /* 1+x < sqrt(2)+ */
+ if (ax >= 0x3f800000) { /* x <= -1.0 */
+ if (x == (float)-1.0)
+ return -two25/zero; /* log1p(-1)=+inf */
+ return (x-x)/(x-x); /* log1p(x<-1)=NaN */
+ }
+ if (ax < 0x38000000) { /* |x| < 2**-15 */
+ /* raise inexact */
+ if (two25 + x > zero && ax < 0x33800000) /* |x| < 2**-24 */
+ return x;
+ return x - x*x*(float)0.5;
+ }
+ if (hx > 0 || hx <= (int32_t)0xbe95f619) { /* sqrt(2)/2- <= 1+x < sqrt(2)+ */
+ k = 0;
+ f = x;
+ hu = 1;
+ }
+ }
+ if (hx >= 0x7f800000)
+ return x+x;
+ if (k != 0) {
+ if (hx < 0x5a000000) {
+ STRICT_ASSIGN(float, u, (float)1.0 + x);
+ GET_FLOAT_WORD(hu, u);
+ k = (hu>>23) - 127;
+ /* correction term */
+ c = k > 0 ? (float)1.0-(u-x) : x-(u-(float)1.0);
+ c /= u;
+ } else {
+ u = x;
+ GET_FLOAT_WORD(hu,u);
+ k = (hu>>23) - 127;
+ c = 0;
+ }
+ hu &= 0x007fffff;
+ /*
+ * The approximation to sqrt(2) used in thresholds is not
+ * critical. However, the ones used above must give less
+ * strict bounds than the one here so that the k==0 case is
+ * never reached from here, since here we have committed to
+ * using the correction term but don't use it if k==0.
+ */
+ if (hu < 0x3504f4) { /* u < sqrt(2) */
+ SET_FLOAT_WORD(u, hu|0x3f800000); /* normalize u */
+ } else {
+ k += 1;
+ SET_FLOAT_WORD(u, hu|0x3f000000); /* normalize u/2 */
+ hu = (0x00800000-hu)>>2;
+ }
+ f = u - (float)1.0;
+ }
+ hfsq = (float)0.5*f*f;
+ if (hu == 0) { /* |f| < 2**-20 */
+ if (f == zero) {
+ if (k == 0)
+ return zero;
+ c += k*ln2_lo;
+ return k*ln2_hi+c;
+ }
+ R = hfsq*((float)1.0-(float)0.66666666666666666*f);
+ if (k == 0)
+ return f - R;
+ return k*ln2_hi - ((R-(k*ln2_lo+c))-f);
+ }
+ s = f/((float)2.0+f);
+ z = s*s;
+ R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7))))));
+ if (k == 0)
+ return f - (hfsq-s*(hfsq+R));
+ return k*ln2_hi - ((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f);
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/s_log1pl.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Relative error logarithm
+ * Natural logarithm of 1+x, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log1pl();
+ *
+ * y = log1pl( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base e (2.718...) logarithm of 1+x.
+ *
+ * The argument 1+x is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z^3 P(z)/Q(z).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -1.0, 9.0 100000 8.2e-20 2.5e-20
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x-1 = 0; returns -INFINITY
+ * log domain: x-1 < 0; returns NAN
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double log1pl(long double x)
+{
+ return log1p(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/* Coefficients for log(1+x) = x - x^2 / 2 + x^3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 2.32e-20
+ */
+static long double P[] = {
+ 4.5270000862445199635215E-5L,
+ 4.9854102823193375972212E-1L,
+ 6.5787325942061044846969E0L,
+ 2.9911919328553073277375E1L,
+ 6.0949667980987787057556E1L,
+ 5.7112963590585538103336E1L,
+ 2.0039553499201281259648E1L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 1.5062909083469192043167E1L,
+ 8.3047565967967209469434E1L,
+ 2.2176239823732856465394E2L,
+ 3.0909872225312059774938E2L,
+ 2.1642788614495947685003E2L,
+ 6.0118660497603843919306E1L,
+};
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+static const long double C1 = 6.9314575195312500000000E-1L;
+static const long double C2 = 1.4286068203094172321215E-6L;
+
+#define SQRTH 0.70710678118654752440L
+
+long double log1pl(long double xm1)
+{
+ long double x, y, z;
+ int e;
+
+ if (isnan(xm1))
+ return xm1;
+ if (xm1 == INFINITY)
+ return xm1;
+ if (xm1 == 0.0)
+ return xm1;
+
+ x = xm1 + 1.0L;
+
+ /* Test for domain errors. */
+ if (x <= 0.0L) {
+ if (x == 0.0L)
+ return -INFINITY;
+ return NAN;
+ }
+
+ /* Separate mantissa from exponent.
+ Use frexp 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;
+ z = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3));
+ z = z + e * C2;
+ z = z + x;
+ z = z + e * C1;
+ return z;
+ }
+
+ /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+ if (x < SQRTH) {
+ e -= 1;
+ if (e != 0)
+ x = 2.0 * x - 1.0L;
+ else
+ x = xm1;
+ } else {
+ if (e != 0)
+ x = x - 1.0L;
+ else
+ x = xm1;
+ }
+ z = x*x;
+ y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 6));
+ y = y + e * C2;
+ z = y - 0.5 * z;
+ z = z + x;
+ z = z + e * C1;
+ return z;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_log2.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * Return the base 2 logarithm of x. See log.c and __log1p.h for most
+ * comments.
+ *
+ * This reduces x to {k, 1+f} exactly as in e_log.c, then calls the kernel,
+ * then does the combining and scaling steps
+ * log2(x) = (f - 0.5*f*f + k_log1p(f)) / ln2 + k
+ * in not-quite-routine extra precision.
+ */
+
+#include "libm.h"
+#include "__log1p.h"
+
+static const double
+two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
+ivln2hi = 1.44269504072144627571e+00, /* 0x3ff71547, 0x65200000 */
+ivln2lo = 1.67517131648865118353e-10; /* 0x3de705fc, 0x2eefa200 */
+
+static const double zero = 0.0;
+
+double log2(double x)
+{
+ double f,hfsq,hi,lo,r,val_hi,val_lo,w,y;
+ int32_t i,k,hx;
+ uint32_t lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+
+ k = 0;
+ if (hx < 0x00100000) { /* x < 2**-1022 */
+ if (((hx&0x7fffffff)|lx) == 0)
+ return -two54/zero; /* log(+-0)=-inf */
+ if (hx < 0)
+ return (x-x)/zero; /* log(-#) = NaN */
+ /* subnormal number, scale up x */
+ k -= 54;
+ x *= two54;
+ 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 = __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;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_log2f.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * See comments in log2.c.
+ */
+
+#include "libm.h"
+#include "__log1pf.h"
+
+static const float
+two25 = 3.3554432000e+07, /* 0x4c000000 */
+ivln2hi = 1.4428710938e+00, /* 0x3fb8b000 */
+ivln2lo = -1.7605285393e-04; /* 0xb9389ad4 */
+
+static const float zero = 0.0;
+
+float log2f(float x)
+{
+ float f,hfsq,hi,lo,r,y;
+ int32_t i,k,hx;
+
+ GET_FLOAT_WORD(hx, x);
+
+ k = 0;
+ if (hx < 0x00800000) { /* x < 2**-126 */
+ if ((hx&0x7fffffff) == 0)
+ return -two25/zero; /* log(+-0)=-inf */
+ if (hx < 0)
+ return (x-x)/zero; /* log(-#) = NaN */
+ /* subnormal number, scale up x */
+ k -= 25;
+ x *= two25;
+ GET_FLOAT_WORD(hx, x);
+ }
+ if (hx >= 0x7f800000)
+ return x+x;
+ if (hx == 0x3f800000)
+ return zero; /* log(1) = +0 */
+ k += (hx>>23) - 127;
+ hx &= 0x007fffff;
+ i = (hx+(0x4afb0d))&0x800000;
+ SET_FLOAT_WORD(x, hx|(i^0x3f800000)); /* normalize x or x/2 */
+ k += i>>23;
+ y = (float)k;
+ f = x - (float)1.0;
+ hfsq = (float)0.5*f*f;
+ r = __log1pf(f);
+
+ /*
+ * We no longer need to avoid falling into the multi-precision
+ * calculations due to compiler bugs breaking Dekker's theorem.
+ * Keep avoiding this as an optimization. See log2.c for more
+ * details (some details are here only because the optimization
+ * is not yet available in double precision).
+ *
+ * Another compiler bug turned up. With gcc on i386,
+ * (ivln2lo + ivln2hi) would be evaluated in float precision
+ * despite runtime evaluations using double precision. So we
+ * must cast one of its terms to float_t. This makes the whole
+ * expression have type float_t, so return is forced to waste
+ * time clobbering its extra precision.
+ */
+// FIXME
+// if (sizeof(float_t) > sizeof(float))
+// return (r - hfsq + f) * ((float_t)ivln2lo + ivln2hi) + y;
+
+ hi = f - hfsq;
+ GET_FLOAT_WORD(hx,hi);
+ SET_FLOAT_WORD(hi,hx&0xfffff000);
+ lo = (f - hi) - hfsq + r;
+ return (lo+hi)*ivln2lo + lo*ivln2hi + hi*ivln2hi + y;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_log2l.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Base 2 logarithm, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, log2l();
+ *
+ * y = log2l( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base 2 logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the (natural)
+ * logarithm of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 30000 9.8e-20 2.7e-20
+ * IEEE exp(+-10000) 70000 5.4e-20 2.3e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns -INFINITY
+ * log domain: x < 0; returns NAN
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double log2l(long double x)
+{
+ return log2(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.2e-22
+ */
+static long double P[] = {
+ 4.9962495940332550844739E-1L,
+ 1.0767376367209449010438E1L,
+ 7.7671073698359539859595E1L,
+ 2.5620629828144409632571E2L,
+ 4.2401812743503691187826E2L,
+ 3.4258224542413922935104E2L,
+ 1.0747524399916215149070E2L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 2.3479774160285863271658E1L,
+ 1.9444210022760132894510E2L,
+ 7.7952888181207260646090E2L,
+ 1.6911722418503949084863E3L,
+ 2.0307734695595183428202E3L,
+ 1.2695660352705325274404E3L,
+ 3.2242573199748645407652E2L,
+};
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+/* log2(e) - 1 */
+#define LOG2EA 4.4269504088896340735992e-1L
+
+#define SQRTH 0.70710678118654752440L
+
+long double log2l(long double x)
+{
+ volatile long double z;
+ long double y;
+ int e;
+
+ if (isnan(x))
+ return x;
+ if (x == INFINITY)
+ return x;
+ if (x <= 0.0L) {
+ if (x == 0.0L)
+ return -INFINITY;
+ return NAN;
+ }
+
+ /* 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 * __polevll(z, R, 3) / __p1evll(z, S, 3));
+ goto done;
+ }
+
+ /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+ if (x < SQRTH) {
+ e -= 1;
+ x = ldexpl(x, 1) - 1.0L; /* 2x - 1 */
+ } else {
+ x = x - 1.0L;
+ }
+ z = x*x;
+ y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 7));
+ y = y - ldexpl(z, -1); /* -0.5x^2 + ... */
+
+done:
+ /* Multiply log of fraction by log2(e)
+ * and base 2 exponent by 1
+ *
+ * ***CAUTION***
+ *
+ * This sequence of operations is critical and it may
+ * be horribly defeated by some compiler optimizers.
+ */
+ z = y * LOG2EA;
+ z += x * LOG2EA;
+ z += y;
+ z += x;
+ z += e;
+ return z;
+}
+#endif
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+/*
+special cases:
+ logb(+-0) = -inf
+ logb(+-inf) = +inf
+ logb(nan) = nan
+these are calculated at runtime to raise fp exceptions
+*/
+
+double logb(double x) {
+ int i = ilogb(x);
+
+ if (i == FP_ILOGB0)
+ return -1.0/fabs(x);
+ if (i == FP_ILOGBNAN || i == INT_MAX)
+ return x * x;
+ return i;
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+float logbf(float x) {
+ int i = ilogbf(x);
+
+ if (i == FP_ILOGB0)
+ return -1.0f/fabsf(x);
+ if (i == FP_ILOGBNAN || i == INT_MAX)
+ return x * x;
+ return i;
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double logbl(long double x)
+{
+ return logb(x);
+}
+#else
+long double logbl(long double x)
+{
+ int i = ilogbl(x);
+
+ if (i == FP_ILOGB0)
+ return -1.0/fabsl(x);
+ if (i == FP_ILOGBNAN || i == INT_MAX)
+ return x * x;
+ return i;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_logf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+ln2_hi = 6.9313812256e-01, /* 0x3f317180 */
+ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */
+two25 = 3.355443200e+07, /* 0x4c000000 */
+/* |(log(1+s)-log(1-s))/s - Lg(s)| < 2**-34.24 (~[-4.95e-11, 4.97e-11]). */
+Lg1 = 0xaaaaaa.0p-24, /* 0.66666662693 */
+Lg2 = 0xccce13.0p-25, /* 0.40000972152 */
+Lg3 = 0x91e9ee.0p-25, /* 0.28498786688 */
+Lg4 = 0xf89e26.0p-26; /* 0.24279078841 */
+
+static const float zero = 0.0;
+
+float logf(float x)
+{
+ float hfsq,f,s,z,R,w,t1,t2,dk;
+ int32_t k,ix,i,j;
+
+ GET_FLOAT_WORD(ix, x);
+
+ k = 0;
+ if (ix < 0x00800000) { /* x < 2**-126 */
+ if ((ix & 0x7fffffff) == 0)
+ return -two25/zero; /* log(+-0)=-inf */
+ if (ix < 0)
+ return (x-x)/zero; /* log(-#) = NaN */
+ /* subnormal number, scale up x */
+ k -= 25;
+ x *= two25;
+ GET_FLOAT_WORD(ix, x);
+ }
+ if (ix >= 0x7f800000)
+ return x+x;
+ k += (ix>>23) - 127;
+ ix &= 0x007fffff;
+ i = (ix + (0x95f64<<3)) & 0x800000;
+ SET_FLOAT_WORD(x, ix|(i^0x3f800000)); /* normalize x or x/2 */
+ k += i>>23;
+ f = x - (float)1.0;
+ if ((0x007fffff & (0x8000 + ix)) < 0xc000) { /* -2**-9 <= f < 2**-9 */
+ if (f == zero) {
+ if (k == 0)
+ return zero;
+ dk = (float)k;
+ return dk*ln2_hi + dk*ln2_lo;
+ }
+ R = f*f*((float)0.5 - (float)0.33333333333333333*f);
+ if (k == 0)
+ return f-R;
+ dk = (float)k;
+ return dk*ln2_hi - ((R-dk*ln2_lo)-f);
+ }
+ s = f/((float)2.0+f);
+ dk = (float)k;
+ z = s*s;
+ i = ix-(0x6147a<<3);
+ w = z*z;
+ j = (0x6b851<<3)-ix;
+ t1= w*(Lg2+w*Lg4);
+ t2= z*(Lg1+w*Lg3);
+ i |= j;
+ R = t2 + t1;
+ if (i > 0) {
+ hfsq = (float)0.5*f*f;
+ if (k == 0)
+ return f - (hfsq-s*(hfsq+R));
+ return dk*ln2_hi - ((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f);
+ } else {
+ if (k == 0)
+ return f - s*(f-R);
+ return dk*ln2_hi - ((s*(f-R)-dk*ln2_lo)-f);
+ }
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_logl.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Natural logarithm, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, logl();
+ *
+ * y = logl( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the base e (2.718...) logarithm of x.
+ *
+ * The argument is separated into its exponent and fractional
+ * parts. If the exponent is between -1 and +1, the logarithm
+ * of the fraction is approximated by
+ *
+ * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
+ *
+ * Otherwise, setting z = 2(x-1)/x+1),
+ *
+ * log(x) = z + z**3 P(z)/Q(z).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE 0.5, 2.0 150000 8.71e-20 2.75e-20
+ * IEEE exp(+-10000) 100000 5.39e-20 2.34e-20
+ *
+ * In the tests over the interval exp(+-10000), the logarithms
+ * of the random arguments were uniformly distributed over
+ * [-10000, +10000].
+ *
+ * ERROR MESSAGES:
+ *
+ * log singularity: x = 0; returns -INFINITY
+ * log domain: x < 0; returns NAN
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double logl(long double x)
+{
+ return log(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 2.32e-20
+ */
+static long double P[] = {
+ 4.5270000862445199635215E-5L,
+ 4.9854102823193375972212E-1L,
+ 6.5787325942061044846969E0L,
+ 2.9911919328553073277375E1L,
+ 6.0949667980987787057556E1L,
+ 5.7112963590585538103336E1L,
+ 2.0039553499201281259648E1L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0,*/
+ 1.5062909083469192043167E1L,
+ 8.3047565967967209469434E1L,
+ 2.2176239823732856465394E2L,
+ 3.0909872225312059774938E2L,
+ 2.1642788614495947685003E2L,
+ 6.0118660497603843919306E1L,
+};
+
+/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2),
+ * where z = 2(x-1)/(x+1)
+ * 1/sqrt(2) <= x < sqrt(2)
+ * Theoretical peak relative error = 6.16e-22
+ */
+static long double R[4] = {
+ 1.9757429581415468984296E-3L,
+-7.1990767473014147232598E-1L,
+ 1.0777257190312272158094E1L,
+-3.5717684488096787370998E1L,
+};
+static long double S[4] = {
+/* 1.00000000000000000000E0L,*/
+-2.6201045551331104417768E1L,
+ 1.9361891836232102174846E2L,
+-4.2861221385716144629696E2L,
+};
+static const long double C1 = 6.9314575195312500000000E-1L;
+static const long double C2 = 1.4286068203094172321215E-6L;
+
+#define SQRTH 0.70710678118654752440L
+
+long double logl(long double x)
+{
+ long double y, z;
+ int e;
+
+ if (isnan(x))
+ return x;
+ if (x == INFINITY)
+ return x;
+ if (x <= 0.0L) {
+ if (x == 0.0L)
+ return -INFINITY;
+ return NAN;
+ }
+
+ /* 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;
+ z = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3));
+ z = z + e * C2;
+ z = z + x;
+ z = z + e * C1;
+ return z;
+ }
+
+ /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
+ if (x < SQRTH) {
+ e -= 1;
+ x = ldexpl(x, 1) - 1.0L; /* 2x - 1 */
+ } else {
+ x = x - 1.0L;
+ }
+ z = x*x;
+ y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 6));
+ y = y + e * C2;
+ z = y - ldexpl(z, -1); /* y - 0.5 * z */
+ /* Note, the sum of above terms does not exceed x/4,
+ * so it contributes at most about 1/4 lsb to the error.
+ */
+ z = z + x;
+ z = z + e * C1; /* This sum has an error of 1/2 lsb. */
+ return z;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_lrint.c */
+/*-
+ * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <fenv.h>
+#include "libm.h"
+
+#ifndef type
+#define type double
+#define roundit rint
+#define dtype long
+#define fn lrint
+#endif
+
+/*
+ * C99 says we should not raise a spurious inexact exception when an
+ * invalid exception is raised. Unfortunately, the set of inputs
+ * that overflows depends on the rounding mode when 'dtype' has more
+ * significant bits than 'type'. Hence, we bend over backwards for the
+ * sake of correctness; an MD implementation could be more efficient.
+ */
+dtype fn(type x)
+{
+ fenv_t env;
+ dtype d;
+
+ feholdexcept(&env);
+ d = (dtype)roundit(x);
+ if (fetestexcept(FE_INVALID))
+ feclearexcept(FE_INEXACT);
+ feupdateenv(&env);
+ return d;
+}
--- /dev/null
+#define type float
+#define roundit rintf
+#define dtype long
+#define fn lrintf
+
+#include "lrint.c"
--- /dev/null
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long lrintl(long double x)
+{
+ return lrint(x);
+}
+#else
+#define type long double
+#define roundit rintl
+#define dtype long
+#define fn lrintl
+
+#include "lrint.c"
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_lround.c */
+/*-
+ * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <limits.h>
+#include <fenv.h>
+#include "libm.h"
+
+#ifndef type
+#define type double
+#define roundit round
+#define dtype long
+#define DTYPE_MIN LONG_MIN
+#define DTYPE_MAX LONG_MAX
+#define fn lround
+#endif
+
+/*
+ * If type has more precision than dtype, the endpoints dtype_(min|max) are
+ * of the form xxx.5; they are "out of range" because lround() rounds away
+ * from 0. On the other hand, if type has less precision than dtype, then
+ * all values that are out of range are integral, so we might as well assume
+ * that everything is in range. At compile time, INRANGE(x) should reduce to
+ * two floating-point comparisons in the former case, or TRUE otherwise.
+ */
+static const type dtype_min = DTYPE_MIN - 0.5;
+static const type dtype_max = DTYPE_MAX + 0.5;
+#define INRANGE(x) \
+ (dtype_max - DTYPE_MAX != 0.5 || ((x) > dtype_min && (x) < dtype_max))
+
+dtype fn(type x)
+{
+
+ if (INRANGE(x)) {
+ x = roundit(x);
+ return (dtype)x;
+ } else {
+ feraiseexcept(FE_INVALID);
+ return DTYPE_MAX;
+ }
+}
--- /dev/null
+#define type float
+#define roundit roundf
+#define dtype long
+#define DTYPE_MIN LONG_MIN
+#define DTYPE_MAX LONG_MAX
+#define fn lroundf
+
+#include "lround.c"
--- /dev/null
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long lroundl(long double x)
+{
+ return lround(x);
+}
+#else
+#define type long double
+#define roundit roundl
+#define dtype long
+#define DTYPE_MIN LONG_MIN
+#define DTYPE_MAX LONG_MAX
+#define fn lroundl
+
+#include "lround.c"
+#endif
+++ /dev/null
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#ifndef _MATH_PRIVATE_H_
-#define _MATH_PRIVATE_H_
-
-#include <inttypes.h>
-
-/*
- * The original fdlibm code used statements like:
- * n0 = ((*(int*)&one)>>29)^1; * index of high word *
- * ix0 = *(n0+(int*)&x); * high word of x *
- * ix1 = *((1-n0)+(int*)&x); * low word of x *
- * to dig two 32 bit words out of the 64 bit IEEE floating point
- * value. That is non-ANSI, and, moreover, the gcc instruction
- * scheduler gets it wrong. We instead use the following macros.
- * Unlike the original code, we determine the endianness at compile
- * time, not at run time; I don't see much benefit to selecting
- * endianness at run time.
- */
-
-/*
- * A union which permits us to convert between a double and two 32 bit
- * ints.
- */
-
-typedef union
-{
- double value;
- uint64_t words;
-} ieee_double_shape_type;
-
-/* Get two 32 bit ints from a double. */
-
-#define EXTRACT_WORDS(ix0,ix1,d) \
-do { \
- ieee_double_shape_type ew_u; \
- ew_u.value = (d); \
- (ix0) = ew_u.words >> 32; \
- (ix1) = (uint32_t)ew_u.words; \
-} while (0)
-
-/* Get the more significant 32 bit int from a double. */
-
-#define GET_HIGH_WORD(i,d) \
-do { \
- ieee_double_shape_type gh_u; \
- gh_u.value = (d); \
- (i) = gh_u.words >> 32; \
-} while (0)
-
-/* Get the less significant 32 bit int from a double. */
-
-#define GET_LOW_WORD(i,d) \
-do { \
- ieee_double_shape_type gl_u; \
- gl_u.value = (d); \
- (i) = (uint32_t)gl_u.words; \
-} while (0)
-
-/* Set a double from two 32 bit ints. */
-
-#define INSERT_WORDS(d,ix0,ix1) \
-do { \
- ieee_double_shape_type iw_u; \
- iw_u.words = ((uint64_t)(ix0) << 32) | (ix1); \
- (d) = iw_u.value; \
-} while (0)
-
-/* Set the more significant 32 bits of a double from an int. */
-
-#define SET_HIGH_WORD(d,v) \
-do { \
- ieee_double_shape_type sh_u; \
- sh_u.value = (d); \
- sh_u.words &= 0xffffffff; \
- sh_u.words |= ((uint64_t)(v) << 32); \
- (d) = sh_u.value; \
-} while (0)
-
-/* Set the less significant 32 bits of a double from an int. */
-
-#define SET_LOW_WORD(d,v) \
-do { \
- ieee_double_shape_type sl_u; \
- sl_u.value = (d); \
- sl_u.words &= 0xffffffff00000000ull; \
- sl_u.words |= (uint32_t)(v); \
- (d) = sl_u.value; \
-} while (0)
-
-/*
- * A union which permits us to convert between a float and a 32 bit
- * int.
- */
-
-typedef union
-{
- float value;
- uint32_t word;
-} ieee_float_shape_type;
-
-/* Get a 32 bit int from a float. */
-
-#define GET_FLOAT_WORD(i,d) \
-do { \
- ieee_float_shape_type gf_u; \
- gf_u.value = (d); \
- (i) = gf_u.word; \
-} while (0)
-
-/* Set a float from a 32 bit int. */
-
-#define SET_FLOAT_WORD(d,i) \
-do { \
- ieee_float_shape_type sf_u; \
- sf_u.word = (i); \
- (d) = sf_u.value; \
-} while (0)
-
-/* fdlibm kernel function */
-int __ieee754_rem_pio2(double,double*);
-double __kernel_sin(double,double,int);
-double __kernel_cos(double,double);
-double __kernel_tan(double,double,int);
-int __kernel_rem_pio2(double*,double*,int,int,int,const int*);
-
-/* float versions of fdlibm kernel functions */
-int __ieee754_rem_pio2f(float,float*);
-float __kernel_sinf(float,float,int);
-float __kernel_cosf(float,float);
-float __kernel_tanf(float,float,int);
-int __kernel_rem_pio2f(float*,float*,int,int,int,const int*);
-
-#endif /* !_MATH_PRIVATE_H_ */
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_modf.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * modf(double x, double *iptr)
+ * return fraction part of x, and return x's integral part in *iptr.
+ * Method:
+ * Bit twiddling.
+ *
+ * Exception:
+ * No exception.
+ */
+
+#include "libm.h"
+
+static const double one = 1.0;
+
+double modf(double x, double *iptr)
+{
+ int32_t i0,i1,j0;
+ uint32_t i;
+
+ EXTRACT_WORDS(i0, i1, x);
+ j0 = ((i0>>20) & 0x7ff) - 0x3ff; /* exponent of x */
+ if (j0 < 20) { /* integer part in high x */
+ if (j0 < 0) { /* |x| < 1 */
+ INSERT_WORDS(*iptr, i0 & 0x80000000, 0); /* *iptr = +-0 */
+ return x;
+ }
+ i = 0x000fffff >> j0;
+ if (((i0&i)|i1) == 0) { /* x is integral */
+ uint32_t high;
+ *iptr = x;
+ GET_HIGH_WORD(high, x);
+ INSERT_WORDS(x, high & 0x80000000, 0); /* return +-0 */
+ return x;
+ }
+ INSERT_WORDS(*iptr, i0&~i, 0);
+ return x - *iptr;
+ } else if (j0 > 51) { /* no fraction part */
+ uint32_t high;
+ if (j0 == 0x400) { /* inf/NaN */
+ *iptr = x;
+ return 0.0 / x;
+ }
+ *iptr = x*one;
+ GET_HIGH_WORD(high, x);
+ INSERT_WORDS(x, high & 0x80000000, 0); /* return +-0 */
+ return x;
+ } else { /* fraction part in low x */
+ i = (uint32_t)0xffffffff >> (j0 - 20);
+ if ((i1&i) == 0) { /* x is integral */
+ uint32_t high;
+ *iptr = x;
+ GET_HIGH_WORD(high, x);
+ INSERT_WORDS(x, high & 0x80000000, 0); /* return +-0 */
+ return x;
+ }
+ INSERT_WORDS(*iptr, i0, i1&~i);
+ return x - *iptr;
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_modff.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float one = 1.0;
+
+float modff(float x, float *iptr)
+{
+ int32_t i0,j0;
+ uint32_t i;
+
+ GET_FLOAT_WORD(i0, x);
+ j0 = ((i0>>23) & 0xff) - 0x7f; /* exponent of x */
+ if (j0 < 23) { /* integer part in x */
+ if (j0 < 0) { /* |x| < 1 */
+ SET_FLOAT_WORD(*iptr, i0 & 0x80000000); /* *iptr = +-0 */
+ return x;
+ }
+ i = 0x007fffff >> j0;
+ if ((i0&i) == 0) { /* x is integral */
+ uint32_t ix;
+ *iptr = x;
+ GET_FLOAT_WORD(ix, x);
+ SET_FLOAT_WORD(x, ix & 0x80000000); /* return +-0 */
+ return x;
+ }
+ SET_FLOAT_WORD(*iptr, i0&~i);
+ return x - *iptr;
+ } else { /* no fraction part */
+ uint32_t ix;
+ *iptr = x*one;
+ if (x != x) /* NaN */
+ return x;
+ GET_FLOAT_WORD(ix, x);
+ SET_FLOAT_WORD(x, ix & 0x80000000); /* return +-0 */
+ return x;
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_modfl.c */
+/*-
+ * Copyright (c) 2007 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * Derived from s_modf.c, which has the following Copyright:
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double modfl(long double x, long double *iptr)
+{
+ return modf(x, iptr);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#if LDBL_MANL_SIZE > 32
+#define MASK ((uint64_t)-1)
+#else
+#define MASK ((uint32_t)-1)
+#endif
+/* Return the last n bits of a word, representing the fractional part. */
+#define GETFRAC(bits, n) ((bits) & ~(MASK << (n)))
+/* The number of fraction bits in manh, not counting the integer bit */
+#define HIBITS (LDBL_MANT_DIG - LDBL_MANL_SIZE)
+
+static const long double zero[] = { 0.0L, -0.0L };
+
+long double modfl(long double x, long double *iptr)
+{
+ union IEEEl2bits ux;
+ int e;
+
+ ux.e = x;
+ e = ux.bits.exp - LDBL_MAX_EXP + 1;
+ if (e < HIBITS) { /* Integer part is in manh. */
+ if (e < 0) { /* |x|<1 */
+ *iptr = zero[ux.bits.sign];
+ return x;
+ }
+ if ((GETFRAC(ux.bits.manh, HIBITS - 1 - e)|ux.bits.manl) == 0) {
+ /* x is an integer. */
+ *iptr = x;
+ return zero[ux.bits.sign];
+ }
+ /* Clear all but the top e+1 bits. */
+ ux.bits.manh >>= HIBITS - 1 - e;
+ ux.bits.manh <<= HIBITS - 1 - e;
+ ux.bits.manl = 0;
+ *iptr = ux.e;
+ return x - ux.e;
+ } else if (e >= LDBL_MANT_DIG - 1) { /* x has no fraction part. */
+ *iptr = x;
+ if (x != x) /* Handle NaNs. */
+ return x;
+ return zero[ux.bits.sign];
+ } else { /* Fraction part is in manl. */
+ if (GETFRAC(ux.bits.manl, LDBL_MANT_DIG - 1 - e) == 0) {
+ /* x is integral. */
+ *iptr = x;
+ return zero[ux.bits.sign];
+ }
+ /* Clear all but the top e+1 bits. */
+ ux.bits.manl >>= LDBL_MANT_DIG - 1 - e;
+ ux.bits.manl <<= LDBL_MANT_DIG - 1 - e;
+ *iptr = ux.e;
+ return x - ux.e;
+ }
+}
+#endif
--- /dev/null
+#include <fenv.h>
+#include "libm.h"
+
+/*
+rint may raise inexact (and it should not alter the fenv otherwise)
+nearbyint must not raise inexact
+
+(according to ieee754r section 7.9 both functions should raise invalid
+when the input is signaling nan, but c99 does not define snan so saving
+and restoring the entire fenv should be fine)
+*/
+
+double nearbyint(double x) {
+ fenv_t e;
+
+ fegetenv(&e);
+ x = rint(x);
+ fesetenv(&e);
+ return x;
+}
--- /dev/null
+#include <fenv.h>
+#include "libm.h"
+
+float nearbyintf(float x) {
+ fenv_t e;
+
+ fegetenv(&e);
+ x = rintf(x);
+ fesetenv(&e);
+ return x;
+}
--- /dev/null
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double nearbyintl(long double x)
+{
+ return nearbyint(x);
+}
+#else
+#include <fenv.h>
+long double nearbyintl(long double x)
+{
+ fenv_t e;
+
+ fegetenv(&e);
+ x = rintl(x);
+ fesetenv(&e);
+ return x;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_nextafter.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* IEEE functions
+ * nextafter(x,y)
+ * return the next machine floating-point number of x in the
+ * direction toward y.
+ * Special cases:
+ */
+
+#include "libm.h"
+
+double nextafter(double x, double y)
+{
+ volatile double t;
+ int32_t hx,hy,ix,iy;
+ uint32_t lx,ly;
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hy, ly, y);
+ ix = hx & 0x7fffffff; /* |x| */
+ iy = hy & 0x7fffffff; /* |y| */
+
+ if ((ix >= 0x7ff00000 && (ix-0x7ff00000)|lx) != 0 || /* x is nan */
+ (iy >= 0x7ff00000 && (iy-0x7ff00000)|ly) != 0) /* y is nan */
+ return x+y;
+ if (x == y) /* x == y */
+ return y;
+ if ((ix|lx) == 0) { /* x == 0 */
+ INSERT_WORDS(x, hy&0x80000000, 1); /* return +-minsubnormal */
+ /* raise underflow flag */
+ t = x*x;
+ if (t == x)
+ return t;
+ return x;
+ }
+ if (hx >= 0) { /* x > 0 */
+ if (hx > hy || (hx == hy && lx > ly)) { /* x > y, x -= ulp */
+ if (lx == 0)
+ hx--;
+ lx--;
+ } else { /* x < y, x += ulp */
+ lx++;
+ if (lx == 0)
+ hx++;
+ }
+ } else { /* x < 0 */
+ if (hy >= 0 || hx > hy || (hx == hy && lx > ly)) { /* x < y, x -= ulp */
+ if (lx == 0)
+ hx--;
+ lx--;
+ } else { /* x > y, x += ulp */
+ lx++;
+ if (lx == 0)
+ hx++;
+ }
+ }
+ hy = hx & 0x7ff00000;
+ if (hy >= 0x7ff00000) /* overflow */
+ return x+x;
+ if (hy < 0x00100000) { /* underflow */
+ /* raise underflow flag */
+ t = x*x;
+ if (t != x) {
+ INSERT_WORDS(y, hx, lx);
+ return y;
+ }
+ }
+ INSERT_WORDS(x, hx, lx);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_nextafterf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+float nextafterf(float x, float y)
+{
+ volatile float t;
+ int32_t hx,hy,ix,iy;
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hy, y);
+ ix = hx & 0x7fffffff; /* |x| */
+ iy = hy & 0x7fffffff; /* |y| */
+
+ if (ix > 0x7f800000 || /* x is nan */
+ iy > 0x7f800000) /* y is nan */
+ return x+y;
+ if (x == y) /* x == y */
+ return y;
+ if (ix == 0) { /* x == 0 */
+ SET_FLOAT_WORD(x, (hy&0x80000000)|1); /* return +-minsubnormal */
+ /* raise underflow flag */
+ t = x*x;
+ if (t == x)
+ return t;
+ return x;
+ }
+ if (hx >= 0) { /* x > 0 */
+ if (hx > hy) { /* x > y, x -= ulp */
+ hx--;
+ } else { /* x < y, x += ulp */
+ hx++;
+ }
+ } else { /* x < 0 */
+ if (hy >= 0 || hx > hy) { /* x < y, x -= ulp */
+ hx--;
+ } else { /* x > y, x += ulp */
+ hx++;
+ }
+ }
+ hy = hx & 0x7f800000;
+ if (hy >= 0x7f800000) /* overflow */
+ return x+x;
+ if (hy < 0x00800000) { /* underflow */
+ /* raise underflow flag */
+ t = x*x;
+ if (t != x) {
+ SET_FLOAT_WORD(y, hx);
+ return y;
+ }
+ }
+ SET_FLOAT_WORD(x, hx);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_nextafterl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* IEEE functions
+ * nextafter(x,y)
+ * return the next machine floating-point number of x in the
+ * direction toward y.
+ * Special cases:
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double nextafterl(long double x, long double y)
+{
+ return nextafter(x, y);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+long double nextafterl(long double x, long double y)
+{
+ volatile long double t;
+ union IEEEl2bits ux, uy;
+
+ ux.e = x;
+ uy.e = y;
+
+ if ((ux.bits.exp == 0x7fff && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl) != 0) ||
+ (uy.bits.exp == 0x7fff && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0))
+ return x+y; /* x or y is nan */
+ if (x == y)
+ return y; /* x=y, return y */
+ if (x == 0.0) {
+ /* return +-minsubnormal */
+ ux.bits.manh = 0;
+ ux.bits.manl = 1;
+ ux.bits.sign = uy.bits.sign;
+ /* raise underflow flag */
+ t = ux.e*ux.e;
+ if (t == ux.e)
+ return t;
+ return ux.e;
+ }
+ if(x > 0.0 ^ x < y) { /* x -= ulp */
+ if (ux.bits.manl == 0) {
+ if ((ux.bits.manh&~LDBL_NBIT) == 0)
+ ux.bits.exp--;
+ ux.bits.manh = (ux.bits.manh - 1) | (ux.bits.manh & LDBL_NBIT);
+ }
+ ux.bits.manl--;
+ } else { /* x += ulp */
+ ux.bits.manl++;
+ if (ux.bits.manl == 0) {
+ ux.bits.manh = (ux.bits.manh + 1) | (ux.bits.manh & LDBL_NBIT);
+ if ((ux.bits.manh&~LDBL_NBIT)==0)
+ ux.bits.exp++;
+ }
+ }
+ if (ux.bits.exp == 0x7fff) /* overflow */
+ return x+x;
+ if (ux.bits.exp == 0) { /* underflow */
+ mask_nbit_l(ux);
+ /* raise underflow flag */
+ t = ux.e * ux.e;
+ if (t != ux.e)
+ return ux.e;
+ }
+ return ux.e;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_nexttoward.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+double nexttoward(double x, long double y)
+{
+ return nextafter(x, y);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+double nexttoward(double x, long double y)
+{
+ union IEEEl2bits uy;
+ volatile double t;
+ int32_t hx,ix;
+ uint32_t lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+ ix = hx & 0x7fffffff;
+ uy.e = y;
+
+ if ((ix >= 0x7ff00000 && ((ix-0x7ff00000)|lx) != 0) ||
+ (uy.bits.exp == 0x7fff && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0))
+ return x + y; /* x or y is nan */
+ if (x == y)
+ return (double)y;
+ if (x == 0.0) {
+ INSERT_WORDS(x, uy.bits.sign<<31, 1); /* return +-minsubnormal */
+ /* raise underflow */
+ t = x * x;
+ if (t == x)
+ return t;
+ return x;
+ }
+ if (hx > 0.0 ^ x < y) { /* x -= ulp */
+ if (lx == 0)
+ hx--;
+ lx--;
+ } else { /* x += ulp */
+ lx++;
+ if (lx == 0)
+ hx++;
+ }
+ ix = hx & 0x7ff00000;
+ if (ix >= 0x7ff00000) /* overflow */
+ return x + x;
+ if (ix < 0x00100000) { /* underflow */
+ /* raise underflow flag */
+ t = x * x;
+ if (t != x) {
+ INSERT_WORDS(x, hx, lx);
+ return x;
+ }
+ }
+ INSERT_WORDS(x, hx, lx);
+ return x;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_nexttowardf.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+// FIXME
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#define LDBL_INFNAN_EXP (LDBL_MAX_EXP * 2 - 1)
+
+float nexttowardf(float x, long double y)
+{
+ union IEEEl2bits uy;
+ volatile float t;
+ int32_t hx,ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff; /* |x| */
+ uy.e = y;
+
+ if (ix > 0x7f800000 ||
+ (uy.bits.exp == LDBL_INFNAN_EXP &&
+ ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0))
+ return x + y; /* x or y is nan */
+ if (x == y)
+ return (float)y; /* x=y, return y */
+ if (ix == 0) { /* x == 0 */
+ SET_FLOAT_WORD(x, (uy.bits.sign<<31)|1); /* return +-minsubnormal */
+ /* raise underflow flag */
+ t = x*x;
+ if (t == x)
+ return t;
+ return x;
+ }
+ if (hx >= 0 ^ x < y) /* x -= ulp */
+ hx--;
+ else /* x += ulp */
+ hx++;
+ ix = hx & 0x7f800000;
+ if (ix >= 0x7f800000) /* overflow */
+ return x+x;
+ if (ix < 0x00800000) { /* underflow */
+ /* raise underflow flag */
+ t = x*x;
+ if (t != x) {
+ SET_FLOAT_WORD(x, hx);
+ return x;
+ }
+ }
+ SET_FLOAT_WORD(x, hx);
+ return x;
+}
+#endif
--- /dev/null
+#include "libm.h"
+
+long double nexttowardl(long double x, long double y)
+{
+ return nextafterl(x, y);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_pow.c */
+/*
+ * ====================================================
+ * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* pow(x,y) return x**y
+ *
+ * n
+ * Method: Let x = 2 * (1+f)
+ * 1. Compute and return log2(x) in two pieces:
+ * log2(x) = w1 + w2,
+ * where w1 has 53-24 = 29 bit trailing zeros.
+ * 2. Perform y*log2(x) = n+y' by simulating muti-precision
+ * arithmetic, where |y'|<=0.5.
+ * 3. Return x**y = 2**n*exp(y'*log2)
+ *
+ * Special cases:
+ * 1. (anything) ** 0 is 1
+ * 2. (anything) ** 1 is itself
+ * 3. (anything except 1) ** NAN is NAN, 1 ** NAN is 1
+ * 4. NAN ** (anything except 0) is NAN
+ * 5. +-(|x| > 1) ** +INF is +INF
+ * 6. +-(|x| > 1) ** -INF is +0
+ * 7. +-(|x| < 1) ** +INF is +0
+ * 8. +-(|x| < 1) ** -INF is +INF
+ * 9. +-1 ** +-INF is 1
+ * 10. +0 ** (+anything except 0, NAN) is +0
+ * 11. -0 ** (+anything except 0, NAN, odd integer) is +0
+ * 12. +0 ** (-anything except 0, NAN) is +INF
+ * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF
+ * 14. -0 ** (odd integer) = -( +0 ** (odd integer) )
+ * 15. +INF ** (+anything except 0,NAN) is +INF
+ * 16. +INF ** (-anything except 0,NAN) is +0
+ * 17. -INF ** (anything) = -0 ** (-anything)
+ * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer)
+ * 19. (-anything except 0 and inf) ** (non-integer) is NAN
+ *
+ * Accuracy:
+ * pow(x,y) returns x**y nearly rounded. In particular
+ * pow(integer,integer)
+ * always returns the correct integer provided it is
+ * representable.
+ *
+ * Constants :
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "libm.h"
+
+static const double
+bp[] = {1.0, 1.5,},
+dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */
+dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */
+zero = 0.0,
+one = 1.0,
+two = 2.0,
+two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */
+huge = 1.0e300,
+tiny = 1.0e-300,
+/* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
+L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */
+L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */
+L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */
+L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */
+L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */
+L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */
+P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
+P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
+P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
+P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
+P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */
+lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
+lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */
+lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */
+ovt = 8.0085662595372944372e-017, /* -(1024-log2(ovfl+.5ulp)) */
+cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */
+cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */
+cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/
+ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */
+ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/
+ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/
+
+double pow(double x, double y)
+{
+ double z,ax,z_h,z_l,p_h,p_l;
+ double y1,t1,t2,r,s,t,u,v,w;
+ int32_t i,j,k,yisint,n;
+ int32_t hx,hy,ix,iy;
+ uint32_t lx,ly;
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hy, ly, y);
+ ix = hx & 0x7fffffff;
+ iy = hy & 0x7fffffff;
+
+ /* y == zero: x**0 = 1 */
+ if ((iy|ly) == 0)
+ return one;
+
+ /* x == 1: 1**y = 1, even if y is NaN */
+ if (hx == 0x3ff00000 && lx == 0)
+ return one;
+
+ /* y != zero: result is NaN if either arg is NaN */
+ if (ix > 0x7ff00000 || (ix == 0x7ff00000 && lx != 0) ||
+ iy > 0x7ff00000 || (iy == 0x7ff00000 && ly != 0))
+ return (x+0.0)+(y+0.0); // FIXME: x+y ?
+
+ /* determine if y is an odd int when x < 0
+ * yisint = 0 ... y is not an integer
+ * yisint = 1 ... y is an odd int
+ * yisint = 2 ... y is an even int
+ */
+ yisint = 0;
+ if (hx < 0) {
+ if (iy >= 0x43400000)
+ yisint = 2; /* even integer y */
+ else if (iy >= 0x3ff00000) {
+ k = (iy>>20) - 0x3ff; /* exponent */
+ if (k > 20) {
+ j = ly>>(52-k);
+ if ((j<<(52-k)) == ly)
+ yisint = 2 - (j&1);
+ } else if (ly == 0) {
+ j = iy>>(20-k);
+ if ((j<<(20-k)) == iy)
+ yisint = 2 - (j&1);
+ }
+ }
+ }
+
+ /* special value of y */
+ if (ly == 0) {
+ if (iy == 0x7ff00000) { /* y is +-inf */
+ if (((ix-0x3ff00000)|lx) == 0) /* (-1)**+-inf is 1 */
+ return one;
+ else if (ix >= 0x3ff00000) /* (|x|>1)**+-inf = inf,0 */
+ return hy >= 0 ? y : zero;
+ else /* (|x|<1)**+-inf = 0,inf */
+ return hy < 0 ? -y : zero;
+ }
+ if (iy == 0x3ff00000) { /* y is +-1 */
+ if (hy < 0)
+ return one/x;
+ return x;
+ }
+ if (hy == 0x40000000) /* y is 2 */
+ return x*x;
+ if (hy == 0x3fe00000) { /* y is 0.5 */
+ if (hx >= 0) /* x >= +0 */
+ return sqrt(x);
+ }
+ }
+
+ ax = fabs(x);
+ /* special value of x */
+ if (lx == 0) {
+ if (ix == 0x7ff00000 || ix == 0 || ix == 0x3ff00000) { /* x is +-0,+-inf,+-1 */
+ z = ax;
+ if (hy < 0) /* z = (1/|x|) */
+ z = one/z;
+ if (hx < 0) {
+ if (((ix-0x3ff00000)|yisint) == 0) {
+ z = (z-z)/(z-z); /* (-1)**non-int is NaN */
+ } else if (yisint == 1)
+ z = -z; /* (x<0)**odd = -(|x|**odd) */
+ }
+ return z;
+ }
+ }
+
+ /* CYGNUS LOCAL + fdlibm-5.3 fix: This used to be
+ n = (hx>>31)+1;
+ but ANSI C says a right shift of a signed negative quantity is
+ implementation defined. */
+ n = ((uint32_t)hx>>31) - 1;
+
+ /* (x<0)**(non-int) is NaN */
+ if ((n|yisint) == 0)
+ return (x-x)/(x-x);
+
+ s = one; /* s (sign of result -ve**odd) = -1 else = 1 */
+ if ((n|(yisint-1)) == 0)
+ s = -one;/* (-ve)**(odd int) */
+
+ /* |y| is huge */
+ if (iy > 0x41e00000) { /* if |y| > 2**31 */
+ if (iy > 0x43f00000) { /* if |y| > 2**64, must o/uflow */
+ if (ix <= 0x3fefffff)
+ return hy < 0 ? huge*huge : tiny*tiny;
+ if (ix >= 0x3ff00000)
+ return hy > 0 ? huge*huge : tiny*tiny;
+ }
+ /* over/underflow if x is not close to one */
+ if (ix < 0x3fefffff)
+ return hy < 0 ? s*huge*huge : s*tiny*tiny;
+ if (ix > 0x3ff00000)
+ return hy > 0 ? s*huge*huge : s*tiny*tiny;
+ /* now |1-x| is tiny <= 2**-20, suffice to compute
+ log(x) by x-x^2/2+x^3/3-x^4/4 */
+ t = ax - one; /* t has 20 trailing zeros */
+ w = (t*t)*(0.5 - t*(0.3333333333333333333333-t*0.25));
+ u = ivln2_h*t; /* ivln2_h has 21 sig. bits */
+ v = t*ivln2_l - w*ivln2;
+ t1 = u + v;
+ SET_LOW_WORD(t1, 0);
+ t2 = v - (t1-u);
+ } else {
+ double ss,s2,s_h,s_l,t_h,t_l;
+ n = 0;
+ /* take care subnormal number */
+ if (ix < 0x00100000) {
+ ax *= two53;
+ n -= 53;
+ GET_HIGH_WORD(ix,ax);
+ }
+ n += ((ix)>>20) - 0x3ff;
+ j = ix & 0x000fffff;
+ /* determine interval */
+ ix = j | 0x3ff00000; /* normalize ix */
+ if (j <= 0x3988E) /* |x|<sqrt(3/2) */
+ k = 0;
+ else if (j < 0xBB67A) /* |x|<sqrt(3) */
+ k = 1;
+ else {
+ k = 0;
+ n += 1;
+ ix -= 0x00100000;
+ }
+ SET_HIGH_WORD(ax, ix);
+
+ /* compute ss = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
+ u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
+ v = one/(ax+bp[k]);
+ ss = u*v;
+ s_h = ss;
+ SET_LOW_WORD(s_h, 0);
+ /* t_h=ax+bp[k] High */
+ t_h = zero;
+ SET_HIGH_WORD(t_h, ((ix>>1)|0x20000000) + 0x00080000 + (k<<18));
+ t_l = ax - (t_h-bp[k]);
+ s_l = v*((u-s_h*t_h)-s_h*t_l);
+ /* compute log(ax) */
+ s2 = ss*ss;
+ r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6)))));
+ r += s_l*(s_h+ss);
+ s2 = s_h*s_h;
+ t_h = 3.0 + s2 + r;
+ SET_LOW_WORD(t_h, 0);
+ t_l = r - ((t_h-3.0)-s2);
+ /* u+v = ss*(1+...) */
+ u = s_h*t_h;
+ v = s_l*t_h + t_l*ss;
+ /* 2/(3log2)*(ss+...) */
+ p_h = u + v;
+ SET_LOW_WORD(p_h, 0);
+ p_l = v - (p_h-u);
+ z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */
+ z_l = cp_l*p_h+p_l*cp + dp_l[k];
+ /* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */
+ t = (double)n;
+ t1 = ((z_h + z_l) + dp_h[k]) + t;
+ SET_LOW_WORD(t1, 0);
+ t2 = z_l - (((t1 - t) - dp_h[k]) - z_h);
+ }
+
+ /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
+ y1 = y;
+ SET_LOW_WORD(y1, 0);
+ p_l = (y-y1)*t1 + y*t2;
+ p_h = y1*t1;
+ z = p_l + p_h;
+ EXTRACT_WORDS(j, i, z);
+ if (j >= 0x40900000) { /* z >= 1024 */
+ if (((j-0x40900000)|i) != 0) /* if z > 1024 */
+ return s*huge*huge; /* overflow */
+ if (p_l + ovt > z - p_h)
+ return s*huge*huge; /* overflow */
+ } else if ((j&0x7fffffff) >= 0x4090cc00) { /* z <= -1075 */ // FIXME: instead of abs(j) use unsigned j
+ if (((j-0xc090cc00)|i) != 0) /* z < -1075 */
+ return s*tiny*tiny; /* underflow */
+ if (p_l <= z - p_h)
+ return s*tiny*tiny; /* underflow */
+ }
+ /*
+ * compute 2**(p_h+p_l)
+ */
+ i = j & 0x7fffffff;
+ k = (i>>20) - 0x3ff;
+ n = 0;
+ if (i > 0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */
+ n = j + (0x00100000>>(k+1));
+ k = ((n&0x7fffffff)>>20) - 0x3ff; /* new k for n */
+ t = zero;
+ SET_HIGH_WORD(t, n & ~(0x000fffff>>k));
+ n = ((n&0x000fffff)|0x00100000)>>(20-k);
+ if (j < 0)
+ n = -n;
+ p_h -= t;
+ }
+ t = p_l + p_h;
+ SET_LOW_WORD(t, 0);
+ u = t*lg2_h;
+ v = (p_l-(t-p_h))*lg2 + t*lg2_l;
+ z = u + v;
+ w = v - (z-u);
+ t = z*z;
+ t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
+ r = (z*t1)/(t1-two) - (w + z*w);
+ z = one - (r-z);
+ GET_HIGH_WORD(j, z);
+ j += n<<20;
+ if ((j>>20) <= 0) /* subnormal output */
+ z = scalbn(z,n);
+ else
+ SET_HIGH_WORD(z, j);
+ return s*z;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_powf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+bp[] = {1.0, 1.5,},
+dp_h[] = { 0.0, 5.84960938e-01,}, /* 0x3f15c000 */
+dp_l[] = { 0.0, 1.56322085e-06,}, /* 0x35d1cfdc */
+zero = 0.0,
+one = 1.0,
+two = 2.0,
+two24 = 16777216.0, /* 0x4b800000 */
+huge = 1.0e30,
+tiny = 1.0e-30,
+/* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
+L1 = 6.0000002384e-01, /* 0x3f19999a */
+L2 = 4.2857143283e-01, /* 0x3edb6db7 */
+L3 = 3.3333334327e-01, /* 0x3eaaaaab */
+L4 = 2.7272811532e-01, /* 0x3e8ba305 */
+L5 = 2.3066075146e-01, /* 0x3e6c3255 */
+L6 = 2.0697501302e-01, /* 0x3e53f142 */
+P1 = 1.6666667163e-01, /* 0x3e2aaaab */
+P2 = -2.7777778450e-03, /* 0xbb360b61 */
+P3 = 6.6137559770e-05, /* 0x388ab355 */
+P4 = -1.6533901999e-06, /* 0xb5ddea0e */
+P5 = 4.1381369442e-08, /* 0x3331bb4c */
+lg2 = 6.9314718246e-01, /* 0x3f317218 */
+lg2_h = 6.93145752e-01, /* 0x3f317200 */
+lg2_l = 1.42860654e-06, /* 0x35bfbe8c */
+ovt = 4.2995665694e-08, /* -(128-log2(ovfl+.5ulp)) */
+cp = 9.6179670095e-01, /* 0x3f76384f =2/(3ln2) */
+cp_h = 9.6191406250e-01, /* 0x3f764000 =12b cp */
+cp_l = -1.1736857402e-04, /* 0xb8f623c6 =tail of cp_h */
+ivln2 = 1.4426950216e+00, /* 0x3fb8aa3b =1/ln2 */
+ivln2_h = 1.4426879883e+00, /* 0x3fb8aa00 =16b 1/ln2*/
+ivln2_l = 7.0526075433e-06; /* 0x36eca570 =1/ln2 tail*/
+
+float powf(float x, float y)
+{
+ float z,ax,z_h,z_l,p_h,p_l;
+ float y1,t1,t2,r,s,sn,t,u,v,w;
+ int32_t i,j,k,yisint,n;
+ int32_t hx,hy,ix,iy,is;
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hy, y);
+ ix = hx & 0x7fffffff;
+ iy = hy & 0x7fffffff;
+
+ /* y == zero: x**0 = 1 */
+ if (iy == 0)
+ return one;
+
+ /* x == 1: 1**y = 1, even if y is NaN */
+ if (hx == 0x3f800000)
+ return one;
+
+ /* y != zero: result is NaN if either arg is NaN */
+ if (ix > 0x7f800000 || iy > 0x7f800000)
+ return (x+0.0F) + (y+0.0F);
+
+ /* determine if y is an odd int when x < 0
+ * yisint = 0 ... y is not an integer
+ * yisint = 1 ... y is an odd int
+ * yisint = 2 ... y is an even int
+ */
+ yisint = 0;
+ if (hx < 0) {
+ if (iy >= 0x4b800000)
+ yisint = 2; /* even integer y */
+ else if (iy >= 0x3f800000) {
+ k = (iy>>23) - 0x7f; /* exponent */
+ j = iy>>(23-k);
+ if ((j<<(23-k)) == iy)
+ yisint = 2 - (j & 1);
+ }
+ }
+
+ /* special value of y */
+ if (iy == 0x7f800000) { /* y is +-inf */
+ if (ix == 0x3f800000) /* (-1)**+-inf is 1 */
+ return one;
+ else if (ix > 0x3f800000) /* (|x|>1)**+-inf = inf,0 */
+ return hy >= 0 ? y : zero;
+ else /* (|x|<1)**+-inf = 0,inf */
+ return hy < 0 ? -y : zero;
+ }
+ if (iy == 0x3f800000) { /* y is +-1 */
+ if (hy < 0)
+ return one/x;
+ return x;
+ }
+ if (hy == 0x40000000) /* y is 2 */
+ return x*x;
+ if (hy == 0x3f000000) { /* y is 0.5 */
+ if (hx >= 0) /* x >= +0 */
+ return sqrtf(x);
+ }
+
+ ax = fabsf(x);
+ /* special value of x */
+ if (ix == 0x7f800000 || ix == 0 || ix == 0x3f800000) { /* x is +-0,+-inf,+-1 */
+ z = ax;
+ if (hy < 0) /* z = (1/|x|) */
+ z = one/z;
+ if (hx < 0) {
+ if (((ix-0x3f800000)|yisint) == 0) {
+ z = (z-z)/(z-z); /* (-1)**non-int is NaN */
+ } else if (yisint == 1)
+ z = -z; /* (x<0)**odd = -(|x|**odd) */
+ }
+ return z;
+ }
+
+ n = ((uint32_t)hx>>31) - 1;
+
+ /* (x<0)**(non-int) is NaN */
+ if ((n|yisint) == 0)
+ return (x-x)/(x-x);
+
+ sn = one; /* s (sign of result -ve**odd) = -1 else = 1 */
+ if ((n|(yisint-1)) == 0) /* (-ve)**(odd int) */
+ sn = -one;
+
+ /* |y| is huge */
+ if (iy > 0x4d000000) { /* if |y| > 2**27 */
+ /* over/underflow if x is not close to one */
+ if (ix < 0x3f7ffff8)
+ return hy < 0 ? sn*huge*huge : sn*tiny*tiny;
+ if (ix > 0x3f800007)
+ return hy > 0 ? sn*huge*huge : sn*tiny*tiny;
+ /* now |1-x| is tiny <= 2**-20, suffice to compute
+ log(x) by x-x^2/2+x^3/3-x^4/4 */
+ t = ax - 1; /* t has 20 trailing zeros */
+ w = (t*t)*((float)0.5-t*((float)0.333333333333-t*(float)0.25));
+ u = ivln2_h*t; /* ivln2_h has 16 sig. bits */
+ v = t*ivln2_l - w*ivln2;
+ t1 = u + v;
+ GET_FLOAT_WORD(is, t1);
+ SET_FLOAT_WORD(t1, is & 0xfffff000);
+ t2 = v - (t1-u);
+ } else {
+ float s2,s_h,s_l,t_h,t_l;
+ n = 0;
+ /* take care subnormal number */
+ if (ix < 0x00800000) {
+ ax *= two24;
+ n -= 24;
+ GET_FLOAT_WORD(ix, ax);
+ }
+ n += ((ix)>>23) - 0x7f;
+ j = ix & 0x007fffff;
+ /* determine interval */
+ ix = j | 0x3f800000; /* normalize ix */
+ if (j <= 0x1cc471) /* |x|<sqrt(3/2) */
+ k = 0;
+ else if (j < 0x5db3d7) /* |x|<sqrt(3) */
+ k = 1;
+ else {
+ k = 0;
+ n += 1;
+ ix -= 0x00800000;
+ }
+ SET_FLOAT_WORD(ax, ix);
+
+ /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
+ u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
+ v = one/(ax+bp[k]);
+ s = u*v;
+ s_h = s;
+ GET_FLOAT_WORD(is, s_h);
+ SET_FLOAT_WORD(s_h, is & 0xfffff000);
+ /* t_h=ax+bp[k] High */
+ is = ((ix>>1) & 0xfffff000) | 0x20000000;
+ SET_FLOAT_WORD(t_h, is + 0x00400000 + (k<<21));
+ t_l = ax - (t_h - bp[k]);
+ s_l = v*((u - s_h*t_h) - s_h*t_l);
+ /* compute log(ax) */
+ s2 = s*s;
+ r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6)))));
+ r += s_l*(s_h+s);
+ s2 = s_h*s_h;
+ t_h = (float)3.0 + s2 + r;
+ GET_FLOAT_WORD(is, t_h);
+ SET_FLOAT_WORD(t_h, is & 0xfffff000);
+ t_l = r - ((t_h - (float)3.0) - s2);
+ /* u+v = s*(1+...) */
+ u = s_h*t_h;
+ v = s_l*t_h + t_l*s;
+ /* 2/(3log2)*(s+...) */
+ p_h = u + v;
+ GET_FLOAT_WORD(is, p_h);
+ SET_FLOAT_WORD(p_h, is & 0xfffff000);
+ p_l = v - (p_h - u);
+ z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */
+ z_l = cp_l*p_h + p_l*cp+dp_l[k];
+ /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */
+ t = (float)n;
+ t1 = (((z_h + z_l) + dp_h[k]) + t);
+ GET_FLOAT_WORD(is, t1);
+ SET_FLOAT_WORD(t1, is & 0xfffff000);
+ t2 = z_l - (((t1 - t) - dp_h[k]) - z_h);
+ }
+
+ /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
+ GET_FLOAT_WORD(is, y);
+ SET_FLOAT_WORD(y1, is & 0xfffff000);
+ p_l = (y-y1)*t1 + y*t2;
+ p_h = y1*t1;
+ z = p_l + p_h;
+ GET_FLOAT_WORD(j, z);
+ if (j > 0x43000000) /* if z > 128 */
+ return sn*huge*huge; /* overflow */
+ else if (j == 0x43000000) { /* if z == 128 */
+ if (p_l + ovt > z - p_h)
+ return sn*huge*huge; /* overflow */
+ } else if ((j&0x7fffffff) > 0x43160000) /* z < -150 */ // FIXME: check should be (uint32_t)j > 0xc3160000
+ return sn*tiny*tiny; /* underflow */
+ else if (j == 0xc3160000) { /* z == -150 */
+ if (p_l <= z-p_h)
+ return sn*tiny*tiny; /* underflow */
+ }
+ /*
+ * compute 2**(p_h+p_l)
+ */
+ i = j & 0x7fffffff;
+ k = (i>>23) - 0x7f;
+ n = 0;
+ if (i > 0x3f000000) { /* if |z| > 0.5, set n = [z+0.5] */
+ n = j + (0x00800000>>(k+1));
+ k = ((n&0x7fffffff)>>23) - 0x7f; /* new k for n */
+ SET_FLOAT_WORD(t, n & ~(0x007fffff>>k));
+ n = ((n&0x007fffff)|0x00800000)>>(23-k);
+ if (j < 0)
+ n = -n;
+ p_h -= t;
+ }
+ t = p_l + p_h;
+ GET_FLOAT_WORD(is, t);
+ SET_FLOAT_WORD(t, is & 0xffff8000);
+ u = t*lg2_h;
+ v = (p_l-(t-p_h))*lg2 + t*lg2_l;
+ z = u + v;
+ w = v - (z - u);
+ t = z*z;
+ t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
+ r = (z*t1)/(t1-two) - (w+z*w);
+ z = one - (r - z);
+ GET_FLOAT_WORD(j, z);
+ j += n<<23;
+ if ((j>>23) <= 0) /* subnormal output */
+ z = scalbnf(z, n);
+ else
+ SET_FLOAT_WORD(z, j);
+ return sn*z;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_powl.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/* powl.c
+ *
+ * Power function, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, z, powl();
+ *
+ * z = powl( x, y );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Computes x raised to the yth power. Analytically,
+ *
+ * x**y = exp( y log(x) ).
+ *
+ * Following Cody and Waite, this program uses a lookup table
+ * of 2**-i/32 and pseudo extended precision arithmetic to
+ * obtain several extra bits of accuracy in both the logarithm
+ * and the exponential.
+ *
+ *
+ * ACCURACY:
+ *
+ * The relative error of pow(x,y) can be estimated
+ * by y dl ln(2), where dl is the absolute error of
+ * the internally computed base 2 logarithm. At the ends
+ * of the approximation interval the logarithm equal 1/32
+ * and its relative error is about 1 lsb = 1.1e-19. Hence
+ * the predicted relative error in the result is 2.3e-21 y .
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ *
+ * IEEE +-1000 40000 2.8e-18 3.7e-19
+ * .001 < x < 1000, with log(x) uniformly distributed.
+ * -1000 < y < 1000, y uniformly distributed.
+ *
+ * IEEE 0,8700 60000 6.5e-18 1.0e-18
+ * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed.
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * pow overflow x**y > MAXNUM INFINITY
+ * pow underflow x**y < 1/MAXNUM 0.0
+ * pow domain x<0 and y noninteger 0.0
+ *
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double powl(long double x, long double y)
+{
+ return pow(x, y);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+
+/* Table size */
+#define NXT 32
+/* log2(Table size) */
+#define LNXT 5
+
+/* log(1+x) = x - .5x^2 + x^3 * P(z)/Q(z)
+ * on the domain 2^(-1/32) - 1 <= x <= 2^(1/32) - 1
+ */
+static long double P[] = {
+ 8.3319510773868690346226E-4L,
+ 4.9000050881978028599627E-1L,
+ 1.7500123722550302671919E0L,
+ 1.4000100839971580279335E0L,
+};
+static long double Q[] = {
+/* 1.0000000000000000000000E0L,*/
+ 5.2500282295834889175431E0L,
+ 8.4000598057587009834666E0L,
+ 4.2000302519914740834728E0L,
+};
+/* A[i] = 2^(-i/32), rounded to IEEE long double precision.
+ * If i is even, A[i] + B[i/2] gives additional accuracy.
+ */
+static long double A[33] = {
+ 1.0000000000000000000000E0L,
+ 9.7857206208770013448287E-1L,
+ 9.5760328069857364691013E-1L,
+ 9.3708381705514995065011E-1L,
+ 9.1700404320467123175367E-1L,
+ 8.9735453750155359320742E-1L,
+ 8.7812608018664974155474E-1L,
+ 8.5930964906123895780165E-1L,
+ 8.4089641525371454301892E-1L,
+ 8.2287773907698242225554E-1L,
+ 8.0524516597462715409607E-1L,
+ 7.8799042255394324325455E-1L,
+ 7.7110541270397041179298E-1L,
+ 7.5458221379671136985669E-1L,
+ 7.3841307296974965571198E-1L,
+ 7.2259040348852331001267E-1L,
+ 7.0710678118654752438189E-1L,
+ 6.9195494098191597746178E-1L,
+ 6.7712777346844636413344E-1L,
+ 6.6261832157987064729696E-1L,
+ 6.4841977732550483296079E-1L,
+ 6.3452547859586661129850E-1L,
+ 6.2092890603674202431705E-1L,
+ 6.0762367999023443907803E-1L,
+ 5.9460355750136053334378E-1L,
+ 5.8186242938878875689693E-1L,
+ 5.6939431737834582684856E-1L,
+ 5.5719337129794626814472E-1L,
+ 5.4525386633262882960438E-1L,
+ 5.3357020033841180906486E-1L,
+ 5.2213689121370692017331E-1L,
+ 5.1094857432705833910408E-1L,
+ 5.0000000000000000000000E-1L,
+};
+static long double B[17] = {
+ 0.0000000000000000000000E0L,
+ 2.6176170809902549338711E-20L,
+-1.0126791927256478897086E-20L,
+ 1.3438228172316276937655E-21L,
+ 1.2207982955417546912101E-20L,
+-6.3084814358060867200133E-21L,
+ 1.3164426894366316434230E-20L,
+-1.8527916071632873716786E-20L,
+ 1.8950325588932570796551E-20L,
+ 1.5564775779538780478155E-20L,
+ 6.0859793637556860974380E-21L,
+-2.0208749253662532228949E-20L,
+ 1.4966292219224761844552E-20L,
+ 3.3540909728056476875639E-21L,
+-8.6987564101742849540743E-22L,
+-1.2327176863327626135542E-20L,
+ 0.0000000000000000000000E0L,
+};
+
+/* 2^x = 1 + x P(x),
+ * on the interval -1/32 <= x <= 0
+ */
+static long double R[] = {
+ 1.5089970579127659901157E-5L,
+ 1.5402715328927013076125E-4L,
+ 1.3333556028915671091390E-3L,
+ 9.6181291046036762031786E-3L,
+ 5.5504108664798463044015E-2L,
+ 2.4022650695910062854352E-1L,
+ 6.9314718055994530931447E-1L,
+};
+
+#define douba(k) A[k]
+#define doubb(k) B[k]
+#define MEXP (NXT*16384.0L)
+/* The following if denormal numbers are supported, else -MEXP: */
+#define MNEXP (-NXT*(16384.0L+64.0L))
+/* log2(e) - 1 */
+#define LOG2EA 0.44269504088896340735992L
+
+#define F W
+#define Fa Wa
+#define Fb Wb
+#define G W
+#define Ga Wa
+#define Gb u
+#define H W
+#define Ha Wb
+#define Hb Wb
+
+static const long double MAXLOGL = 1.1356523406294143949492E4L;
+static const long double MINLOGL = -1.13994985314888605586758E4L;
+static const long double LOGE2L = 6.9314718055994530941723E-1L;
+static volatile long double z;
+static long double w, W, Wa, Wb, ya, yb, u;
+static const long double huge = 0x1p10000L;
+/* XXX Prevent gcc from erroneously constant folding this. */
+static volatile long double twom10000 = 0x1p-10000L;
+
+static long double reducl(long double);
+static long double powil(long double, int);
+
+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;
+
+ if (y == 0.0L)
+ return 1.0L;
+ if (isnan(x))
+ return x;
+ if (isnan(y))
+ return y;
+ if (y == 1.0L)
+ return x;
+
+ // FIXME: this is wrong, see pow special cases in c99 F.9.4.4
+ if (!isfinite(y) && (x == -1.0L || x == 1.0L) )
+ return y - y; /* +-1**inf is NaN */
+ if (x == 1.0L)
+ return 1.0L;
+ if (y >= LDBL_MAX) {
+ if (x > 1.0L)
+ return INFINITY;
+ if (x > 0.0L && x < 1.0L)
+ return 0.0L;
+ if (x < -1.0L)
+ return INFINITY;
+ if (x > -1.0L && x < 0.0L)
+ return 0.0L;
+ }
+ if (y <= -LDBL_MAX) {
+ if (x > 1.0L)
+ return 0.0L;
+ if (x > 0.0L && x < 1.0L)
+ return INFINITY;
+ if (x < -1.0L)
+ return 0.0L;
+ if (x > -1.0L && x < 0.0L)
+ return INFINITY;
+ }
+ if (x >= LDBL_MAX) {
+ if (y > 0.0L)
+ return INFINITY;
+ return 0.0L;
+ }
+
+ 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.5L * ya);
+ yb = 0.5L * fabsl(w);
+ if( ya != yb )
+ yoddint = 1;
+ }
+
+ if (x <= -LDBL_MAX) {
+ if (y > 0.0L) {
+ if (yoddint)
+ return -INFINITY;
+ return INFINITY;
+ }
+ if (y < 0.0L) {
+ if (yoddint)
+ return -0.0L;
+ return 0.0;
+ }
+ }
+
+
+ nflg = 0; /* flag = 1 if x<0 raised to integer power */
+ if (x <= 0.0L) {
+ if (x == 0.0L) {
+ if (y < 0.0) {
+ if (signbit(x) && yoddint)
+ return -INFINITY;
+ return INFINITY;
+ }
+ if (y > 0.0) {
+ if (signbit(x) && yoddint)
+ return -0.0L;
+ return 0.0;
+ }
+ if (y == 0.0L)
+ return 1.0L; /* 0**0 */
+ return 0.0L; /* 0**y */
+ }
+ if (iyflg == 0)
+ return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */
+ nflg = 1;
+ }
+
+ /* Integer power of an integer. */
+ if (iyflg) {
+ i = w;
+ w = floorl(x);
+ if (w == x && fabsl(y) < 32768.0) {
+ w = powil(x, (int)y);
+ return w;
+ }
+ }
+
+ if (nflg)
+ x = fabsl(x);
+
+ /* separate significand from exponent */
+ x = frexpl(x, &i);
+ e = i;
+
+ /* find significand in antilog table A[] */
+ i = 1;
+ if (x <= douba(17))
+ i = 17;
+ if (x <= douba(i+8))
+ i += 8;
+ if (x <= douba(i+4))
+ i += 4;
+ if (x <= douba(i+2))
+ i += 2;
+ if (x >= douba(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 -= douba(i);
+ x -= doubb(i/2);
+ x /= douba(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 - ldexpl(z, -1); /* 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 = ldexpl(w, -LNXT); /* divide by 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 = ldexpl( Ga+Ha, LNXT );
+
+ /* 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.0L) {
+ e += 1;
+ Hb -= 1.0L/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 = douba(e);
+ z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */
+ z = z + w;
+ z = ldexpl(z, i); /* multiply by integer power of 2 */
+
+ if (nflg) {
+ /* For negative x,
+ * find out if the integer exponent
+ * is odd or even.
+ */
+ w = ldexpl(y, -1);
+ w = floorl(w);
+ w = ldexpl(w, 1);
+ if (w != y)
+ z = -z; /* odd exponent */
+ }
+
+ return z;
+}
+
+
+/* Find a multiple of 1/NXT that is within 1/NXT of x. */
+static long double reducl(long double x)
+{
+ long double t;
+
+ t = ldexpl(x, LNXT);
+ t = floorl(t);
+ t = ldexpl(t, -LNXT);
+ return t;
+}
+
+/* powil.c
+ *
+ * Real raised to integer power, long double precision
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, powil();
+ * int n;
+ *
+ * y = powil( x, n );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns argument x raised to the nth power.
+ * The routine efficiently decomposes n as a sum of powers of
+ * two. The desired power is a product of two-to-the-kth
+ * powers of x. Thus to compute the 32767 power of x requires
+ * 28 multiplications instead of 32767 multiplications.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic x domain n domain # trials peak rms
+ * IEEE .001,1000 -1022,1023 50000 4.3e-17 7.8e-18
+ * IEEE 1,2 -1022,1023 20000 3.9e-17 7.6e-18
+ * IEEE .99,1.01 0,8700 10000 3.6e-16 7.2e-17
+ *
+ * Returns MAXNUM on overflow, zero on underflow.
+ */
+
+static long double powil(long double x, int nn)
+{
+ long double ww, y;
+ long double s;
+ int n, e, sign, asign, lx;
+
+ if (x == 0.0L) {
+ if (nn == 0)
+ return 1.0L;
+ else if (nn < 0)
+ return LDBL_MAX;
+ return 0.0L;
+ }
+
+ if (nn == 0)
+ return 1.0L;
+
+ if (x < 0.0L) {
+ asign = -1;
+ x = -x;
+ } else
+ asign = 0;
+
+ if (nn < 0) {
+ sign = -1;
+ n = -nn;
+ } else {
+ sign = 1;
+ n = nn;
+ }
+
+ /* Overflow detection */
+
+ /* Calculate approximate logarithm of answer */
+ s = x;
+ s = frexpl( s, &lx);
+ e = (lx - 1)*n;
+ if ((e == 0) || (e > 64) || (e < -64)) {
+ s = (s - 7.0710678118654752e-1L) / (s + 7.0710678118654752e-1L);
+ s = (2.9142135623730950L * s - 0.5L + lx) * nn * LOGE2L;
+ } else {
+ s = LOGE2L * e;
+ }
+
+ if (s > MAXLOGL)
+ return huge * huge; /* overflow */
+
+ if (s < MINLOGL)
+ return twom10000 * twom10000; /* underflow */
+ /* Handle tiny denormal answer, but with less accuracy
+ * since roundoff error in 1.0/x will be amplified.
+ * The precise demarcation should be the gradual underflow threshold.
+ */
+ if (s < -MAXLOGL+2.0L) {
+ x = 1.0L/x;
+ sign = -sign;
+ }
+
+ /* First bit of the power */
+ if (n & 1)
+ y = x;
+ else {
+ y = 1.0L;
+ asign = 0;
+ }
+
+ ww = x;
+ n >>= 1;
+ while (n) {
+ ww = ww * ww; /* arg to the 2-to-the-kth power */
+ if (n & 1) /* if that bit is set, then include in product */
+ y *= ww;
+ n >>= 1;
+ }
+
+ if (asign)
+ y = -y; /* odd power of negative number */
+ if (sign < 0)
+ y = 1.0L/y;
+ return y;
+}
+
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_remainder.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* remainder(x,p)
+ * Return :
+ * returns x REM p = x - [x/p]*p as if in infinite
+ * precise arithmetic, where [x/p] is the (infinite bit)
+ * integer nearest x/p (in half way case choose the even one).
+ * Method :
+ * Based on fmod() return x-[x/p]chopped*p exactlp.
+ */
+
+#include "libm.h"
+
+static const double zero = 0.0;
+
+double remainder(double x, double p)
+{
+ int32_t hx,hp;
+ uint32_t sx,lx,lp;
+ double p_half;
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hp, lp, p);
+ sx = hx & 0x80000000;
+ hp &= 0x7fffffff;
+ hx &= 0x7fffffff;
+
+ /* purge off exception values */
+ if ((hp|lp) == 0) /* p = 0 */
+ return (x*p)/(x*p);
+ if (hx >= 0x7ff00000 || /* x not finite */
+ (hp >= 0x7ff00000 && (hp-0x7ff00000 | lp) != 0)) /* p is NaN */
+ // FIXME: why long double?
+ return ((long double)x*p)/((long double)x*p);
+
+ if (hp <= 0x7fdfffff)
+ x = fmod(x, p+p); /* now x < 2p */
+ if (((hx-hp)|(lx-lp)) == 0)
+ return zero*x;
+ x = fabs(x);
+ p = fabs(p);
+ if (hp < 0x00200000) {
+ if (x + x > p) {
+ x -= p;
+ if (x + x >= p)
+ x -= p;
+ }
+ } else {
+ p_half = 0.5*p;
+ if (x > p_half) {
+ x -= p;
+ if (x >= p_half)
+ x -= p;
+ }
+ }
+ GET_HIGH_WORD(hx, x);
+ if ((hx&0x7fffffff) == 0)
+ hx = 0;
+ SET_HIGH_WORD(x, hx^sx);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_remainderf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float zero = 0.0;
+
+float remainderf(float x, float p)
+{
+ int32_t hx,hp;
+ uint32_t sx;
+ float p_half;
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hp, p);
+ sx = hx & 0x80000000;
+ hp &= 0x7fffffff;
+ hx &= 0x7fffffff;
+
+ /* purge off exception values */
+ if (hp == 0) /* p = 0 */
+ return (x*p)/(x*p);
+ if (hx >= 0x7f800000 || hp > 0x7f800000) /* x not finite, p is NaN */
+ // FIXME: why long double?
+ return ((long double)x*p)/((long double)x*p);
+
+ if (hp <= 0x7effffff)
+ x = fmodf(x, p + p); /* now x < 2p */
+ if (hx - hp == 0)
+ return zero*x;
+ x = fabsf(x);
+ p = fabsf(p);
+ if (hp < 0x01000000) {
+ if (x + x > p) {
+ x -= p;
+ if (x + x >= p)
+ x -= p;
+ }
+ } else {
+ p_half = (float)0.5*p;
+ if (x > p_half) {
+ x -= p;
+ if (x >= p_half)
+ x -= p;
+ }
+ }
+ GET_FLOAT_WORD(hx, x);
+ if ((hx & 0x7fffffff) == 0)
+ hx = 0;
+ SET_FLOAT_WORD(x, hx ^ sx);
+ return x;
+}
--- /dev/null
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double remainderl(long double x, long double y)
+{
+ return remainder(x, y);
+}
+#else
+long double remainderl(long double x, long double y)
+{
+ int q;
+ return remquol(x, y, &q);
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_remquo.c */
+/*-
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * Return the IEEE remainder and set *quo to the last n bits of the
+ * quotient, rounded to the nearest integer. We choose n=31 because
+ * we wind up computing all the integer bits of the quotient anyway as
+ * a side-effect of computing the remainder by the shift and subtract
+ * method. In practice, this is far more bits than are needed to use
+ * remquo in reduction algorithms.
+ */
+
+#include "libm.h"
+
+static const double Zero[] = {0.0, -0.0,};
+
+double remquo(double x, double y, int *quo)
+{
+ int32_t n,hx,hy,hz,ix,iy,sx,i;
+ uint32_t lx,ly,lz,q,sxy;
+
+ EXTRACT_WORDS(hx, lx, x);
+ EXTRACT_WORDS(hy, ly, y);
+ sxy = (hx ^ hy) & 0x80000000;
+ sx = hx & 0x80000000; /* sign of x */
+ hx ^= sx; /* |x| */
+ hy &= 0x7fffffff; /* |y| */
+
+ /* purge off exception values */
+ // FIXME: signed shift
+ if ((hy|ly) == 0 || hx >= 0x7ff00000 || /* y = 0, or x not finite */
+ (hy|((ly|-ly)>>31)) > 0x7ff00000) /* or y is NaN */
+ return (x*y)/(x*y);
+ if (hx <= hy) {
+ if (hx < hy || lx < ly) { /* |x| < |y| return x or x-y */
+ q = 0;
+ goto fixup;
+ }
+ if (lx == ly) { /* |x| = |y| return x*0 */
+ *quo = 1;
+ return Zero[(uint32_t)sx>>31];
+ }
+ }
+
+ // FIXME: use ilogb?
+
+ /* determine ix = ilogb(x) */
+ if (hx < 0x00100000) { /* subnormal x */
+ if (hx == 0) {
+ for (ix = -1043, i=lx; i>0; i<<=1) ix--;
+ } else {
+ for (ix = -1022, i=hx<<11; i>0; i<<=1) ix--;
+ }
+ } else
+ ix = (hx>>20) - 1023;
+
+ /* determine iy = ilogb(y) */
+ if (hy < 0x00100000) { /* subnormal y */
+ if (hy == 0) {
+ for (iy = -1043, i=ly; i>0; i<<=1) iy--;
+ } else {
+ for (iy = -1022, i=hy<<11; i>0; i<<=1) iy--;
+ }
+ } else
+ iy = (hy>>20) - 1023;
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ if (ix >= -1022)
+ hx = 0x00100000|(0x000fffff&hx);
+ else { /* subnormal x, shift x to normal */
+ n = -1022 - ix;
+ if (n <= 31) {
+ hx = (hx<<n)|(lx>>(32-n));
+ lx <<= n;
+ } else {
+ hx = lx<<(n-32);
+ lx = 0;
+ }
+ }
+ if (iy >= -1022)
+ hy = 0x00100000|(0x000fffff&hy);
+ else { /* subnormal y, shift y to normal */
+ n = -1022 - iy;
+ if (n <= 31) {
+ hy = (hy<<n)|(ly>>(32-n));
+ ly <<= n;
+ } else {
+ hy = ly<<(n-32);
+ ly = 0;
+ }
+ }
+
+ /* fix point fmod */
+ n = ix - iy;
+ q = 0;
+ while (n--) {
+ hz = hx - hy;
+ lz = lx - ly;
+ if (lx < ly)
+ hz--;
+ if (hz < 0) {
+ hx = hx + hx + (lx>>31);
+ lx = lx + lx;
+ } else {
+ hx = hz + hz + (lz>>31);
+ lx = lz + lz;
+ q++;
+ }
+ q <<= 1;
+ }
+ hz = hx - hy;
+ lz = lx - ly;
+ if (lx < ly)
+ hz--;
+ if (hz >= 0) {
+ hx = hz;
+ lx = lz;
+ q++;
+ }
+
+ /* convert back to floating value and restore the sign */
+ if ((hx|lx) == 0) { /* return sign(x)*0 */
+ *quo = sxy ? -q : q;
+ return Zero[(uint32_t)sx>>31];
+ }
+ while (hx < 0x00100000) { /* normalize x */
+ hx = hx + hx + (lx>>31);
+ lx = lx + lx;
+ iy--;
+ }
+ if (iy >= -1022) { /* normalize output */
+ hx = (hx-0x00100000)|((iy+1023)<<20);
+ } else { /* subnormal output */
+ n = -1022 - iy;
+ if (n <= 20) {
+ lx = (lx>>n)|((uint32_t)hx<<(32-n));
+ hx >>= n;
+ } else if (n <= 31) {
+ lx = (hx<<(32-n))|(lx>>n);
+ hx = sx;
+ } else {
+ lx = hx>>(n-32);
+ hx = sx;
+ }
+ }
+fixup:
+ INSERT_WORDS(x, hx, lx);
+ y = fabs(y);
+ if (y < 0x1p-1021) {
+ if (x + x > y || (x + x == y && (q & 1))) {
+ q++;
+ x -= y;
+ }
+ } else if (x > 0.5*y || (x == 0.5*y && (q & 1))) {
+ q++;
+ x -= y;
+ }
+ GET_HIGH_WORD(hx, x);
+ SET_HIGH_WORD(x, hx ^ sx);
+ q &= 0x7fffffff;
+ *quo = sxy ? -q : q;
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_remquof.c */
+/*-
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * Return the IEEE remainder and set *quo to the last n bits of the
+ * quotient, rounded to the nearest integer. We choose n=31 because
+ * we wind up computing all the integer bits of the quotient anyway as
+ * a side-effect of computing the remainder by the shift and subtract
+ * method. In practice, this is far more bits than are needed to use
+ * remquo in reduction algorithms.
+ */
+
+#include "libm.h"
+
+static const float Zero[] = {0.0, -0.0,};
+
+float remquof(float x, float y, int *quo)
+{
+ int32_t n,hx,hy,hz,ix,iy,sx,i;
+ uint32_t q,sxy;
+
+ GET_FLOAT_WORD(hx, x);
+ GET_FLOAT_WORD(hy, y);
+ sxy = (hx ^ hy) & 0x80000000;
+ sx = hx & 0x80000000; /* sign of x */
+ hx ^= sx; /* |x| */
+ hy &= 0x7fffffff; /* |y| */
+
+ /* purge off exception values */
+ if (hy == 0 || hx >= 0x7f800000 || hy > 0x7f800000) /* y=0,NaN;or x not finite */
+ return (x*y)/(x*y);
+ if (hx < hy) { /* |x| < |y| return x or x-y */
+ q = 0;
+ goto fixup;
+ } else if(hx==hy) { /* |x| = |y| return x*0*/
+ *quo = 1;
+ return Zero[(uint32_t)sx>>31];
+ }
+
+ /* determine ix = ilogb(x) */
+ if (hx < 0x00800000) { /* subnormal x */
+ for (ix = -126, i=hx<<8; i>0; i<<=1) ix--;
+ } else
+ ix = (hx>>23) - 127;
+
+ /* determine iy = ilogb(y) */
+ if (hy < 0x00800000) { /* subnormal y */
+ for (iy = -126, i=hy<<8; i>0; i<<=1) iy--;
+ } else
+ iy = (hy>>23) - 127;
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ if (ix >= -126)
+ hx = 0x00800000|(0x007fffff&hx);
+ else { /* subnormal x, shift x to normal */
+ n = -126 - ix;
+ hx <<= n;
+ }
+ if (iy >= -126)
+ hy = 0x00800000|(0x007fffff&hy);
+ else { /* subnormal y, shift y to normal */
+ n = -126 - iy;
+ hy <<= n;
+ }
+
+ /* fix point fmod */
+ n = ix - iy;
+ q = 0;
+ while (n--) {
+ hz = hx - hy;
+ if (hz < 0)
+ hx = hx << 1;
+ else {
+ hx = hz << 1;
+ q++;
+ }
+ q <<= 1;
+ }
+ hz = hx - hy;
+ if (hz >= 0) {
+ hx = hz;
+ q++;
+ }
+
+ /* convert back to floating value and restore the sign */
+ if (hx == 0) { /* return sign(x)*0 */
+ *quo = sxy ? -q : q;
+ return Zero[(uint32_t)sx>>31];
+ }
+ while (hx < 0x00800000) { /* normalize x */
+ hx <<= 1;
+ iy--;
+ }
+ if (iy >= -126) { /* normalize output */
+ hx = (hx-0x00800000)|((iy+127)<<23);
+ } else { /* subnormal output */
+ n = -126 - iy;
+ hx >>= n;
+ }
+fixup:
+ SET_FLOAT_WORD(x,hx);
+ y = fabsf(y);
+ if (y < 0x1p-125f) {
+ if (x + x > y || (x + x == y && (q & 1))) {
+ q++;
+ x -= y;
+ }
+ } else if (x > 0.5f*y || (x == 0.5f*y && (q & 1))) {
+ q++;
+ x -= y;
+ }
+ GET_FLOAT_WORD(hx, x);
+ SET_FLOAT_WORD(x, hx ^ sx);
+ q &= 0x7fffffff;
+ *quo = sxy ? -q : q;
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_remquol.c */
+/*-
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double remquol(long double x, long double y, int *quo)
+{
+ return remquo(x, y, quo);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#define BIAS (LDBL_MAX_EXP - 1)
+
+#if LDBL_MANL_SIZE > 32
+typedef uint64_t manl_t;
+#else
+typedef uint32_t manl_t;
+#endif
+
+#if LDBL_MANH_SIZE > 32
+typedef uint64_t manh_t;
+#else
+typedef uint32_t manh_t;
+#endif
+
+/*
+ * These macros add and remove an explicit integer bit in front of the
+ * fractional mantissa, if the architecture doesn't have such a bit by
+ * default already.
+ */
+#ifdef LDBL_IMPLICIT_NBIT
+#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE))
+#define HFRAC_BITS LDBL_MANH_SIZE
+#else
+#define SET_NBIT(hx) (hx)
+#define HFRAC_BITS (LDBL_MANH_SIZE - 1)
+#endif
+
+#define MANL_SHIFT (LDBL_MANL_SIZE - 1)
+
+static const long double Zero[] = {0.0L, -0.0L};
+
+/*
+ * Return the IEEE remainder and set *quo to the last n bits of the
+ * quotient, rounded to the nearest integer. We choose n=31 because
+ * we wind up computing all the integer bits of the quotient anyway as
+ * a side-effect of computing the remainder by the shift and subtract
+ * method. In practice, this is far more bits than are needed to use
+ * remquo in reduction algorithms.
+ *
+ * Assumptions:
+ * - The low part of the mantissa fits in a manl_t exactly.
+ * - The high part of the mantissa fits in an int64_t with enough room
+ * for an explicit integer bit in front of the fractional bits.
+ */
+long double remquol(long double x, long double y, int *quo)
+{
+ union IEEEl2bits ux, uy;
+ int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */
+ manh_t hy;
+ manl_t lx,ly,lz;
+ int ix,iy,n,q,sx,sxy;
+
+ ux.e = x;
+ uy.e = y;
+ sx = ux.bits.sign;
+ sxy = sx ^ uy.bits.sign;
+ ux.bits.sign = 0; /* |x| */
+ uy.bits.sign = 0; /* |y| */
+ x = ux.e;
+
+ /* purge off exception values */
+ if ((uy.bits.exp|uy.bits.manh|uy.bits.manl)==0 || /* y=0 */
+ (ux.bits.exp == BIAS + LDBL_MAX_EXP) || /* or x not finite */
+ (uy.bits.exp == BIAS + LDBL_MAX_EXP &&
+ ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)!=0)) /* or y is NaN */
+ return (x*y)/(x*y);
+ if (ux.bits.exp <= uy.bits.exp) {
+ if ((ux.bits.exp < uy.bits.exp) ||
+ (ux.bits.manh <= uy.bits.manh &&
+ (ux.bits.manh < uy.bits.manh ||
+ ux.bits.manl < uy.bits.manl))) {
+ q = 0;
+ goto fixup; /* |x|<|y| return x or x-y */
+ }
+ if (ux.bits.manh == uy.bits.manh && ux.bits.manl == uy.bits.manl) {
+ *quo = 1;
+ return Zero[sx]; /* |x|=|y| return x*0*/
+ }
+ }
+
+ /* determine ix = ilogb(x) */
+ if (ux.bits.exp == 0) { /* subnormal x */
+ ux.e *= 0x1.0p512;
+ ix = ux.bits.exp - (BIAS + 512);
+ } else {
+ ix = ux.bits.exp - BIAS;
+ }
+
+ /* determine iy = ilogb(y) */
+ if (uy.bits.exp == 0) { /* subnormal y */
+ uy.e *= 0x1.0p512;
+ iy = uy.bits.exp - (BIAS + 512);
+ } else {
+ iy = uy.bits.exp - BIAS;
+ }
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ hx = SET_NBIT(ux.bits.manh);
+ hy = SET_NBIT(uy.bits.manh);
+ lx = ux.bits.manl;
+ ly = uy.bits.manl;
+
+ /* fix point fmod */
+ n = ix - iy;
+ q = 0;
+
+ while (n--) {
+ hz = hx - hy;
+ lz = lx - ly;
+ if (lx < ly)
+ hz -= 1;
+ if (hz < 0) {
+ hx = hx + hx + (lx>>MANL_SHIFT);
+ lx = lx + lx;
+ } else {
+ hx = hz + hz + (lz>>MANL_SHIFT);
+ lx = lz + lz;
+ q++;
+ }
+ q <<= 1;
+ }
+ hz = hx - hy;
+ lz = lx - ly;
+ if (lx < ly)
+ hz -= 1;
+ if (hz >= 0) {
+ hx = hz;
+ lx = lz;
+ q++;
+ }
+
+ /* convert back to floating value and restore the sign */
+ if ((hx|lx) == 0) { /* return sign(x)*0 */
+ *quo = sxy ? -q : q;
+ return Zero[sx];
+ }
+ while (hx < (1ULL<<HFRAC_BITS)) { /* normalize x */
+ hx = hx + hx + (lx>>MANL_SHIFT);
+ lx = lx + lx;
+ iy -= 1;
+ }
+ ux.bits.manh = hx; /* The integer bit is truncated here if needed. */
+ ux.bits.manl = lx;
+ if (iy < LDBL_MIN_EXP) {
+ ux.bits.exp = iy + (BIAS + 512);
+ ux.e *= 0x1p-512;
+ } else {
+ ux.bits.exp = iy + BIAS;
+ }
+ ux.bits.sign = 0;
+ x = ux.e;
+fixup:
+ y = fabsl(y);
+ if (y < LDBL_MIN * 2) {
+ if (x + x > y || (x + x == y && (q & 1))) {
+ q++;
+ x-=y;
+ }
+ } else if (x > 0.5*y || (x == 0.5*y && (q & 1))) {
+ q++;
+ x-=y;
+ }
+
+ ux.e = x;
+ ux.bits.sign ^= sx;
+ x = ux.e;
+
+ q &= 0x7fffffff;
+ *quo = sxy ? -q : q;
+ return x;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_rint.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * rint(x)
+ * Return x rounded to integral value according to the prevailing
+ * rounding mode.
+ * Method:
+ * Using floating addition.
+ * Exception:
+ * Inexact flag raised if x not equal to rint(x).
+ */
+
+#include "libm.h"
+
+static const double
+TWO52[2] = {
+ 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
+ -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */
+};
+
+double rint(double x)
+{
+ int32_t i0,j0,sx;
+ uint32_t i,i1;
+ double w,t;
+
+ EXTRACT_WORDS(i0, i1, x);
+ // FIXME: signed shift
+ sx = (i0>>31) & 1;
+ j0 = ((i0>>20)&0x7ff) - 0x3ff;
+ if (j0 < 20) {
+ if (j0 < 0) {
+ if (((i0&0x7fffffff)|i1) == 0)
+ return x;
+ i1 |= i0 & 0x0fffff;
+ i0 &= 0xfffe0000;
+ i0 |= ((i1|-i1)>>12) & 0x80000;
+ SET_HIGH_WORD(x, i0);
+ STRICT_ASSIGN(double, w, TWO52[sx] + x);
+ t = w - TWO52[sx];
+ GET_HIGH_WORD(i0, t);
+ SET_HIGH_WORD(t, (i0&0x7fffffff)|(sx<<31));
+ return t;
+ } else {
+ i = 0x000fffff>>j0;
+ if (((i0&i)|i1) == 0)
+ return x; /* x is integral */
+ i >>= 1;
+ if (((i0&i)|i1) != 0) {
+ /*
+ * Some bit is set after the 0.5 bit. To avoid the
+ * possibility of errors from double rounding in
+ * w = TWO52[sx]+x, adjust the 0.25 bit to a lower
+ * guard bit. We do this for all j0<=51. The
+ * adjustment is trickiest for j0==18 and j0==19
+ * since then it spans the word boundary.
+ */
+ if (j0 == 19)
+ i1 = 0x40000000;
+ else if (j0 == 18)
+ i1 = 0x80000000;
+ else
+ i0 = (i0 & ~i)|(0x20000>>j0);
+ }
+ }
+ } else if (j0 > 51) {
+ if (j0 == 0x400)
+ return x+x; /* inf or NaN */
+ return x; /* x is integral */
+ } else {
+ i = (uint32_t)0xffffffff>>(j0-20);
+ if ((i1&i) == 0)
+ return x; /* x is integral */
+ i >>= 1;
+ if ((i1&i) != 0)
+ i1 = (i1 & ~i)|(0x40000000>>(j0-20));
+ }
+ INSERT_WORDS(x, i0, i1);
+ STRICT_ASSIGN(double, w, TWO52[sx] + x);
+ return w - TWO52[sx];
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_rintf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+TWO23[2] = {
+ 8.3886080000e+06, /* 0x4b000000 */
+ -8.3886080000e+06, /* 0xcb000000 */
+};
+
+float rintf(float x)
+{
+ int32_t i0,j0,sx;
+ float w,t;
+
+ GET_FLOAT_WORD(i0, x);
+ sx = (i0>>31) & 1;
+ j0 = ((i0>>23)&0xff) - 0x7f;
+ if (j0 < 23) {
+ if (j0 < 0) {
+ if ((i0&0x7fffffff) == 0)
+ return x;
+ STRICT_ASSIGN(float, w, TWO23[sx] + x);
+ t = w - TWO23[sx];
+ GET_FLOAT_WORD(i0, t);
+ SET_FLOAT_WORD(t, (i0&0x7fffffff)|(sx<<31));
+ return t;
+ }
+ STRICT_ASSIGN(float, w, TWO23[sx] + x);
+ return w - TWO23[sx];
+ }
+ if (j0 == 0x80)
+ return x+x; /* inf or NaN */
+ return x; /* x is integral */
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_rintl.c */
+/*-
+ * Copyright (c) 2008 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double rintl(long double x)
+{
+ return rint(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+
+#define BIAS (LDBL_MAX_EXP - 1)
+
+static const float
+shift[2] = {
+#if LDBL_MANT_DIG == 64
+ 0x1.0p63, -0x1.0p63
+#elif LDBL_MANT_DIG == 113
+ 0x1.0p112, -0x1.0p112
+#else
+#error "Unsupported long double format"
+#endif
+};
+static const float zero[2] = { 0.0, -0.0 };
+
+long double rintl(long double x)
+{
+ union IEEEl2bits u;
+ uint32_t expsign;
+ int ex, sign;
+
+ u.e = x;
+ expsign = u.xbits.expsign;
+ ex = expsign & 0x7fff;
+
+ if (ex >= BIAS + LDBL_MANT_DIG - 1) {
+ if (ex == BIAS + LDBL_MAX_EXP)
+ return x + x; /* Inf, NaN, or unsupported format */
+ return x; /* finite and already an integer */
+ }
+ sign = expsign >> 15;
+
+ /*
+ * The following code assumes that intermediate results are
+ * evaluated in long double precision. If they are evaluated in
+ * greater precision, double rounding may occur, and if they are
+ * evaluated in less precision (as on i386), results will be
+ * wildly incorrect.
+ */
+ x += shift[sign];
+ x -= shift[sign];
+
+ /*
+ * If the result is +-0, then it must have the same sign as x, but
+ * the above calculation doesn't always give this. Fix up the sign.
+ */
+ if (ex < BIAS && x == 0.0L)
+ return zero[sign];
+
+ return x;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_round.c */
+/*-
+ * Copyright (c) 2003, Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+double round(double x)
+{
+ double t;
+
+ if (!isfinite(x))
+ return x;
+
+ if (x >= 0.0) {
+ t = floor(x);
+ if (t - x <= -0.5)
+ t += 1.0;
+ return t;
+ } else {
+ t = floor(-x);
+ if (t + x <= -0.5)
+ t += 1.0;
+ return -t;
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_roundf.c */
+/*-
+ * Copyright (c) 2003, Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include "libm.h"
+
+float roundf(float x)
+{
+ float t;
+
+ if (!isfinite(x))
+ return x;
+
+ if (x >= 0.0) {
+ t = floorf(x);
+ if (t - x <= -0.5)
+ t += 1.0;
+ return t;
+ } else {
+ t = floorf(-x);
+ if (t + x <= -0.5)
+ t += 1.0;
+ return -t;
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_roundl.c */
+/*-
+ * Copyright (c) 2003, Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include "libm.h"
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double roundl(long double x)
+{
+ return round(x);
+}
+#else
+long double roundl(long double x)
+{
+ long double t;
+
+ if (!isfinite(x))
+ return x;
+
+ if (x >= 0.0) {
+ t = floorl(x);
+ if (t - x <= -0.5)
+ t += 1.0;
+ return t;
+ } else {
+ t = floorl(-x);
+ if (t + x <= -0.5)
+ t += 1.0;
+ return -t;
+ }
+}
+#endif
+++ /dev/null
-/* @(#)s_asinh.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* asinh(x)
- * Method :
- * Based on
- * asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ]
- * we have
- * asinh(x) := x if 1+x*x=1,
- * := sign(x)*(log(x)+ln2)) for large |x|, else
- * := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else
- * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2)))
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
-ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
-huge= 1.00000000000000000000e+300;
-
-double
-asinh(double x)
-{
- double t,w;
- int32_t hx,ix;
- GET_HIGH_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x7ff00000) return x+x; /* x is inf or NaN */
- if(ix< 0x3e300000) { /* |x|<2**-28 */
- if(huge+x>one) return x; /* return x inexact except 0 */
- }
- if(ix>0x41b00000) { /* |x| > 2**28 */
- w = log(fabs(x))+ln2;
- } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */
- t = fabs(x);
- w = log(2.0*t+one/(sqrt(x*x+one)+t));
- } else { /* 2.0 > |x| > 2**-28 */
- t = x*x;
- w =log1p(fabs(x)+t/(one+sqrt(one+t)));
- }
- if(hx>0) return w; else return -w;
-}
+++ /dev/null
-/* s_asinhf.c -- float version of s_asinh.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0000000000e+00, /* 0x3F800000 */
-ln2 = 6.9314718246e-01, /* 0x3f317218 */
-huge= 1.0000000000e+30;
-
-float
-asinhf(float x)
-{
- float t,w;
- int32_t hx,ix;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x7f800000) return x+x; /* x is inf or NaN */
- if(ix< 0x31800000) { /* |x|<2**-28 */
- if(huge+x>one) return x; /* return x inexact except 0 */
- }
- if(ix>0x4d800000) { /* |x| > 2**28 */
- w = logf(fabsf(x))+ln2;
- } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */
- t = fabsf(x);
- w = logf((float)2.0*t+one/(sqrtf(x*x+one)+t));
- } else { /* 2.0 > |x| > 2**-28 */
- t = x*x;
- w =log1pf(fabsf(x)+t/(one+sqrtf(one+t)));
- }
- if(hx>0) return w; else return -w;
-}
+++ /dev/null
-/* @(#)s_atan.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* atan(x)
- * Method
- * 1. Reduce x to positive by atan(x) = -atan(-x).
- * 2. According to the integer k=4t+0.25 chopped, t=x, the argument
- * is further reduced to one of the following intervals and the
- * arctangent of t is evaluated by the corresponding formula:
- *
- * [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
- * [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) )
- * [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) )
- * [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) )
- * [39/16,INF] atan(x) = atan(INF) + atan( -1/t )
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double atanhi[] = {
- 4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */
- 7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */
- 9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */
- 1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */
-};
-
-static const double atanlo[] = {
- 2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */
- 3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */
- 1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */
- 6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */
-};
-
-static const double aT[] = {
- 3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */
- -1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */
- 1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */
- -1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */
- 9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */
- -7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */
- 6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */
- -5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */
- 4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */
- -3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */
- 1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */
-};
-
- static const double
-one = 1.0,
-huge = 1.0e300;
-
-double
-atan(double x)
-{
- double w,s1,s2,z;
- int32_t ix,hx,id;
-
- GET_HIGH_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x44100000) { /* if |x| >= 2^66 */
- uint32_t low;
- GET_LOW_WORD(low,x);
- if(ix>0x7ff00000||
- (ix==0x7ff00000&&(low!=0)))
- return x+x; /* NaN */
- if(hx>0) return atanhi[3]+atanlo[3];
- else return -atanhi[3]-atanlo[3];
- } if (ix < 0x3fdc0000) { /* |x| < 0.4375 */
- if (ix < 0x3e200000) { /* |x| < 2^-29 */
- if(huge+x>one) return x; /* raise inexact */
- }
- id = -1;
- } else {
- x = fabs(x);
- if (ix < 0x3ff30000) { /* |x| < 1.1875 */
- if (ix < 0x3fe60000) { /* 7/16 <=|x|<11/16 */
- id = 0; x = (2.0*x-one)/(2.0+x);
- } else { /* 11/16<=|x|< 19/16 */
- id = 1; x = (x-one)/(x+one);
- }
- } else {
- if (ix < 0x40038000) { /* |x| < 2.4375 */
- id = 2; x = (x-1.5)/(one+1.5*x);
- } else { /* 2.4375 <= |x| < 2^66 */
- id = 3; x = -1.0/x;
- }
- }}
- /* end of argument reduction */
- z = x*x;
- w = z*z;
- /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */
- s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10])))));
- s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9]))));
- if (id<0) return x - x*(s1+s2);
- else {
- z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x);
- return (hx<0)? -z:z;
- }
-}
+++ /dev/null
-/* s_atanf.c -- float version of s_atan.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float atanhi[] = {
- 4.6364760399e-01, /* atan(0.5)hi 0x3eed6338 */
- 7.8539812565e-01, /* atan(1.0)hi 0x3f490fda */
- 9.8279368877e-01, /* atan(1.5)hi 0x3f7b985e */
- 1.5707962513e+00, /* atan(inf)hi 0x3fc90fda */
-};
-
-static const float atanlo[] = {
- 5.0121582440e-09, /* atan(0.5)lo 0x31ac3769 */
- 3.7748947079e-08, /* atan(1.0)lo 0x33222168 */
- 3.4473217170e-08, /* atan(1.5)lo 0x33140fb4 */
- 7.5497894159e-08, /* atan(inf)lo 0x33a22168 */
-};
-
-static const float aT[] = {
- 3.3333334327e-01, /* 0x3eaaaaaa */
- -2.0000000298e-01, /* 0xbe4ccccd */
- 1.4285714924e-01, /* 0x3e124925 */
- -1.1111110449e-01, /* 0xbde38e38 */
- 9.0908870101e-02, /* 0x3dba2e6e */
- -7.6918758452e-02, /* 0xbd9d8795 */
- 6.6610731184e-02, /* 0x3d886b35 */
- -5.8335702866e-02, /* 0xbd6ef16b */
- 4.9768779427e-02, /* 0x3d4bda59 */
- -3.6531571299e-02, /* 0xbd15a221 */
- 1.6285819933e-02, /* 0x3c8569d7 */
-};
-
- static const float
-one = 1.0,
-huge = 1.0e30;
-
-float
-atanf(float x)
-{
- float w,s1,s2,z;
- int32_t ix,hx,id;
-
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x50800000) { /* if |x| >= 2^34 */
- if(ix>0x7f800000)
- return x+x; /* NaN */
- if(hx>0) return atanhi[3]+atanlo[3];
- else return -atanhi[3]-atanlo[3];
- } if (ix < 0x3ee00000) { /* |x| < 0.4375 */
- if (ix < 0x31000000) { /* |x| < 2^-29 */
- if(huge+x>one) return x; /* raise inexact */
- }
- id = -1;
- } else {
- x = fabsf(x);
- if (ix < 0x3f980000) { /* |x| < 1.1875 */
- if (ix < 0x3f300000) { /* 7/16 <=|x|<11/16 */
- id = 0; x = ((float)2.0*x-one)/((float)2.0+x);
- } else { /* 11/16<=|x|< 19/16 */
- id = 1; x = (x-one)/(x+one);
- }
- } else {
- if (ix < 0x401c0000) { /* |x| < 2.4375 */
- id = 2; x = (x-(float)1.5)/(one+(float)1.5*x);
- } else { /* 2.4375 <= |x| < 2^66 */
- id = 3; x = -(float)1.0/x;
- }
- }}
- /* end of argument reduction */
- z = x*x;
- w = z*z;
- /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */
- s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10])))));
- s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9]))));
- if (id<0) return x - x*(s1+s2);
- else {
- z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x);
- return (hx<0)? -z:z;
- }
-}
+++ /dev/null
-/* @(#)s_cbrt.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-/* cbrt(x)
- * Return cube root of x
- */
-static const uint32_t
- B1 = 715094163, /* B1 = (682-0.03306235651)*2**20 */
- B2 = 696219795; /* B2 = (664-0.03306235651)*2**20 */
-
-static const double
-C = 5.42857142857142815906e-01, /* 19/35 = 0x3FE15F15, 0xF15F15F1 */
-D = -7.05306122448979611050e-01, /* -864/1225 = 0xBFE691DE, 0x2532C834 */
-E = 1.41428571428571436819e+00, /* 99/70 = 0x3FF6A0EA, 0x0EA0EA0F */
-F = 1.60714285714285720630e+00, /* 45/28 = 0x3FF9B6DB, 0x6DB6DB6E */
-G = 3.57142857142857150787e-01; /* 5/14 = 0x3FD6DB6D, 0xB6DB6DB7 */
-
-double
-cbrt(double x)
-{
- int32_t hx;
- double r,s,t=0.0,w;
- uint32_t sign;
- uint32_t high,low;
-
- GET_HIGH_WORD(hx,x);
- sign=hx&0x80000000; /* sign= sign(x) */
- hx ^=sign;
- if(hx>=0x7ff00000) return(x+x); /* cbrt(NaN,INF) is itself */
- GET_LOW_WORD(low,x);
- if((hx|low)==0)
- return(x); /* cbrt(0) is itself */
-
- SET_HIGH_WORD(x,hx); /* x <- |x| */
- /* rough cbrt to 5 bits */
- if(hx<0x00100000) /* subnormal number */
- {SET_HIGH_WORD(t,0x43500000); /* set t= 2**54 */
- t*=x; GET_HIGH_WORD(high,t); SET_HIGH_WORD(t,high/3+B2);
- }
- else
- SET_HIGH_WORD(t,hx/3+B1);
-
-
- /* new cbrt to 23 bits, may be implemented in single precision */
- r=t*t/x;
- s=C+r*t;
- t*=G+F/(s+E+D/s);
-
- /* chopped to 20 bits and make it larger than cbrt(x) */
- GET_HIGH_WORD(high,t);
- INSERT_WORDS(t,high+0x00000001,0);
-
-
- /* one step newton iteration to 53 bits with error less than 0.667 ulps */
- s=t*t; /* t*t is exact */
- r=x/s;
- w=t+t;
- r=(r-t)/(w+r); /* r-s is exact */
- t=t+t*r;
-
- /* retore the sign bit */
- GET_HIGH_WORD(high,t);
- SET_HIGH_WORD(t,high|sign);
- return(t);
-}
+++ /dev/null
-/* s_cbrtf.c -- float version of s_cbrt.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-/* cbrtf(x)
- * Return cube root of x
- */
-static const unsigned
- B1 = 709958130, /* B1 = (84+2/3-0.03306235651)*2**23 */
- B2 = 642849266; /* B2 = (76+2/3-0.03306235651)*2**23 */
-
-static const float
-C = 5.4285717010e-01, /* 19/35 = 0x3f0af8b0 */
-D = -7.0530611277e-01, /* -864/1225 = 0xbf348ef1 */
-E = 1.4142856598e+00, /* 99/70 = 0x3fb50750 */
-F = 1.6071428061e+00, /* 45/28 = 0x3fcdb6db */
-G = 3.5714286566e-01; /* 5/14 = 0x3eb6db6e */
-
-float
-cbrtf(float x)
-{
- float r,s,t;
- int32_t hx;
- uint32_t sign;
- uint32_t high;
-
- GET_FLOAT_WORD(hx,x);
- sign=hx&0x80000000; /* sign= sign(x) */
- hx ^=sign;
- if(hx>=0x7f800000) return(x+x); /* cbrt(NaN,INF) is itself */
- if(hx==0)
- return(x); /* cbrt(0) is itself */
-
- SET_FLOAT_WORD(x,hx); /* x <- |x| */
- /* rough cbrt to 5 bits */
- if(hx<0x00800000) /* subnormal number */
- {SET_FLOAT_WORD(t,0x4b800000); /* set t= 2**24 */
- t*=x; GET_FLOAT_WORD(high,t); SET_FLOAT_WORD(t,high/3+B2);
- }
- else
- SET_FLOAT_WORD(t,hx/3+B1);
-
-
- /* new cbrt to 23 bits */
- r=t*t/x;
- s=C+r*t;
- t*=G+F/(s+E+D/s);
-
- /* retore the sign bit */
- GET_FLOAT_WORD(high,t);
- SET_FLOAT_WORD(t,high|sign);
- return(t);
-}
+++ /dev/null
-/* @(#)s_ceil.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * ceil(x)
- * Return x rounded toward -inf to integral value
- * Method:
- * Bit twiddling.
- * Exception:
- * Inexact flag raised if x not equal to ceil(x).
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double huge = 1.0e300;
-
-double
-ceil(double x)
-{
- int32_t i0,i1,j0;
- uint32_t i,j;
- EXTRACT_WORDS(i0,i1,x);
- j0 = ((i0>>20)&0x7ff)-0x3ff;
- if(j0<20) {
- if(j0<0) { /* raise inexact if x != 0 */
- if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */
- if(i0<0) {i0=0x80000000;i1=0;}
- else if((i0|i1)!=0) { i0=0x3ff00000;i1=0;}
- }
- } else {
- i = (0x000fffff)>>j0;
- if(((i0&i)|i1)==0) return x; /* x is integral */
- if(huge+x>0.0) { /* raise inexact flag */
- if(i0>0) i0 += (0x00100000)>>j0;
- i0 &= (~i); i1=0;
- }
- }
- } else if (j0>51) {
- if(j0==0x400) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- } else {
- i = ((uint32_t)(0xffffffff))>>(j0-20);
- if((i1&i)==0) return x; /* x is integral */
- if(huge+x>0.0) { /* raise inexact flag */
- if(i0>0) {
- if(j0==20) i0+=1;
- else {
- j = i1 + (1<<(52-j0));
- if(j<i1) i0+=1; /* got a carry */
- i1 = j;
- }
- }
- i1 &= (~i);
- }
- }
- INSERT_WORDS(x,i0,i1);
- return x;
-}
+++ /dev/null
-/* s_ceilf.c -- float version of s_ceil.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float huge = 1.0e30;
-
-float
-ceilf(float x)
-{
- int32_t i0,j0;
- uint32_t i;
-
- GET_FLOAT_WORD(i0,x);
- j0 = ((i0>>23)&0xff)-0x7f;
- if(j0<23) {
- if(j0<0) { /* raise inexact if x != 0 */
- if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */
- if(i0<0) {i0=0x80000000;}
- else if(i0!=0) { i0=0x3f800000;}
- }
- } else {
- i = (0x007fffff)>>j0;
- if((i0&i)==0) return x; /* x is integral */
- if(huge+x>(float)0.0) { /* raise inexact flag */
- if(i0>0) i0 += (0x00800000)>>j0;
- i0 &= (~i);
- }
- }
- } else {
- if(j0==0x80) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- }
- SET_FLOAT_WORD(x,i0);
- return x;
-}
+++ /dev/null
-/* @(#)s_copysign.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * copysign(double x, double y)
- * copysign(x,y) returns a value with the magnitude of x and
- * with the sign bit of y.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-copysign(double x, double y)
-{
- uint32_t hx,hy;
- GET_HIGH_WORD(hx,x);
- GET_HIGH_WORD(hy,y);
- SET_HIGH_WORD(x,(hx&0x7fffffff)|(hy&0x80000000));
- return x;
-}
+++ /dev/null
-/* s_copysignf.c -- float version of s_copysign.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * copysignf(float x, float y)
- * copysignf(x,y) returns a value with the magnitude of x and
- * with the sign bit of y.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-copysignf(float x, float y)
-{
- uint32_t ix,iy;
- GET_FLOAT_WORD(ix,x);
- GET_FLOAT_WORD(iy,y);
- SET_FLOAT_WORD(x,(ix&0x7fffffff)|(iy&0x80000000));
- return x;
-}
+++ /dev/null
-/* @(#)s_cos.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* cos(x)
- * Return cosine function of x.
- *
- * kernel function:
- * __kernel_sin ... sine function on [-pi/4,pi/4]
- * __kernel_cos ... cosine function on [-pi/4,pi/4]
- * __ieee754_rem_pio2 ... argument reduction routine
- *
- * Method.
- * Let S,C and T denote the sin, cos and tan respectively on
- * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
- * in [-pi/4 , +pi/4], and let n = k mod 4.
- * We have
- *
- * n sin(x) cos(x) tan(x)
- * ----------------------------------------------------------
- * 0 S C T
- * 1 C -S -1/T
- * 2 -S -C T
- * 3 -C S -1/T
- * ----------------------------------------------------------
- *
- * Special cases:
- * Let trig be any of sin, cos, or tan.
- * trig(+-INF) is NaN, with signals;
- * trig(NaN) is that NaN;
- *
- * Accuracy:
- * TRIG(x) returns trig(x) nearly rounded
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-cos(double x)
-{
- double y[2],z=0.0;
- int32_t n, ix;
-
- /* High word of x. */
- GET_HIGH_WORD(ix,x);
-
- /* |x| ~< pi/4 */
- ix &= 0x7fffffff;
- if(ix <= 0x3fe921fb) return __kernel_cos(x,z);
-
- /* cos(Inf or NaN) is NaN */
- else if (ix>=0x7ff00000) return x-x;
-
- /* argument reduction needed */
- else {
- n = __ieee754_rem_pio2(x,y);
- switch(n&3) {
- case 0: return __kernel_cos(y[0],y[1]);
- case 1: return -__kernel_sin(y[0],y[1],1);
- case 2: return -__kernel_cos(y[0],y[1]);
- default:
- return __kernel_sin(y[0],y[1],1);
- }
- }
-}
+++ /dev/null
-/* s_cosf.c -- float version of s_cos.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one=1.0;
-
-float
-cosf(float x)
-{
- float y[2],z=0.0;
- int32_t n,ix;
-
- GET_FLOAT_WORD(ix,x);
-
- /* |x| ~< pi/4 */
- ix &= 0x7fffffff;
- if(ix <= 0x3f490fd8) return __kernel_cosf(x,z);
-
- /* cos(Inf or NaN) is NaN */
- else if (ix>=0x7f800000) return x-x;
-
- /* argument reduction needed */
- else {
- n = __ieee754_rem_pio2f(x,y);
- switch(n&3) {
- case 0: return __kernel_cosf(y[0],y[1]);
- case 1: return -__kernel_sinf(y[0],y[1],1);
- case 2: return -__kernel_cosf(y[0],y[1]);
- default:
- return __kernel_sinf(y[0],y[1],1);
- }
- }
-}
+++ /dev/null
-/* @(#)s_erf.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* double erf(double x)
- * double erfc(double x)
- * x
- * 2 |\
- * erf(x) = --------- | exp(-t*t)dt
- * sqrt(pi) \|
- * 0
- *
- * erfc(x) = 1-erf(x)
- * Note that
- * erf(-x) = -erf(x)
- * erfc(-x) = 2 - erfc(x)
- *
- * Method:
- * 1. For |x| in [0, 0.84375]
- * erf(x) = x + x*R(x^2)
- * erfc(x) = 1 - erf(x) if x in [-.84375,0.25]
- * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375]
- * where R = P/Q where P is an odd poly of degree 8 and
- * Q is an odd poly of degree 10.
- * -57.90
- * | R - (erf(x)-x)/x | <= 2
- *
- *
- * Remark. The formula is derived by noting
- * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
- * and that
- * 2/sqrt(pi) = 1.128379167095512573896158903121545171688
- * is close to one. The interval is chosen because the fix
- * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
- * near 0.6174), and by some experiment, 0.84375 is chosen to
- * guarantee the error is less than one ulp for erf.
- *
- * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and
- * c = 0.84506291151 rounded to single (24 bits)
- * erf(x) = sign(x) * (c + P1(s)/Q1(s))
- * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0
- * 1+(c+P1(s)/Q1(s)) if x < 0
- * |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06
- * Remark: here we use the taylor series expansion at x=1.
- * erf(1+s) = erf(1) + s*Poly(s)
- * = 0.845.. + P1(s)/Q1(s)
- * That is, we use rational approximation to approximate
- * erf(1+s) - (c = (single)0.84506291151)
- * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
- * where
- * P1(s) = degree 6 poly in s
- * Q1(s) = degree 6 poly in s
- *
- * 3. For x in [1.25,1/0.35(~2.857143)],
- * erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1)
- * erf(x) = 1 - erfc(x)
- * where
- * R1(z) = degree 7 poly in z, (z=1/x^2)
- * S1(z) = degree 8 poly in z
- *
- * 4. For x in [1/0.35,28]
- * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
- * = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6<x<0
- * = 2.0 - tiny (if x <= -6)
- * erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6, else
- * erf(x) = sign(x)*(1.0 - tiny)
- * where
- * R2(z) = degree 6 poly in z, (z=1/x^2)
- * S2(z) = degree 7 poly in z
- *
- * Note1:
- * To compute exp(-x*x-0.5625+R/S), let s be a single
- * precision number and s := x; then
- * -x*x = -s*s + (s-x)*(s+x)
- * exp(-x*x-0.5626+R/S) =
- * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S);
- * Note2:
- * Here 4 and 5 make use of the asymptotic series
- * exp(-x*x)
- * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) )
- * x*sqrt(pi)
- * We use rational approximation to approximate
- * g(s)=f(1/x^2) = log(erfc(x)*x) - x*x + 0.5625
- * Here is the error bound for R1/S1 and R2/S2
- * |R1/S1 - f(x)| < 2**(-62.57)
- * |R2/S2 - f(x)| < 2**(-61.52)
- *
- * 5. For inf > x >= 28
- * erf(x) = sign(x) *(1 - tiny) (raise inexact)
- * erfc(x) = tiny*tiny (raise underflow) if x > 0
- * = 2 - tiny if x<0
- *
- * 7. Special case:
- * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
- * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
- * erfc/erf(NaN) is NaN
- */
-
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-tiny = 1e-300,
-half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
-one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
-two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
- /* c = (float)0.84506291151 */
-erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */
-/*
- * Coefficients for approximation to erf on [0,0.84375]
- */
-efx = 1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */
-efx8= 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */
-pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */
-pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */
-pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */
-pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */
-pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */
-qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */
-qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */
-qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */
-qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */
-qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */
-/*
- * Coefficients for approximation to erf in [0.84375,1.25]
- */
-pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */
-pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */
-pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */
-pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */
-pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */
-pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */
-pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */
-qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */
-qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */
-qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */
-qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */
-qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */
-qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */
-/*
- * Coefficients for approximation to erfc in [1.25,1/0.35]
- */
-ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */
-ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */
-ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */
-ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */
-ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */
-ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */
-ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */
-ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */
-sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */
-sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */
-sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */
-sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */
-sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */
-sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */
-sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */
-sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */
-/*
- * Coefficients for approximation to erfc in [1/.35,28]
- */
-rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */
-rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */
-rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */
-rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */
-rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */
-rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */
-rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */
-sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */
-sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */
-sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */
-sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */
-sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */
-sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */
-sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */
-
-double
-erf(double x)
-{
- int32_t hx,ix,i;
- double R,S,P,Q,s,y,z,r;
- GET_HIGH_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x7ff00000) { /* erf(nan)=nan */
- i = ((uint32_t)hx>>31)<<1;
- return (double)(1-i)+one/x; /* erf(+-inf)=+-1 */
- }
-
- if(ix < 0x3feb0000) { /* |x|<0.84375 */
- if(ix < 0x3e300000) { /* |x|<2**-28 */
- if (ix < 0x00800000)
- return 0.125*(8.0*x+efx8*x); /*avoid underflow */
- return x + efx*x;
- }
- z = x*x;
- r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
- s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
- y = r/s;
- return x + x*y;
- }
- if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
- s = fabs(x)-one;
- P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
- Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
- if(hx>=0) return erx + P/Q; else return -erx - P/Q;
- }
- if (ix >= 0x40180000) { /* inf>|x|>=6 */
- if(hx>=0) return one-tiny; else return tiny-one;
- }
- x = fabs(x);
- s = one/(x*x);
- if(ix< 0x4006DB6E) { /* |x| < 1/0.35 */
- R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
- ra5+s*(ra6+s*ra7))))));
- S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
- sa5+s*(sa6+s*(sa7+s*sa8)))))));
- } else { /* |x| >= 1/0.35 */
- R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
- rb5+s*rb6)))));
- S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
- sb5+s*(sb6+s*sb7))))));
- }
- z = x;
- SET_LOW_WORD(z,0);
- r = exp(-z*z-0.5625)*exp((z-x)*(z+x)+R/S);
- if(hx>=0) return one-r/x; else return r/x-one;
-}
-
-double
-erfc(double x)
-{
- int32_t hx,ix;
- double R,S,P,Q,s,y,z,r;
- GET_HIGH_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x7ff00000) { /* erfc(nan)=nan */
- /* erfc(+-inf)=0,2 */
- return (double)(((uint32_t)hx>>31)<<1)+one/x;
- }
-
- if(ix < 0x3feb0000) { /* |x|<0.84375 */
- if(ix < 0x3c700000) /* |x|<2**-56 */
- return one-x;
- z = x*x;
- r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
- s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
- y = r/s;
- if(hx < 0x3fd00000) { /* x<1/4 */
- return one-(x+x*y);
- } else {
- r = x*y;
- r += (x-half);
- return half - r ;
- }
- }
- if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
- s = fabs(x)-one;
- P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
- Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
- if(hx>=0) {
- z = one-erx; return z - P/Q;
- } else {
- z = erx+P/Q; return one+z;
- }
- }
- if (ix < 0x403c0000) { /* |x|<28 */
- x = fabs(x);
- s = one/(x*x);
- if(ix< 0x4006DB6D) { /* |x| < 1/.35 ~ 2.857143*/
- R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
- ra5+s*(ra6+s*ra7))))));
- S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
- sa5+s*(sa6+s*(sa7+s*sa8)))))));
- } else { /* |x| >= 1/.35 ~ 2.857143 */
- if(hx<0&&ix>=0x40180000) return two-tiny;/* x < -6 */
- R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
- rb5+s*rb6)))));
- S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
- sb5+s*(sb6+s*sb7))))));
- }
- z = x;
- SET_LOW_WORD(z,0);
- r = exp(-z*z-0.5625)*
- exp((z-x)*(z+x)+R/S);
- if(hx>0) return r/x; else return two-r/x;
- } else {
- if(hx>0) return tiny*tiny; else return two-tiny;
- }
-}
+++ /dev/null
-/* s_erff.c -- float version of s_erf.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-tiny = 1e-30,
-half= 5.0000000000e-01, /* 0x3F000000 */
-one = 1.0000000000e+00, /* 0x3F800000 */
-two = 2.0000000000e+00, /* 0x40000000 */
- /* c = (subfloat)0.84506291151 */
-erx = 8.4506291151e-01, /* 0x3f58560b */
-/*
- * Coefficients for approximation to erf on [0,0.84375]
- */
-efx = 1.2837916613e-01, /* 0x3e0375d4 */
-efx8= 1.0270333290e+00, /* 0x3f8375d4 */
-pp0 = 1.2837916613e-01, /* 0x3e0375d4 */
-pp1 = -3.2504209876e-01, /* 0xbea66beb */
-pp2 = -2.8481749818e-02, /* 0xbce9528f */
-pp3 = -5.7702702470e-03, /* 0xbbbd1489 */
-pp4 = -2.3763017452e-05, /* 0xb7c756b1 */
-qq1 = 3.9791721106e-01, /* 0x3ecbbbce */
-qq2 = 6.5022252500e-02, /* 0x3d852a63 */
-qq3 = 5.0813062117e-03, /* 0x3ba68116 */
-qq4 = 1.3249473704e-04, /* 0x390aee49 */
-qq5 = -3.9602282413e-06, /* 0xb684e21a */
-/*
- * Coefficients for approximation to erf in [0.84375,1.25]
- */
-pa0 = -2.3621185683e-03, /* 0xbb1acdc6 */
-pa1 = 4.1485610604e-01, /* 0x3ed46805 */
-pa2 = -3.7220788002e-01, /* 0xbebe9208 */
-pa3 = 3.1834661961e-01, /* 0x3ea2fe54 */
-pa4 = -1.1089469492e-01, /* 0xbde31cc2 */
-pa5 = 3.5478305072e-02, /* 0x3d1151b3 */
-pa6 = -2.1663755178e-03, /* 0xbb0df9c0 */
-qa1 = 1.0642088205e-01, /* 0x3dd9f331 */
-qa2 = 5.4039794207e-01, /* 0x3f0a5785 */
-qa3 = 7.1828655899e-02, /* 0x3d931ae7 */
-qa4 = 1.2617121637e-01, /* 0x3e013307 */
-qa5 = 1.3637083583e-02, /* 0x3c5f6e13 */
-qa6 = 1.1984500103e-02, /* 0x3c445aa3 */
-/*
- * Coefficients for approximation to erfc in [1.25,1/0.35]
- */
-ra0 = -9.8649440333e-03, /* 0xbc21a093 */
-ra1 = -6.9385856390e-01, /* 0xbf31a0b7 */
-ra2 = -1.0558626175e+01, /* 0xc128f022 */
-ra3 = -6.2375331879e+01, /* 0xc2798057 */
-ra4 = -1.6239666748e+02, /* 0xc322658c */
-ra5 = -1.8460508728e+02, /* 0xc3389ae7 */
-ra6 = -8.1287437439e+01, /* 0xc2a2932b */
-ra7 = -9.8143291473e+00, /* 0xc11d077e */
-sa1 = 1.9651271820e+01, /* 0x419d35ce */
-sa2 = 1.3765776062e+02, /* 0x4309a863 */
-sa3 = 4.3456588745e+02, /* 0x43d9486f */
-sa4 = 6.4538726807e+02, /* 0x442158c9 */
-sa5 = 4.2900814819e+02, /* 0x43d6810b */
-sa6 = 1.0863500214e+02, /* 0x42d9451f */
-sa7 = 6.5702495575e+00, /* 0x40d23f7c */
-sa8 = -6.0424413532e-02, /* 0xbd777f97 */
-/*
- * Coefficients for approximation to erfc in [1/.35,28]
- */
-rb0 = -9.8649431020e-03, /* 0xbc21a092 */
-rb1 = -7.9928326607e-01, /* 0xbf4c9dd4 */
-rb2 = -1.7757955551e+01, /* 0xc18e104b */
-rb3 = -1.6063638306e+02, /* 0xc320a2ea */
-rb4 = -6.3756646729e+02, /* 0xc41f6441 */
-rb5 = -1.0250950928e+03, /* 0xc480230b */
-rb6 = -4.8351919556e+02, /* 0xc3f1c275 */
-sb1 = 3.0338060379e+01, /* 0x41f2b459 */
-sb2 = 3.2579251099e+02, /* 0x43a2e571 */
-sb3 = 1.5367296143e+03, /* 0x44c01759 */
-sb4 = 3.1998581543e+03, /* 0x4547fdbb */
-sb5 = 2.5530502930e+03, /* 0x451f90ce */
-sb6 = 4.7452853394e+02, /* 0x43ed43a7 */
-sb7 = -2.2440952301e+01; /* 0xc1b38712 */
-
-float
-erff(float x)
-{
- int32_t hx,ix,i;
- float R,S,P,Q,s,y,z,r;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x7f800000) { /* erf(nan)=nan */
- i = ((uint32_t)hx>>31)<<1;
- return (float)(1-i)+one/x; /* erf(+-inf)=+-1 */
- }
-
- if(ix < 0x3f580000) { /* |x|<0.84375 */
- if(ix < 0x31800000) { /* |x|<2**-28 */
- if (ix < 0x04000000)
- /*avoid underflow */
- return (float)0.125*((float)8.0*x+efx8*x);
- return x + efx*x;
- }
- z = x*x;
- r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
- s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
- y = r/s;
- return x + x*y;
- }
- if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */
- s = fabsf(x)-one;
- P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
- Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
- if(hx>=0) return erx + P/Q; else return -erx - P/Q;
- }
- if (ix >= 0x40c00000) { /* inf>|x|>=6 */
- if(hx>=0) return one-tiny; else return tiny-one;
- }
- x = fabsf(x);
- s = one/(x*x);
- if(ix< 0x4036DB6E) { /* |x| < 1/0.35 */
- R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
- ra5+s*(ra6+s*ra7))))));
- S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
- sa5+s*(sa6+s*(sa7+s*sa8)))))));
- } else { /* |x| >= 1/0.35 */
- R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
- rb5+s*rb6)))));
- S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
- sb5+s*(sb6+s*sb7))))));
- }
- GET_FLOAT_WORD(ix,x);
- SET_FLOAT_WORD(z,ix&0xfffff000);
- r = expf(-z*z-(float)0.5625)*expf((z-x)*(z+x)+R/S);
- if(hx>=0) return one-r/x; else return r/x-one;
-}
-
-float
-erfcf(float x)
-{
- int32_t hx,ix;
- float R,S,P,Q,s,y,z,r;
- GET_FLOAT_WORD(hx,x);
- ix = hx&0x7fffffff;
- if(ix>=0x7f800000) { /* erfc(nan)=nan */
- /* erfc(+-inf)=0,2 */
- return (float)(((uint32_t)hx>>31)<<1)+one/x;
- }
-
- if(ix < 0x3f580000) { /* |x|<0.84375 */
- if(ix < 0x23800000) /* |x|<2**-56 */
- return one-x;
- z = x*x;
- r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
- s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
- y = r/s;
- if(hx < 0x3e800000) { /* x<1/4 */
- return one-(x+x*y);
- } else {
- r = x*y;
- r += (x-half);
- return half - r ;
- }
- }
- if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */
- s = fabsf(x)-one;
- P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
- Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
- if(hx>=0) {
- z = one-erx; return z - P/Q;
- } else {
- z = erx+P/Q; return one+z;
- }
- }
- if (ix < 0x41e00000) { /* |x|<28 */
- x = fabsf(x);
- s = one/(x*x);
- if(ix< 0x4036DB6D) { /* |x| < 1/.35 ~ 2.857143*/
- R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
- ra5+s*(ra6+s*ra7))))));
- S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
- sa5+s*(sa6+s*(sa7+s*sa8)))))));
- } else { /* |x| >= 1/.35 ~ 2.857143 */
- if(hx<0&&ix>=0x40c00000) return two-tiny;/* x < -6 */
- R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
- rb5+s*rb6)))));
- S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
- sb5+s*(sb6+s*sb7))))));
- }
- GET_FLOAT_WORD(ix,x);
- SET_FLOAT_WORD(z,ix&0xfffff000);
- r = expf(-z*z-(float)0.5625)*
- expf((z-x)*(z+x)+R/S);
- if(hx>0) return r/x; else return two-r/x;
- } else {
- if(hx>0) return tiny*tiny; else return two-tiny;
- }
-}
+++ /dev/null
-/* @(#)s_expm1.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* expm1(x)
- * Returns exp(x)-1, the exponential of x minus 1.
- *
- * Method
- * 1. Argument reduction:
- * Given x, find r and integer k such that
- *
- * x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658
- *
- * Here a correction term c will be computed to compensate
- * the error in r when rounded to a floating-point number.
- *
- * 2. Approximating expm1(r) by a special rational function on
- * the interval [0,0.34658]:
- * Since
- * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ...
- * we define R1(r*r) by
- * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r)
- * That is,
- * R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r)
- * = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r))
- * = 1 - r^2/60 + r^4/2520 - r^6/100800 + ...
- * We use a special Reme algorithm on [0,0.347] to generate
- * a polynomial of degree 5 in r*r to approximate R1. The
- * maximum error of this polynomial approximation is bounded
- * by 2**-61. In other words,
- * R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5
- * where Q1 = -1.6666666666666567384E-2,
- * Q2 = 3.9682539681370365873E-4,
- * Q3 = -9.9206344733435987357E-6,
- * Q4 = 2.5051361420808517002E-7,
- * Q5 = -6.2843505682382617102E-9;
- * (where z=r*r, and the values of Q1 to Q5 are listed below)
- * with error bounded by
- * | 5 | -61
- * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2
- * | |
- *
- * expm1(r) = exp(r)-1 is then computed by the following
- * specific way which minimize the accumulation rounding error:
- * 2 3
- * r r [ 3 - (R1 + R1*r/2) ]
- * expm1(r) = r + --- + --- * [--------------------]
- * 2 2 [ 6 - r*(3 - R1*r/2) ]
- *
- * To compensate the error in the argument reduction, we use
- * expm1(r+c) = expm1(r) + c + expm1(r)*c
- * ~ expm1(r) + c + r*c
- * Thus c+r*c will be added in as the correction terms for
- * expm1(r+c). Now rearrange the term to avoid optimization
- * screw up:
- * ( 2 2 )
- * ({ ( r [ R1 - (3 - R1*r/2) ] ) } r )
- * expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- )
- * ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 )
- * ( )
- *
- * = r - E
- * 3. Scale back to obtain expm1(x):
- * From step 1, we have
- * expm1(x) = either 2^k*[expm1(r)+1] - 1
- * = or 2^k*[expm1(r) + (1-2^-k)]
- * 4. Implementation notes:
- * (A). To save one multiplication, we scale the coefficient Qi
- * to Qi*2^i, and replace z by (x^2)/2.
- * (B). To achieve maximum accuracy, we compute expm1(x) by
- * (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf)
- * (ii) if k=0, return r-E
- * (iii) if k=-1, return 0.5*(r-E)-0.5
- * (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E)
- * else return 1.0+2.0*(r-E);
- * (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1)
- * (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else
- * (vii) return 2^k(1-((E+2^-k)-r))
- *
- * Special cases:
- * expm1(INF) is INF, expm1(NaN) is NaN;
- * expm1(-INF) is -1, and
- * for finite argument, only expm1(0)=0 is exact.
- *
- * Accuracy:
- * according to an error analysis, the error is always less than
- * 1 ulp (unit in the last place).
- *
- * Misc. info.
- * For IEEE double
- * if x > 7.09782712893383973096e+02 then expm1(x) overflow
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-one = 1.0,
-huge = 1.0e+300,
-tiny = 1.0e-300,
-o_threshold = 7.09782712893383973096e+02,/* 0x40862E42, 0xFEFA39EF */
-ln2_hi = 6.93147180369123816490e-01,/* 0x3fe62e42, 0xfee00000 */
-ln2_lo = 1.90821492927058770002e-10,/* 0x3dea39ef, 0x35793c76 */
-invln2 = 1.44269504088896338700e+00,/* 0x3ff71547, 0x652b82fe */
- /* scaled coefficients related to expm1 */
-Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */
-Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */
-Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */
-Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */
-Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */
-
-double
-expm1(double x)
-{
- double y,hi,lo,c=0.0,t,e,hxs,hfx,r1;
- int32_t k,xsb;
- uint32_t hx;
-
- GET_HIGH_WORD(hx,x);
- xsb = hx&0x80000000; /* sign bit of x */
- if(xsb==0) y=x; else y= -x; /* y = |x| */
- hx &= 0x7fffffff; /* high word of |x| */
-
- /* filter out huge and non-finite argument */
- if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */
- if(hx >= 0x40862E42) { /* if |x|>=709.78... */
- if(hx>=0x7ff00000) {
- uint32_t low;
- GET_LOW_WORD(low,x);
- if(((hx&0xfffff)|low)!=0)
- return x+x; /* NaN */
- else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */
- }
- if(x > o_threshold) return huge*huge; /* overflow */
- }
- if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */
- if(x+tiny<0.0) /* raise inexact */
- return tiny-one; /* return -1 */
- }
- }
-
- /* argument reduction */
- if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
- if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
- if(xsb==0)
- {hi = x - ln2_hi; lo = ln2_lo; k = 1;}
- else
- {hi = x + ln2_hi; lo = -ln2_lo; k = -1;}
- } else {
- k = invln2*x+((xsb==0)?0.5:-0.5);
- t = k;
- hi = x - t*ln2_hi; /* t*ln2_hi is exact here */
- lo = t*ln2_lo;
- }
- x = hi - lo;
- c = (hi-x)-lo;
- }
- else if(hx < 0x3c900000) { /* when |x|<2**-54, return x */
- t = huge+x; /* return x with inexact flags when x!=0 */
- return x - (t-(huge+x));
- }
- else k = 0;
-
- /* x is now in primary range */
- hfx = 0.5*x;
- hxs = x*hfx;
- r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5))));
- t = 3.0-r1*hfx;
- e = hxs*((r1-t)/(6.0 - x*t));
- if(k==0) return x - (x*e-hxs); /* c is 0 */
- else {
- e = (x*(e-c)-c);
- e -= hxs;
- if(k== -1) return 0.5*(x-e)-0.5;
- if(k==1) {
- if(x < -0.25) return -2.0*(e-(x+0.5));
- else return one+2.0*(x-e);
- }
- if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */
- uint32_t high;
- y = one-(e-x);
- GET_HIGH_WORD(high,y);
- SET_HIGH_WORD(y,high+(k<<20)); /* add k to y's exponent */
- return y-one;
- }
- t = one;
- if(k<20) {
- uint32_t high;
- SET_HIGH_WORD(t,0x3ff00000 - (0x200000>>k)); /* t=1-2^-k */
- y = t-(e-x);
- GET_HIGH_WORD(high,y);
- SET_HIGH_WORD(y,high+(k<<20)); /* add k to y's exponent */
- } else {
- uint32_t high;
- SET_HIGH_WORD(t,((0x3ff-k)<<20)); /* 2^-k */
- y = x-(e+t);
- y += one;
- GET_HIGH_WORD(high,y);
- SET_HIGH_WORD(y,high+(k<<20)); /* add k to y's exponent */
- }
- }
- return y;
-}
+++ /dev/null
-/* s_expm1f.c -- float version of s_expm1.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-one = 1.0,
-huge = 1.0e+30,
-tiny = 1.0e-30,
-o_threshold = 8.8721679688e+01,/* 0x42b17180 */
-ln2_hi = 6.9313812256e-01,/* 0x3f317180 */
-ln2_lo = 9.0580006145e-06,/* 0x3717f7d1 */
-invln2 = 1.4426950216e+00,/* 0x3fb8aa3b */
- /* scaled coefficients related to expm1 */
-Q1 = -3.3333335072e-02, /* 0xbd088889 */
-Q2 = 1.5873016091e-03, /* 0x3ad00d01 */
-Q3 = -7.9365076090e-05, /* 0xb8a670cd */
-Q4 = 4.0082177293e-06, /* 0x36867e54 */
-Q5 = -2.0109921195e-07; /* 0xb457edbb */
-
-float
-expm1f(float x)
-{
- float y,hi,lo,c=0.0,t,e,hxs,hfx,r1;
- int32_t k,xsb;
- uint32_t hx;
-
- GET_FLOAT_WORD(hx,x);
- xsb = hx&0x80000000; /* sign bit of x */
- if(xsb==0) y=x; else y= -x; /* y = |x| */
- hx &= 0x7fffffff; /* high word of |x| */
-
- /* filter out huge and non-finite argument */
- if(hx >= 0x4195b844) { /* if |x|>=27*ln2 */
- if(hx >= 0x42b17218) { /* if |x|>=88.721... */
- if(hx>0x7f800000)
- return x+x; /* NaN */
- if(hx==0x7f800000)
- return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */
- if(x > o_threshold) return huge*huge; /* overflow */
- }
- if(xsb!=0) { /* x < -27*ln2, return -1.0 with inexact */
- if(x+tiny<(float)0.0) /* raise inexact */
- return tiny-one; /* return -1 */
- }
- }
-
- /* argument reduction */
- if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */
- if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */
- if(xsb==0)
- {hi = x - ln2_hi; lo = ln2_lo; k = 1;}
- else
- {hi = x + ln2_hi; lo = -ln2_lo; k = -1;}
- } else {
- k = invln2*x+((xsb==0)?(float)0.5:(float)-0.5);
- t = k;
- hi = x - t*ln2_hi; /* t*ln2_hi is exact here */
- lo = t*ln2_lo;
- }
- x = hi - lo;
- c = (hi-x)-lo;
- }
- else if(hx < 0x33000000) { /* when |x|<2**-25, return x */
- t = huge+x; /* return x with inexact flags when x!=0 */
- return x - (t-(huge+x));
- }
- else k = 0;
-
- /* x is now in primary range */
- hfx = (float)0.5*x;
- hxs = x*hfx;
- r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5))));
- t = (float)3.0-r1*hfx;
- e = hxs*((r1-t)/((float)6.0 - x*t));
- if(k==0) return x - (x*e-hxs); /* c is 0 */
- else {
- e = (x*(e-c)-c);
- e -= hxs;
- if(k== -1) return (float)0.5*(x-e)-(float)0.5;
- if(k==1) {
- if(x < (float)-0.25) return -(float)2.0*(e-(x+(float)0.5));
- else return one+(float)2.0*(x-e);
- }
- if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */
- int32_t i;
- y = one-(e-x);
- GET_FLOAT_WORD(i,y);
- SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */
- return y-one;
- }
- t = one;
- if(k<23) {
- int32_t i;
- SET_FLOAT_WORD(t,0x3f800000 - (0x1000000>>k)); /* t=1-2^-k */
- y = t-(e-x);
- GET_FLOAT_WORD(i,y);
- SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */
- } else {
- int32_t i;
- SET_FLOAT_WORD(t,((0x7f-k)<<23)); /* 2^-k */
- y = x-(e+t);
- y += one;
- GET_FLOAT_WORD(i,y);
- SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */
- }
- }
- return y;
-}
+++ /dev/null
-/* @(#)s_fabs.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * fabs(x) returns the absolute value of x.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-fabs(double x)
-{
- uint32_t high;
- GET_HIGH_WORD(high,x);
- SET_HIGH_WORD(x,high&0x7fffffff);
- return x;
-}
+++ /dev/null
-/* s_fabsf.c -- float version of s_fabs.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * fabsf(x) returns the absolute value of x.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-fabsf(float x)
-{
- uint32_t ix;
- GET_FLOAT_WORD(ix,x);
- SET_FLOAT_WORD(x,ix&0x7fffffff);
- return x;
-}
+++ /dev/null
-/* @(#)s_floor.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * floor(x)
- * Return x rounded toward -inf to integral value
- * Method:
- * Bit twiddling.
- * Exception:
- * Inexact flag raised if x not equal to floor(x).
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double huge = 1.0e300;
-
-double
-floor(double x)
-{
- int32_t i0,i1,j0;
- uint32_t i,j;
- EXTRACT_WORDS(i0,i1,x);
- j0 = ((i0>>20)&0x7ff)-0x3ff;
- if(j0<20) {
- if(j0<0) { /* raise inexact if x != 0 */
- if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */
- if(i0>=0) {i0=i1=0;}
- else if(((i0&0x7fffffff)|i1)!=0)
- { i0=0xbff00000;i1=0;}
- }
- } else {
- i = (0x000fffff)>>j0;
- if(((i0&i)|i1)==0) return x; /* x is integral */
- if(huge+x>0.0) { /* raise inexact flag */
- if(i0<0) i0 += (0x00100000)>>j0;
- i0 &= (~i); i1=0;
- }
- }
- } else if (j0>51) {
- if(j0==0x400) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- } else {
- i = ((uint32_t)(0xffffffff))>>(j0-20);
- if((i1&i)==0) return x; /* x is integral */
- if(huge+x>0.0) { /* raise inexact flag */
- if(i0<0) {
- if(j0==20) i0+=1;
- else {
- j = i1+(1<<(52-j0));
- if(j<i1) i0 +=1 ; /* got a carry */
- i1=j;
- }
- }
- i1 &= (~i);
- }
- }
- INSERT_WORDS(x,i0,i1);
- return x;
-}
+++ /dev/null
-/* s_floorf.c -- float version of s_floor.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * floorf(x)
- * Return x rounded toward -inf to integral value
- * Method:
- * Bit twiddling.
- * Exception:
- * Inexact flag raised if x not equal to floorf(x).
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float huge = 1.0e30;
-
-float
-floorf(float x)
-{
- int32_t i0,j0;
- uint32_t i;
- GET_FLOAT_WORD(i0,x);
- j0 = ((i0>>23)&0xff)-0x7f;
- if(j0<23) {
- if(j0<0) { /* raise inexact if x != 0 */
- if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */
- if(i0>=0) {i0=0;}
- else if((i0&0x7fffffff)!=0)
- { i0=0xbf800000;}
- }
- } else {
- i = (0x007fffff)>>j0;
- if((i0&i)==0) return x; /* x is integral */
- if(huge+x>(float)0.0) { /* raise inexact flag */
- if(i0<0) i0 += (0x00800000)>>j0;
- i0 &= (~i);
- }
- }
- } else {
- if(j0==0x80) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- }
- SET_FLOAT_WORD(x,i0);
- return x;
-}
+++ /dev/null
-/* @(#)s_ilogb.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* ilogb(double x)
- * return the binary exponent of non-zero x
- * ilogb(0) = FP_ILOGB0
- * ilogb(NaN) = FP_ILOGBNAN (no signal is raised)
- * ilogb(inf) = INT_MAX (no signal is raised)
- */
-
-#include <limits.h>
-
-#include <math.h>
-#include "math_private.h"
-
-int ilogb(double x)
-{
- int32_t hx,lx,ix;
-
- EXTRACT_WORDS(hx,lx,x);
- hx &= 0x7fffffff;
- if(hx<0x00100000) {
- if((hx|lx)==0)
- return FP_ILOGB0;
- else /* subnormal x */
- if(hx==0) {
- for (ix = -1043; lx>0; lx<<=1) ix -=1;
- } else {
- for (ix = -1022,hx<<=11; hx>0; hx<<=1) ix -=1;
- }
- return ix;
- }
- else if (hx<0x7ff00000) return (hx>>20)-1023;
- else if (hx>0x7ff00000 || lx!=0) return FP_ILOGBNAN;
- else return INT_MAX;
-}
+++ /dev/null
-/* s_ilogbf.c -- float version of s_ilogb.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <limits.h>
-
-#include <math.h>
-#include "math_private.h"
-
-int ilogbf(float x)
-{
- int32_t hx,ix;
-
- GET_FLOAT_WORD(hx,x);
- hx &= 0x7fffffff;
- if(hx<0x00800000) {
- if(hx==0)
- return FP_ILOGB0;
- else /* subnormal x */
- for (ix = -126,hx<<=8; hx>0; hx<<=1) ix -=1;
- return ix;
- }
- else if (hx<0x7f800000) return (hx>>23)-127;
- else if (hx>0x7f800000) return FP_ILOGBNAN;
- else return INT_MAX;
-}
+++ /dev/null
-#include <math.h>
-
-double ldexp(double x, int n)
-{
- return scalbn(x, n);
-}
+++ /dev/null
-#include <math.h>
-
-float ldexpf(float x, int n)
-{
- return scalbnf(x, n);
-}
+++ /dev/null
-#include <math.h>
-
-// FIXME: incorrect exception behavior
-
-long long llrint(double x)
-{
- return rint(x);
-}
+++ /dev/null
-/* @(#)s_log1p.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* double log1p(double x)
- *
- * Method :
- * 1. Argument Reduction: find k and f such that
- * 1+x = 2^k * (1+f),
- * where sqrt(2)/2 < 1+f < sqrt(2) .
- *
- * Note. If k=0, then f=x is exact. However, if k!=0, then f
- * may not be representable exactly. In that case, a correction
- * term is need. Let u=1+x rounded. Let c = (1+x)-u, then
- * log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u),
- * and add back the correction term c/u.
- * (Note: when x > 2**53, one can simply return log(x))
- *
- * 2. Approximation of log1p(f).
- * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
- * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
- * = 2s + s*R
- * We use a special Reme algorithm on [0,0.1716] to generate
- * a polynomial of degree 14 to approximate R The maximum error
- * of this polynomial approximation is bounded by 2**-58.45. In
- * other words,
- * 2 4 6 8 10 12 14
- * R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s
- * (the values of Lp1 to Lp7 are listed in the program)
- * and
- * | 2 14 | -58.45
- * | Lp1*s +...+Lp7*s - R(z) | <= 2
- * | |
- * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
- * In order to guarantee error in log below 1ulp, we compute log
- * by
- * log1p(f) = f - (hfsq - s*(hfsq+R)).
- *
- * 3. Finally, log1p(x) = k*ln2 + log1p(f).
- * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
- * Here ln2 is split into two floating point number:
- * ln2_hi + ln2_lo,
- * where n*ln2_hi is always exact for |n| < 2000.
- *
- * Special cases:
- * log1p(x) is NaN with signal if x < -1 (including -INF) ;
- * log1p(+INF) is +INF; log1p(-1) is -INF with signal;
- * log1p(NaN) is that NaN with no signal.
- *
- * Accuracy:
- * according to an error analysis, the error is always less than
- * 1 ulp (unit in the last place).
- *
- * Constants:
- * The hexadecimal values are the intended ones for the following
- * constants. The decimal values may be used, provided that the
- * compiler will convert from decimal to binary accurately enough
- * to produce the hexadecimal values shown.
- *
- * Note: Assuming log() return accurate answer, the following
- * algorithm can be used to compute log1p(x) to within a few ULP:
- *
- * u = 1+x;
- * if(u==1.0) return x ; else
- * return log(u)*(x/(u-1.0));
- *
- * See HP-15C Advanced Functions Handbook, p.193.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
-ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
-two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
-Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
-Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
-Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
-Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
-Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
-Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
-Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
-
-static const double zero = 0.0;
-
-double
-log1p(double x)
-{
- double hfsq,f=0,c=0,s,z,R,u;
- int32_t k,hx,hu=0,ax;
-
- GET_HIGH_WORD(hx,x);
- ax = hx&0x7fffffff;
-
- k = 1;
- if (hx < 0x3FDA827A) { /* x < 0.41422 */
- if(ax>=0x3ff00000) { /* x <= -1.0 */
- if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */
- else return (x-x)/(x-x); /* log1p(x<-1)=NaN */
- }
- if(ax<0x3e200000) { /* |x| < 2**-29 */
- if(two54+x>zero /* raise inexact */
- &&ax<0x3c900000) /* |x| < 2**-54 */
- return x;
- else
- return x - x*x*0.5;
- }
- if(hx>0||hx<=((int32_t)0xbfd2bec3)) {
- k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */
- }
- if (hx >= 0x7ff00000) return x+x;
- if(k!=0) {
- if(hx<0x43400000) {
- u = 1.0+x;
- GET_HIGH_WORD(hu,u);
- k = (hu>>20)-1023;
- c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */
- c /= u;
- } else {
- u = x;
- GET_HIGH_WORD(hu,u);
- k = (hu>>20)-1023;
- c = 0;
- }
- hu &= 0x000fffff;
- if(hu<0x6a09e) {
- SET_HIGH_WORD(u,hu|0x3ff00000); /* normalize u */
- } else {
- k += 1;
- SET_HIGH_WORD(u,hu|0x3fe00000); /* normalize u/2 */
- hu = (0x00100000-hu)>>2;
- }
- f = u-1.0;
- }
- hfsq=0.5*f*f;
- if(hu==0) { /* |f| < 2**-20 */
- if(f==zero) { if(k==0) return zero;
- else {c += k*ln2_lo; return k*ln2_hi+c;} }
- R = hfsq*(1.0-0.66666666666666666*f);
- if(k==0) return f-R; else
- return k*ln2_hi-((R-(k*ln2_lo+c))-f);
- }
- s = f/(2.0+f);
- z = s*s;
- R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7))))));
- if(k==0) return f-(hfsq-s*(hfsq+R)); else
- return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f);
-}
+++ /dev/null
-/* s_log1pf.c -- float version of s_log1p.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-ln2_hi = 6.9313812256e-01, /* 0x3f317180 */
-ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */
-two25 = 3.355443200e+07, /* 0x4c000000 */
-Lp1 = 6.6666668653e-01, /* 3F2AAAAB */
-Lp2 = 4.0000000596e-01, /* 3ECCCCCD */
-Lp3 = 2.8571429849e-01, /* 3E924925 */
-Lp4 = 2.2222198546e-01, /* 3E638E29 */
-Lp5 = 1.8183572590e-01, /* 3E3A3325 */
-Lp6 = 1.5313838422e-01, /* 3E1CD04F */
-Lp7 = 1.4798198640e-01; /* 3E178897 */
-
-static const float zero = 0.0;
-
-float
-log1pf(float x)
-{
- float hfsq,f=0,c=0,s,z,R,u;
- int32_t k,hx,hu=0,ax;
-
- GET_FLOAT_WORD(hx,x);
- ax = hx&0x7fffffff;
-
- k = 1;
- if (hx < 0x3ed413d7) { /* x < 0.41422 */
- if(ax>=0x3f800000) { /* x <= -1.0 */
- if(x==(float)-1.0) return -two25/zero; /* log1p(-1)=+inf */
- else return (x-x)/(x-x); /* log1p(x<-1)=NaN */
- }
- if(ax<0x31000000) { /* |x| < 2**-29 */
- if(two25+x>zero /* raise inexact */
- &&ax<0x24800000) /* |x| < 2**-54 */
- return x;
- else
- return x - x*x*(float)0.5;
- }
- if(hx>0||hx<=((int32_t)0xbe95f61f)) {
- k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */
- }
- if (hx >= 0x7f800000) return x+x;
- if(k!=0) {
- if(hx<0x5a000000) {
- u = (float)1.0+x;
- GET_FLOAT_WORD(hu,u);
- k = (hu>>23)-127;
- /* correction term */
- c = (k>0)? (float)1.0-(u-x):x-(u-(float)1.0);
- c /= u;
- } else {
- u = x;
- GET_FLOAT_WORD(hu,u);
- k = (hu>>23)-127;
- c = 0;
- }
- hu &= 0x007fffff;
- if(hu<0x3504f7) {
- SET_FLOAT_WORD(u,hu|0x3f800000);/* normalize u */
- } else {
- k += 1;
- SET_FLOAT_WORD(u,hu|0x3f000000); /* normalize u/2 */
- hu = (0x00800000-hu)>>2;
- }
- f = u-(float)1.0;
- }
- hfsq=(float)0.5*f*f;
- if(hu==0) { /* |f| < 2**-20 */
- if(f==zero) { if(k==0) return zero;
- else {c += k*ln2_lo; return k*ln2_hi+c;} }
- R = hfsq*((float)1.0-(float)0.66666666666666666*f);
- if(k==0) return f-R; else
- return k*ln2_hi-((R-(k*ln2_lo+c))-f);
- }
- s = f/((float)2.0+f);
- z = s*s;
- R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7))))));
- if(k==0) return f-(hfsq-s*(hfsq+R)); else
- return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f);
-}
+++ /dev/null
-/* @(#)s_logb.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * double logb(x)
- * IEEE 754 logb. Included to pass IEEE test suite. Not recommend.
- * Use ilogb instead.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-logb(double x)
-{
- int32_t lx,ix;
- EXTRACT_WORDS(ix,lx,x);
- ix &= 0x7fffffff; /* high |x| */
- if((ix|lx)==0) return -1.0/fabs(x);
- if(ix>=0x7ff00000) return x*x;
- if((ix>>=20)==0) /* IEEE 754 logb */
- return -1022.0;
- else
- return (double) (ix-1023);
-}
+++ /dev/null
-/* s_logbf.c -- float version of s_logb.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-logbf(float x)
-{
- int32_t ix;
- GET_FLOAT_WORD(ix,x);
- ix &= 0x7fffffff; /* high |x| */
- if(ix==0) return (float)-1.0/fabsf(x);
- if(ix>=0x7f800000) return x*x;
- if((ix>>=23)==0) /* IEEE 754 logb */
- return -126.0;
- else
- return (float) (ix-127);
-}
+++ /dev/null
-#include <math.h>
-
-// FIXME: incorrect exception behavior
-
-long lrint(double x)
-{
- return rint(x);
-}
+++ /dev/null
-#include <math.h>
-
-// FIXME: incorrect exception behavior
-
-long lrintf(float x)
-{
- return rintf(x);
-}
+++ /dev/null
-/* @(#)s_modf.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * modf(double x, double *iptr)
- * return fraction part of x, and return x's integral part in *iptr.
- * Method:
- * Bit twiddling.
- *
- * Exception:
- * No exception.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one = 1.0;
-
-double
-modf(double x, double *iptr)
-{
- int32_t i0,i1,j0;
- uint32_t i;
- EXTRACT_WORDS(i0,i1,x);
- j0 = ((i0>>20)&0x7ff)-0x3ff; /* exponent of x */
- if(j0<20) { /* integer part in high x */
- if(j0<0) { /* |x|<1 */
- INSERT_WORDS(*iptr,i0&0x80000000,0); /* *iptr = +-0 */
- return x;
- } else {
- i = (0x000fffff)>>j0;
- if(((i0&i)|i1)==0) { /* x is integral */
- uint32_t high;
- *iptr = x;
- GET_HIGH_WORD(high,x);
- INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */
- return x;
- } else {
- INSERT_WORDS(*iptr,i0&(~i),0);
- return x - *iptr;
- }
- }
- } else if (j0>51) { /* no fraction part */
- uint32_t high;
- *iptr = x*one;
- GET_HIGH_WORD(high,x);
- INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */
- return x;
- } else { /* fraction part in low x */
- i = ((uint32_t)(0xffffffff))>>(j0-20);
- if((i1&i)==0) { /* x is integral */
- uint32_t high;
- *iptr = x;
- GET_HIGH_WORD(high,x);
- INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */
- return x;
- } else {
- INSERT_WORDS(*iptr,i0,i1&(~i));
- return x - *iptr;
- }
- }
-}
+++ /dev/null
-/* s_modff.c -- float version of s_modf.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one = 1.0;
-
-float
-modff(float x, float *iptr)
-{
- int32_t i0,j0;
- uint32_t i;
- GET_FLOAT_WORD(i0,x);
- j0 = ((i0>>23)&0xff)-0x7f; /* exponent of x */
- if(j0<23) { /* integer part in x */
- if(j0<0) { /* |x|<1 */
- SET_FLOAT_WORD(*iptr,i0&0x80000000); /* *iptr = +-0 */
- return x;
- } else {
- i = (0x007fffff)>>j0;
- if((i0&i)==0) { /* x is integral */
- uint32_t ix;
- *iptr = x;
- GET_FLOAT_WORD(ix,x);
- SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */
- return x;
- } else {
- SET_FLOAT_WORD(*iptr,i0&(~i));
- return x - *iptr;
- }
- }
- } else { /* no fraction part */
- uint32_t ix;
- *iptr = x*one;
- GET_FLOAT_WORD(ix,x);
- SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */
- return x;
- }
-}
+++ /dev/null
-/* @(#)s_nextafter.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* IEEE functions
- * nextafter(x,y)
- * return the next machine floating-point number of x in the
- * direction toward y.
- * Special cases:
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-nextafter(double x, double y)
-{
- volatile double t;
- int32_t hx,hy,ix,iy;
- uint32_t lx,ly;
-
- EXTRACT_WORDS(hx,lx,x);
- EXTRACT_WORDS(hy,ly,y);
- ix = hx&0x7fffffff; /* |x| */
- iy = hy&0x7fffffff; /* |y| */
-
- if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */
- ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */
- return x+y;
- if(x==y) return y; /* x=y, return y */
- if((ix|lx)==0) { /* x == 0 */
- INSERT_WORDS(x,hy&0x80000000,1); /* return +-minsubnormal */
- t = x*x;
- if(t==x) return t; else return x; /* raise underflow flag */
- }
- if(hx>=0) { /* x > 0 */
- if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */
- if(lx==0) hx -= 1;
- lx -= 1;
- } else { /* x < y, x += ulp */
- lx += 1;
- if(lx==0) hx += 1;
- }
- } else { /* x < 0 */
- if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */
- if(lx==0) hx -= 1;
- lx -= 1;
- } else { /* x > y, x += ulp */
- lx += 1;
- if(lx==0) hx += 1;
- }
- }
- hy = hx&0x7ff00000;
- if(hy>=0x7ff00000) return x+x; /* overflow */
- if(hy<0x00100000) { /* underflow */
- t = x*x;
- if(t!=x) { /* raise underflow flag */
- INSERT_WORDS(y,hx,lx);
- return y;
- }
- }
- INSERT_WORDS(x,hx,lx);
- return x;
-}
+++ /dev/null
-/* s_nextafterf.c -- float version of s_nextafter.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-nextafterf(float x, float y)
-{
- volatile float t;
- int32_t hx,hy,ix,iy;
-
- GET_FLOAT_WORD(hx,x);
- GET_FLOAT_WORD(hy,y);
- ix = hx&0x7fffffff; /* |x| */
- iy = hy&0x7fffffff; /* |y| */
-
- if((ix>0x7f800000) || /* x is nan */
- (iy>0x7f800000)) /* y is nan */
- return x+y;
- if(x==y) return y; /* x=y, return y */
- if(ix==0) { /* x == 0 */
- SET_FLOAT_WORD(x,(hy&0x80000000)|1);/* return +-minsubnormal */
- t = x*x;
- if(t==x) return t; else return x; /* raise underflow flag */
- }
- if(hx>=0) { /* x > 0 */
- if(hx>hy) { /* x > y, x -= ulp */
- hx -= 1;
- } else { /* x < y, x += ulp */
- hx += 1;
- }
- } else { /* x < 0 */
- if(hy>=0||hx>hy){ /* x < y, x -= ulp */
- hx -= 1;
- } else { /* x > y, x += ulp */
- hx += 1;
- }
- }
- hy = hx&0x7f800000;
- if(hy>=0x7f800000) return x+x; /* overflow */
- if(hy<0x00800000) { /* underflow */
- t = x*x;
- if(t!=x) { /* raise underflow flag */
- SET_FLOAT_WORD(y,hx);
- return y;
- }
- }
- SET_FLOAT_WORD(x,hx);
- return x;
-}
+++ /dev/null
-/* @(#)e_fmod.c 1.3 95/01/18 */
-/*-
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double Zero[] = {0.0, -0.0,};
-
-/*
- * Return the IEEE remainder and set *quo to the last n bits of the
- * quotient, rounded to the nearest integer. We choose n=31 because
- * we wind up computing all the integer bits of the quotient anyway as
- * a side-effect of computing the remainder by the shift and subtract
- * method. In practice, this is far more bits than are needed to use
- * remquo in reduction algorithms.
- */
-double
-remquo(double x, double y, int *quo)
-{
- int32_t n,hx,hy,hz,ix,iy,sx,i;
- uint32_t lx,ly,lz,q,sxy;
-
- EXTRACT_WORDS(hx,lx,x);
- EXTRACT_WORDS(hy,ly,y);
- sxy = (hx ^ hy) & 0x80000000;
- sx = hx&0x80000000; /* sign of x */
- hx ^=sx; /* |x| */
- hy &= 0x7fffffff; /* |y| */
-
- /* purge off exception values */
- if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */
- ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */
- return (x*y)/(x*y);
- if(hx<=hy) {
- if((hx<hy)||(lx<ly)) {
- q = 0;
- goto fixup; /* |x|<|y| return x or x-y */
- }
- if(lx==ly) {
- *quo = 1;
- return Zero[(uint32_t)sx>>31]; /* |x|=|y| return x*0*/
- }
- }
-
- /* determine ix = ilogb(x) */
- if(hx<0x00100000) { /* subnormal x */
- if(hx==0) {
- for (ix = -1043, i=lx; i>0; i<<=1) ix -=1;
- } else {
- for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1;
- }
- } else ix = (hx>>20)-1023;
-
- /* determine iy = ilogb(y) */
- if(hy<0x00100000) { /* subnormal y */
- if(hy==0) {
- for (iy = -1043, i=ly; i>0; i<<=1) iy -=1;
- } else {
- for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1;
- }
- } else iy = (hy>>20)-1023;
-
- /* set up {hx,lx}, {hy,ly} and align y to x */
- if(ix >= -1022)
- hx = 0x00100000|(0x000fffff&hx);
- else { /* subnormal x, shift x to normal */
- n = -1022-ix;
- if(n<=31) {
- hx = (hx<<n)|(lx>>(32-n));
- lx <<= n;
- } else {
- hx = lx<<(n-32);
- lx = 0;
- }
- }
- if(iy >= -1022)
- hy = 0x00100000|(0x000fffff&hy);
- else { /* subnormal y, shift y to normal */
- n = -1022-iy;
- if(n<=31) {
- hy = (hy<<n)|(ly>>(32-n));
- ly <<= n;
- } else {
- hy = ly<<(n-32);
- ly = 0;
- }
- }
-
- /* fix point fmod */
- n = ix - iy;
- q = 0;
- while(n--) {
- hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1;
- if(hz<0){hx = hx+hx+(lx>>31); lx = lx+lx;}
- else {hx = hz+hz+(lz>>31); lx = lz+lz; q++;}
- q <<= 1;
- }
- hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1;
- if(hz>=0) {hx=hz;lx=lz;q++;}
-
- /* convert back to floating value and restore the sign */
- if((hx|lx)==0) { /* return sign(x)*0 */
- *quo = (sxy ? -q : q);
- return Zero[(uint32_t)sx>>31];
- }
- while(hx<0x00100000) { /* normalize x */
- hx = hx+hx+(lx>>31); lx = lx+lx;
- iy -= 1;
- }
- if(iy>= -1022) { /* normalize output */
- hx = ((hx-0x00100000)|((iy+1023)<<20));
- } else { /* subnormal output */
- n = -1022 - iy;
- if(n<=20) {
- lx = (lx>>n)|((uint32_t)hx<<(32-n));
- hx >>= n;
- } else if (n<=31) {
- lx = (hx<<(32-n))|(lx>>n); hx = sx;
- } else {
- lx = hx>>(n-32); hx = sx;
- }
- }
-fixup:
- INSERT_WORDS(x,hx,lx);
- y = fabs(y);
- if (y < 0x1p-1021) {
- if (x+x>y || (x+x==y && (q & 1))) {
- q++;
- x-=y;
- }
- } else if (x>0.5*y || (x==0.5*y && (q & 1))) {
- q++;
- x-=y;
- }
- GET_HIGH_WORD(hx,x);
- SET_HIGH_WORD(x,hx^sx);
- q &= 0x7fffffff;
- *quo = (sxy ? -q : q);
- return x;
-}
+++ /dev/null
-/* @(#)e_fmod.c 1.3 95/01/18 */
-/*-
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunSoft, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float Zero[] = {0.0, -0.0,};
-
-/*
- * Return the IEEE remainder and set *quo to the last n bits of the
- * quotient, rounded to the nearest integer. We choose n=31 because
- * we wind up computing all the integer bits of the quotient anyway as
- * a side-effect of computing the remainder by the shift and subtract
- * method. In practice, this is far more bits than are needed to use
- * remquo in reduction algorithms.
- */
-float
-remquof(float x, float y, int *quo)
-{
- int32_t n,hx,hy,hz,ix,iy,sx,i;
- uint32_t q,sxy;
-
- GET_FLOAT_WORD(hx,x);
- GET_FLOAT_WORD(hy,y);
- sxy = (hx ^ hy) & 0x80000000;
- sx = hx&0x80000000; /* sign of x */
- hx ^=sx; /* |x| */
- hy &= 0x7fffffff; /* |y| */
-
- /* purge off exception values */
- if(hy==0||hx>=0x7f800000||hy>0x7f800000) /* y=0,NaN;or x not finite */
- return (x*y)/(x*y);
- if(hx<hy) {
- q = 0;
- goto fixup; /* |x|<|y| return x or x-y */
- } else if(hx==hy) {
- *quo = 1;
- return Zero[(uint32_t)sx>>31]; /* |x|=|y| return x*0*/
- }
-
- /* determine ix = ilogb(x) */
- if(hx<0x00800000) { /* subnormal x */
- for (ix = -126,i=(hx<<8); i>0; i<<=1) ix -=1;
- } else ix = (hx>>23)-127;
-
- /* determine iy = ilogb(y) */
- if(hy<0x00800000) { /* subnormal y */
- for (iy = -126,i=(hy<<8); i>0; i<<=1) iy -=1;
- } else iy = (hy>>23)-127;
-
- /* set up {hx,lx}, {hy,ly} and align y to x */
- if(ix >= -126)
- hx = 0x00800000|(0x007fffff&hx);
- else { /* subnormal x, shift x to normal */
- n = -126-ix;
- hx <<= n;
- }
- if(iy >= -126)
- hy = 0x00800000|(0x007fffff&hy);
- else { /* subnormal y, shift y to normal */
- n = -126-iy;
- hy <<= n;
- }
-
- /* fix point fmod */
- n = ix - iy;
- q = 0;
- while(n--) {
- hz=hx-hy;
- if(hz<0) hx = hx << 1;
- else {hx = hz << 1; q++;}
- q <<= 1;
- }
- hz=hx-hy;
- if(hz>=0) {hx=hz;q++;}
-
- /* convert back to floating value and restore the sign */
- if(hx==0) { /* return sign(x)*0 */
- *quo = (sxy ? -q : q);
- return Zero[(uint32_t)sx>>31];
- }
- while(hx<0x00800000) { /* normalize x */
- hx <<= 1;
- iy -= 1;
- }
- if(iy>= -126) { /* normalize output */
- hx = ((hx-0x00800000)|((iy+127)<<23));
- } else { /* subnormal output */
- n = -126 - iy;
- hx >>= n;
- }
-fixup:
- SET_FLOAT_WORD(x,hx);
- y = fabsf(y);
- if (y < 0x1p-125f) {
- if (x+x>y || (x+x==y && (q & 1))) {
- q++;
- x-=y;
- }
- } else if (x>0.5f*y || (x==0.5f*y && (q & 1))) {
- q++;
- x-=y;
- }
- GET_FLOAT_WORD(hx,x);
- SET_FLOAT_WORD(x,hx^sx);
- q &= 0x7fffffff;
- *quo = (sxy ? -q : q);
- return x;
-}
+++ /dev/null
-/* @(#)s_rint.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * rint(x)
- * Return x rounded to integral value according to the prevailing
- * rounding mode.
- * Method:
- * Using floating addition.
- * Exception:
- * Inexact flag raised if x not equal to rint(x).
- */
-
-#include <math.h>
-#include "math_private.h"
-
-/*
- * TWO23 is long double instead of double to avoid a bug in gcc. Without
- * this, gcc thinks that TWO23[sx]+x and w-TWO23[sx] already have double
- * precision and doesn't clip them to double precision when they are
- * assigned and returned.
- */
-static const long double
-TWO52[2]={
- 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
- -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */
-};
-
-double
-rint(double x)
-{
- int32_t i0,j0,sx;
- uint32_t i,i1;
- double w,t;
- EXTRACT_WORDS(i0,i1,x);
- sx = (i0>>31)&1;
- j0 = ((i0>>20)&0x7ff)-0x3ff;
- if(j0<20) {
- if(j0<0) {
- if(((i0&0x7fffffff)|i1)==0) return x;
- i1 |= (i0&0x0fffff);
- i0 &= 0xfffe0000;
- i0 |= ((i1|-i1)>>12)&0x80000;
- SET_HIGH_WORD(x,i0);
- w = TWO52[sx]+x;
- t = w-TWO52[sx];
- GET_HIGH_WORD(i0,t);
- SET_HIGH_WORD(t,(i0&0x7fffffff)|(sx<<31));
- return t;
- } else {
- i = (0x000fffff)>>j0;
- if(((i0&i)|i1)==0) return x; /* x is integral */
- i>>=1;
- if(((i0&i)|i1)!=0) {
- if(j0==19) i1 = 0x40000000; else
- i0 = (i0&(~i))|((0x20000)>>j0);
- }
- }
- } else if (j0>51) {
- if(j0==0x400) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- } else {
- i = ((uint32_t)(0xffffffff))>>(j0-20);
- if((i1&i)==0) return x; /* x is integral */
- i>>=1;
- if((i1&i)!=0) i1 = (i1&(~i))|((0x40000000)>>(j0-20));
- }
- INSERT_WORDS(x,i0,i1);
- w = TWO52[sx]+x;
- return w-TWO52[sx];
-}
+++ /dev/null
-/* s_rintf.c -- float version of s_rint.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-TWO23[2]={
- 8.3886080000e+06, /* 0x4b000000 */
- -8.3886080000e+06, /* 0xcb000000 */
-};
-
-float
-rintf(float x)
-{
- int32_t i0,j0,sx;
- volatile float w,t; /* volatile works around gcc bug */
- GET_FLOAT_WORD(i0,x);
- sx = (i0>>31)&1;
- j0 = ((i0>>23)&0xff)-0x7f;
- if(j0<23) {
- if(j0<0) {
- if((i0&0x7fffffff)==0) return x;
- w = TWO23[sx]+x;
- t = w-TWO23[sx];
- return t;
- }
- w = TWO23[sx]+x;
- return w-TWO23[sx];
- }
- if(j0==0x80) return x+x; /* inf or NaN */
- else return x; /* x is integral */
-}
+++ /dev/null
-/*-
- * Copyright (c) 2003, Steven G. Kargl
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- * 1. Redistributions of source code must retain the above copyright
- * notice unmodified, this list of conditions, and the following
- * disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
- * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
- * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
- * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-#include <math.h>
-
-double
-round(double x)
-{
- double t;
-
- if (!isfinite(x))
- return (x);
-
- if (x >= 0.0) {
- t = ceil(x);
- if (t - x > 0.5)
- t -= 1.0;
- return (t);
- } else {
- t = ceil(-x);
- if (t + x > 0.5)
- t -= 1.0;
- return (-t);
- }
-}
+++ /dev/null
-/*-
- * Copyright (c) 2003, Steven G. Kargl
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- * 1. Redistributions of source code must retain the above copyright
- * notice unmodified, this list of conditions, and the following
- * disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
- * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
- * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
- * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
- * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-#include <math.h>
-
-float
-roundf(float x)
-{
- float t;
-
- if (!isfinite(x))
- return (x);
-
- if (x >= 0.0) {
- t = ceilf(x);
- if (t - x > 0.5)
- t -= 1.0;
- return (t);
- } else {
- t = ceilf(-x);
- if (t + x > 0.5)
- t -= 1.0;
- return (-t);
- }
-}
+++ /dev/null
-/* @(#)s_scalbn.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * scalbn (double x, int n)
- * scalbn(x,n) returns x* 2**n computed by exponent
- * manipulation rather than by actually performing an
- * exponentiation or a multiplication.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double
-two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
-twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */
-huge = 1.0e+300,
-tiny = 1.0e-300;
-
-double
-scalbln (double x, long n)
-{
- int32_t k,hx,lx;
- EXTRACT_WORDS(hx,lx,x);
- k = (hx&0x7ff00000)>>20; /* extract exponent */
- if (k==0) { /* 0 or subnormal x */
- if ((lx|(hx&0x7fffffff))==0) return x; /* +-0 */
- x *= two54;
- GET_HIGH_WORD(hx,x);
- k = ((hx&0x7ff00000)>>20) - 54;
- if (n< -50000) return tiny*x; /*underflow*/
- }
- if (k==0x7ff) return x+x; /* NaN or Inf */
- k = k+n;
- if (k > 0x7fe) return huge*copysign(huge,x); /* overflow */
- if (k > 0) /* normal result */
- {SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); return x;}
- if (k <= -54) {
- if (n > 50000) /* in case integer overflow in n+k */
- return huge*copysign(huge,x); /*overflow*/
- else return tiny*copysign(tiny,x); /*underflow*/
- }
- k += 54; /* subnormal result */
- SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20));
- return x*twom54;
-}
-
-double
-scalbn (double x, int n)
-{
- return scalbln(x, n);
-}
+++ /dev/null
-/* s_scalbnf.c -- float version of s_scalbn.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float
-two25 = 3.355443200e+07, /* 0x4c000000 */
-twom25 = 2.9802322388e-08, /* 0x33000000 */
-huge = 1.0e+30,
-tiny = 1.0e-30;
-
-float
-scalblnf (float x, long n)
-{
- int32_t k,ix;
- GET_FLOAT_WORD(ix,x);
- k = (ix&0x7f800000)>>23; /* extract exponent */
- if (k==0) { /* 0 or subnormal x */
- if ((ix&0x7fffffff)==0) return x; /* +-0 */
- x *= two25;
- GET_FLOAT_WORD(ix,x);
- k = ((ix&0x7f800000)>>23) - 25;
- if (n< -50000) return tiny*x; /*underflow*/
- }
- if (k==0xff) return x+x; /* NaN or Inf */
- k = k+n;
- if (k > 0xfe) return huge*copysignf(huge,x); /* overflow */
- if (k > 0) /* normal result */
- {SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); return x;}
- if (k <= -25) {
- if (n > 50000) /* in case integer overflow in n+k */
- return huge*copysignf(huge,x); /*overflow*/
- else return tiny*copysignf(tiny,x); /*underflow*/
- }
- k += 25; /* subnormal result */
- SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23));
- return x*twom25;
-}
-
-float
-scalbnf (float x, int n)
-{
- return scalblnf(x, n);
-}
+++ /dev/null
-/* @(#)s_sin.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* sin(x)
- * Return sine function of x.
- *
- * kernel function:
- * __kernel_sin ... sine function on [-pi/4,pi/4]
- * __kernel_cos ... cose function on [-pi/4,pi/4]
- * __ieee754_rem_pio2 ... argument reduction routine
- *
- * Method.
- * Let S,C and T denote the sin, cos and tan respectively on
- * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
- * in [-pi/4 , +pi/4], and let n = k mod 4.
- * We have
- *
- * n sin(x) cos(x) tan(x)
- * ----------------------------------------------------------
- * 0 S C T
- * 1 C -S -1/T
- * 2 -S -C T
- * 3 -C S -1/T
- * ----------------------------------------------------------
- *
- * Special cases:
- * Let trig be any of sin, cos, or tan.
- * trig(+-INF) is NaN, with signals;
- * trig(NaN) is that NaN;
- *
- * Accuracy:
- * TRIG(x) returns trig(x) nearly rounded
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-sin(double x)
-{
- double y[2],z=0.0;
- int32_t n, ix;
-
- /* High word of x. */
- GET_HIGH_WORD(ix,x);
-
- /* |x| ~< pi/4 */
- ix &= 0x7fffffff;
- if(ix <= 0x3fe921fb) return __kernel_sin(x,z,0);
-
- /* sin(Inf or NaN) is NaN */
- else if (ix>=0x7ff00000) return x-x;
-
- /* argument reduction needed */
- else {
- n = __ieee754_rem_pio2(x,y);
- switch(n&3) {
- case 0: return __kernel_sin(y[0],y[1],1);
- case 1: return __kernel_cos(y[0],y[1]);
- case 2: return -__kernel_sin(y[0],y[1],1);
- default:
- return -__kernel_cos(y[0],y[1]);
- }
- }
-}
+++ /dev/null
-/* s_sinf.c -- float version of s_sin.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-sinf(float x)
-{
- float y[2],z=0.0;
- int32_t n, ix;
-
- GET_FLOAT_WORD(ix,x);
-
- /* |x| ~< pi/4 */
- ix &= 0x7fffffff;
- if(ix <= 0x3f490fd8) return __kernel_sinf(x,z,0);
-
- /* sin(Inf or NaN) is NaN */
- else if (ix>=0x7f800000) return x-x;
-
- /* argument reduction needed */
- else {
- n = __ieee754_rem_pio2f(x,y);
- switch(n&3) {
- case 0: return __kernel_sinf(y[0],y[1],1);
- case 1: return __kernel_cosf(y[0],y[1]);
- case 2: return -__kernel_sinf(y[0],y[1],1);
- default:
- return -__kernel_cosf(y[0],y[1]);
- }
- }
-}
+++ /dev/null
-/* @(#)s_tan.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* tan(x)
- * Return tangent function of x.
- *
- * kernel function:
- * __kernel_tan ... tangent function on [-pi/4,pi/4]
- * __ieee754_rem_pio2 ... argument reduction routine
- *
- * Method.
- * Let S,C and T denote the sin, cos and tan respectively on
- * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
- * in [-pi/4 , +pi/4], and let n = k mod 4.
- * We have
- *
- * n sin(x) cos(x) tan(x)
- * ----------------------------------------------------------
- * 0 S C T
- * 1 C -S -1/T
- * 2 -S -C T
- * 3 -C S -1/T
- * ----------------------------------------------------------
- *
- * Special cases:
- * Let trig be any of sin, cos, or tan.
- * trig(+-INF) is NaN, with signals;
- * trig(NaN) is that NaN;
- *
- * Accuracy:
- * TRIG(x) returns trig(x) nearly rounded
- */
-
-#include <math.h>
-#include "math_private.h"
-
-double
-tan(double x)
-{
- double y[2],z=0.0;
- int32_t n, ix;
-
- /* High word of x. */
- GET_HIGH_WORD(ix,x);
-
- /* |x| ~< pi/4 */
- ix &= 0x7fffffff;
- if(ix <= 0x3fe921fb) return __kernel_tan(x,z,1);
-
- /* tan(Inf or NaN) is NaN */
- else if (ix>=0x7ff00000) return x-x; /* NaN */
-
- /* argument reduction needed */
- else {
- n = __ieee754_rem_pio2(x,y);
- return __kernel_tan(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even
- -1 -- n odd */
- }
-}
+++ /dev/null
-/* s_tanf.c -- float version of s_tan.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-float
-tanf(float x)
-{
- float y[2],z=0.0;
- int32_t n, ix;
-
- GET_FLOAT_WORD(ix,x);
-
- /* |x| ~< pi/4 */
- ix &= 0x7fffffff;
- if(ix <= 0x3f490fda) return __kernel_tanf(x,z,1);
-
- /* tan(Inf or NaN) is NaN */
- else if (ix>=0x7f800000) return x-x; /* NaN */
-
- /* argument reduction needed */
- else {
- n = __ieee754_rem_pio2f(x,y);
- return __kernel_tanf(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even
- -1 -- n odd */
- }
-}
+++ /dev/null
-/* @(#)s_tanh.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/* Tanh(x)
- * Return the Hyperbolic Tangent of x
- *
- * Method :
- * x -x
- * e - e
- * 0. tanh(x) is defined to be -----------
- * x -x
- * e + e
- * 1. reduce x to non-negative by tanh(-x) = -tanh(x).
- * 2. 0 <= x <= 2**-55 : tanh(x) := x*(one+x)
- * -t
- * 2**-55 < x <= 1 : tanh(x) := -----; t = expm1(-2x)
- * t + 2
- * 2
- * 1 <= x <= 22.0 : tanh(x) := 1- ----- ; t=expm1(2x)
- * t + 2
- * 22.0 < x <= INF : tanh(x) := 1.
- *
- * Special cases:
- * tanh(NaN) is NaN;
- * only tanh(0)=0 is exact for finite argument.
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double one=1.0, two=2.0, tiny = 1.0e-300;
-
-double
-tanh(double x)
-{
- double t,z;
- int32_t jx,ix;
-
- /* High word of |x|. */
- GET_HIGH_WORD(jx,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<0x3c800000) /* |x|<2**-55 */
- 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;
-}
+++ /dev/null
-/* s_tanhf.c -- float version of s_tanh.c.
- * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
- */
-
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float one=1.0, two=2.0, tiny = 1.0e-30;
-
-float
-tanhf(float x)
-{
- float t,z;
- int32_t jx,ix;
-
- GET_FLOAT_WORD(jx,x);
- ix = jx&0x7fffffff;
-
- /* x is INF or NaN */
- if(ix>=0x7f800000) {
- if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */
- else return one/x-one; /* tanh(NaN) = NaN */
- }
-
- /* |x| < 22 */
- if (ix < 0x41b00000) { /* |x|<22 */
- if (ix<0x24000000) /* |x|<2**-55 */
- return x*(one+x); /* tanh(small) = small */
- if (ix>=0x3f800000) { /* |x|>=1 */
- t = expm1f(two*fabsf(x));
- z = one - two/(t+two);
- } else {
- t = expm1f(-two*fabsf(x));
- z= -t/(t+two);
- }
- /* |x| > 22, return +-1 */
- } else {
- z = one - tiny; /* raised inexact flag */
- }
- return (jx>=0)? z: -z;
-}
+++ /dev/null
-/* @(#)s_floor.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * trunc(x)
- * Return x rounded toward 0 to integral value
- * Method:
- * Bit twiddling.
- * Exception:
- * Inexact flag raised if x not equal to trunc(x).
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const double huge = 1.0e300;
-
-double
-trunc(double x)
-{
- int32_t i0,i1,j0;
- uint32_t i,j;
- EXTRACT_WORDS(i0,i1,x);
- j0 = ((i0>>20)&0x7ff)-0x3ff;
- if(j0<20) {
- if(j0<0) { /* raise inexact if x != 0 */
- if(huge+x>0.0) {/* |x|<1, so return 0*sign(x) */
- i0 &= 0x80000000U;
- i1 = 0;
- }
- } else {
- i = (0x000fffff)>>j0;
- if(((i0&i)|i1)==0) return x; /* x is integral */
- if(huge+x>0.0) { /* raise inexact flag */
- i0 &= (~i); i1=0;
- }
- }
- } else if (j0>51) {
- if(j0==0x400) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- } else {
- i = ((uint32_t)(0xffffffff))>>(j0-20);
- if((i1&i)==0) return x; /* x is integral */
- if(huge+x>0.0) /* raise inexact flag */
- i1 &= (~i);
- }
- INSERT_WORDS(x,i0,i1);
- return x;
-}
+++ /dev/null
-/* @(#)s_floor.c 5.1 93/09/24 */
-/*
- * ====================================================
- * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
- *
- * Developed at SunPro, a Sun Microsystems, Inc. business.
- * Permission to use, copy, modify, and distribute this
- * software is freely granted, provided that this notice
- * is preserved.
- * ====================================================
- */
-
-/*
- * truncf(x)
- * Return x rounded toward 0 to integral value
- * Method:
- * Bit twiddling.
- * Exception:
- * Inexact flag raised if x not equal to truncf(x).
- */
-
-#include <math.h>
-#include "math_private.h"
-
-static const float huge = 1.0e30F;
-
-float
-truncf(float x)
-{
- int32_t i0,j0;
- uint32_t i;
- GET_FLOAT_WORD(i0,x);
- j0 = ((i0>>23)&0xff)-0x7f;
- if(j0<23) {
- if(j0<0) { /* raise inexact if x != 0 */
- if(huge+x>0.0F) /* |x|<1, so return 0*sign(x) */
- i0 &= 0x80000000;
- } else {
- i = (0x007fffff)>>j0;
- if((i0&i)==0) return x; /* x is integral */
- if(huge+x>0.0F) /* raise inexact flag */
- i0 &= (~i);
- }
- } else {
- if(j0==0x80) return x+x; /* inf or NaN */
- else return x; /* x is integral */
- }
- SET_FLOAT_WORD(x,i0);
- return x;
-}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_scalb.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * scalb(x, fn) is provide for
+ * passing various standard test suite. One
+ * should use scalbn() instead.
+ */
+
+#include "libm.h"
+
+double scalb(double x, double fn)
+{
+ if (isnan(x) || isnan(fn))
+ return x*fn;
+ if (!isfinite(fn)) {
+ if (fn > 0.0)
+ return x*fn;
+ else
+ return x/(-fn);
+ }
+ if (rint(fn) != fn) return (fn-fn)/(fn-fn);
+ if ( fn > 65000.0) return scalbn(x, 65000);
+ if (-fn > 65000.0) return scalbn(x,-65000);
+ return scalbn(x,(int)fn);
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_scalbf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+float scalbf(float x, float fn)
+{
+ if (isnan(x) || isnan(fn)) return x*fn;
+ if (!isfinite(fn)) {
+ if (fn > (float)0.0)
+ return x*fn;
+ else
+ return x/(-fn);
+ }
+ if (rintf(fn) != fn) return (fn-fn)/(fn-fn);
+ if ( fn > (float)65000.0) return scalbnf(x, 65000);
+ if (-fn > (float)65000.0) return scalbnf(x,-65000);
+ return scalbnf(x,(int)fn);
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+double scalbln(double x, long n)
+{
+ if (n > INT_MAX)
+ n = INT_MAX;
+ else if (n < INT_MIN)
+ n = INT_MIN;
+ return scalbn(x, n);
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+float scalblnf(float x, long n)
+{
+ if (n > INT_MAX)
+ n = INT_MAX;
+ else if (n < INT_MIN)
+ n = INT_MIN;
+ return scalbnf(x, n);
+}
--- /dev/null
+#include <limits.h>
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double scalblnl(long double x, long n)
+{
+ return scalbln(x, n);
+}
+#else
+long double scalblnl(long double x, long n)
+{
+ if (n > INT_MAX)
+ n = INT_MAX;
+ else if (n < INT_MIN)
+ n = INT_MIN;
+ return scalbnl(x, n);
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_scalbn.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * scalbn (double x, int n)
+ * scalbn(x,n) returns x* 2**n computed by exponent
+ * manipulation rather than by actually performing an
+ * exponentiation or a multiplication.
+ */
+
+#include "libm.h"
+
+static const double
+two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
+twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */
+huge = 1.0e+300,
+tiny = 1.0e-300;
+
+double scalbn(double x, int n)
+{
+// FIXME: k+n check depends on signed int overflow.. use unsigned hx
+// TODO: when long != int:
+// scalbln(x,long n) { if(n>9999)n=9999; else if(n<-9999)n=-9999; return scalbn(x,n); }
+// TODO: n < -50000 ...
+ int32_t k,hx,lx;
+
+ EXTRACT_WORDS(hx, lx, x);
+ k = (hx&0x7ff00000)>>20; /* extract exponent */
+ if (k == 0) { /* 0 or subnormal x */
+ if ((lx|(hx&0x7fffffff)) == 0) /* +-0 */
+ return x;
+ x *= two54;
+ GET_HIGH_WORD(hx, x);
+ k = ((hx&0x7ff00000)>>20) - 54;
+ if (n < -50000)
+ return tiny*x; /*underflow*/
+ }
+ if (k == 0x7ff) /* NaN or Inf */
+ return x + x;
+ k = k + n;
+ if (k > 0x7fe)
+ return huge*copysign(huge, x); /* overflow */
+ if (k > 0) { /* normal result */
+ SET_HIGH_WORD(x, (hx&0x800fffff)|(k<<20));
+ return x;
+ }
+ if (k <= -54)
+ if (n > 50000) /* in case integer overflow in n+k */
+ return huge*copysign(huge, x); /*overflow*/
+ return tiny*copysign(tiny, x); /*underflow*/
+ k += 54; /* subnormal result */
+ SET_HIGH_WORD(x, (hx&0x800fffff)|(k<<20));
+ return x*twom54;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_scalbnf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float
+two25 = 3.355443200e+07, /* 0x4c000000 */
+twom25 = 2.9802322388e-08, /* 0x33000000 */
+huge = 1.0e+30,
+tiny = 1.0e-30;
+
+float scalbnf(float x, int n)
+{
+ int32_t k, ix;
+ GET_FLOAT_WORD(ix, x);
+ k = (ix&0x7f800000)>>23; /* extract exponent */
+ if (k == 0) { /* 0 or subnormal x */
+ if ((ix&0x7fffffff) == 0) /* +-0 */
+ return x;
+ x *= two25;
+ GET_FLOAT_WORD(ix, x);
+ k = ((ix&0x7f800000)>>23) - 25;
+ if (n < -50000)
+ return tiny*x; /*underflow*/
+ }
+ if (k == 0xff) /* NaN or Inf */
+ return x + x;
+ k = k + n;
+ if (k > 0xfe)
+ return huge*copysignf(huge, x); /* overflow */
+ if (k > 0) { /* normal result */
+ SET_FLOAT_WORD(x, (ix&0x807fffff)|(k<<23));
+ return x;
+ }
+ if (k <= -25)
+ if (n > 50000) /* in case integer overflow in n+k */
+ return huge*copysignf(huge,x); /*overflow*/
+ return tiny*copysignf(tiny, x); /*underflow*/
+ k += 25; /* subnormal result */
+ SET_FLOAT_WORD(x, (ix&0x807fffff)|(k<<23));
+ return x*twom25;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_scalbnl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * scalbnl (long double x, int n)
+ * scalbnl(x,n) returns x* 2**n computed by exponent
+ * manipulation rather than by actually performing an
+ * exponentiation or a multiplication.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double scalbnl(long double x, int n)
+{
+ return scalbn(x, n);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+static const long double
+huge = 0x1p16000L,
+tiny = 0x1p-16000L;
+
+long double scalbnl(long double x, int n)
+{
+ union IEEEl2bits u;
+ int k;
+
+ u.e = x;
+ k = u.bits.exp; /* extract exponent */
+ if (k == 0) { /* 0 or subnormal x */
+ if ((u.bits.manh|u.bits.manl) == 0) /* +-0 */
+ return x;
+ u.e *= 0x1p128;
+ k = u.bits.exp - 128;
+ if (n < -50000)
+ return tiny*x; /*underflow*/
+ }
+ if (k == 0x7fff) /* NaN or Inf */
+ return x + x;
+ k = k + n;
+ if (k >= 0x7fff)
+ return huge*copysignl(huge, x); /* overflow */
+ if (k > 0) { /* normal result */
+ u.bits.exp = k;
+ return u.e;
+ }
+ if (k <= -128)
+ if (n > 50000) /* in case integer overflow in n+k */
+ return huge*copysign(huge, x); /*overflow*/
+ return tiny*copysign(tiny, x); /*underflow*/
+ k += 128; /* subnormal result */
+ u.bits.exp = k;
+ return u.e*0x1p-128;
+}
+#endif
--- /dev/null
+#include <math.h>
+int signgam = 0;
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_sin.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* sin(x)
+ * Return sine function of x.
+ *
+ * kernel function:
+ * __sin ... sine function on [-pi/4,pi/4]
+ * __cos ... cose function on [-pi/4,pi/4]
+ * __rem_pio2 ... argument reduction routine
+ *
+ * Method.
+ * Let S,C and T denote the sin, cos and tan respectively on
+ * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
+ * in [-pi/4 , +pi/4], and let n = k mod 4.
+ * We have
+ *
+ * n sin(x) cos(x) tan(x)
+ * ----------------------------------------------------------
+ * 0 S C T
+ * 1 C -S -1/T
+ * 2 -S -C T
+ * 3 -C S -1/T
+ * ----------------------------------------------------------
+ *
+ * Special cases:
+ * Let trig be any of sin, cos, or tan.
+ * trig(+-INF) is NaN, with signals;
+ * trig(NaN) is that NaN;
+ *
+ * Accuracy:
+ * TRIG(x) returns trig(x) nearly rounded
+ */
+
+#include "libm.h"
+
+double sin(double x)
+{
+ double y[2], z=0.0;
+ int32_t n, ix;
+
+ /* High word of x. */
+ GET_HIGH_WORD(ix, x);
+
+ /* |x| ~< pi/4 */
+ ix &= 0x7fffffff;
+ if (ix <= 0x3fe921fb) {
+ if (ix < 0x3e500000) { /* |x| < 2**-26 */
+ /* raise inexact if x != 0 */
+ if ((int)x == 0)
+ return x;
+ }
+ return __sin(x, z, 0);
+ }
+
+ /* sin(Inf or NaN) is NaN */
+ if (ix >= 0x7ff00000)
+ return x - x;
+
+ /* argument reduction needed */
+ n = __rem_pio2(x, y);
+ switch (n&3) {
+ case 0: return __sin(y[0], y[1], 1);
+ case 1: return __cos(y[0], y[1]);
+ case 2: return -__sin(y[0], y[1], 1);
+ default:
+ return -__cos(y[0], y[1]);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_sinf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+/* Small multiples of pi/2 rounded to double precision. */
+static const double
+s1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */
+s2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */
+s3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */
+s4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */
+
+float sinf(float x)
+{
+ double y;
+ int32_t n, hx, ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+
+ if (ix <= 0x3f490fda) { /* |x| ~<= pi/4 */
+ if (ix < 0x39800000) /* |x| < 2**-12 */
+ /* raise inexact if x != 0 */
+ if((int)x == 0)
+ return x;
+ return __sindf(x);
+ }
+ if (ix <= 0x407b53d1) { /* |x| ~<= 5*pi/4 */
+ if (ix <= 0x4016cbe3) { /* |x| ~<= 3pi/4 */
+ if (hx > 0)
+ return __cosdf(x - s1pio2);
+ else
+ return -__cosdf(x + s1pio2);
+ }
+ return __sindf(hx > 0 ? s2pio2 - x : -s2pio2 - x);
+ }
+ if (ix <= 0x40e231d5) { /* |x| ~<= 9*pi/4 */
+ if (ix <= 0x40afeddf) { /* |x| ~<= 7*pi/4 */
+ if (hx > 0)
+ return -__cosdf(x - s3pio2);
+ else
+ return __cosdf(x + s3pio2);
+ }
+ return __sindf(hx > 0 ? x - s4pio2 : x + s4pio2);
+ }
+
+ /* sin(Inf or NaN) is NaN */
+ if (ix >= 0x7f800000)
+ return x - x;
+
+ /* general argument reduction needed */
+ n = __rem_pio2f(x, &y);
+ switch (n&3) {
+ case 0: return __sindf(y);
+ case 1: return __cosdf(y);
+ case 2: return __sindf(-y);
+ default:
+ return -__cosdf(y);
+ }
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_sinh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* sinh(x)
+ * Method :
+ * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2
+ * 1. Replace x by |x| (sinh(-x) = -sinh(x)).
+ * 2.
+ * E + E/(E+1)
+ * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x)
+ * 2
+ *
+ * 22 <= x <= lnovft : sinh(x) := exp(x)/2
+ * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2)
+ * ln2ovft < x : sinh(x) := x*shuge (overflow)
+ *
+ * Special cases:
+ * sinh(x) is |x| if x is +INF, -INF, or NaN.
+ * only sinh(0)=0 is exact for finite x.
+ */
+
+#include "libm.h"
+
+static const double one = 1.0, huge = 1.0e307;
+
+double sinh(double x)
+{
+ double t, h;
+ int32_t ix, jx;
+
+ /* High word of |x|. */
+ GET_HIGH_WORD(jx, x);
+ ix = jx & 0x7fffffff;
+
+ /* x is INF or NaN */
+ if (ix >= 0x7ff00000)
+ return x + x;
+
+ h = 0.5;
+ if (jx < 0) h = -h;
+ /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */
+ if (ix < 0x40360000) { /* |x|<22 */
+ if (ix < 0x3e300000) /* |x|<2**-28 */
+ /* raise inexact, return x */
+ if (huge+x > one)
+ return x;
+ t = expm1(fabs(x));
+ if (ix < 0x3ff00000)
+ return h*(2.0*t - t*t/(t+one));
+ return h*(t + t/(t+one));
+ }
+
+ /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */
+ if (ix < 0x40862E42)
+ return h*exp(fabs(x));
+
+ /* |x| in [log(maxdouble), overflowthresold] */
+ if (ix <= 0x408633CE)
+ return h * 2.0 * __expo2(fabs(x)); /* h is for sign only */
+
+ /* |x| > overflowthresold, sinh(x) overflow */
+ return x*huge;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_sinhf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float one = 1.0, huge = 1.0e37;
+
+float sinhf(float x)
+{
+ float t, h;
+ int32_t ix, jx;
+
+ GET_FLOAT_WORD(jx, x);
+ ix = jx & 0x7fffffff;
+
+ /* x is INF or NaN */
+ if (ix >= 0x7f800000)
+ return x + x;
+
+ h = 0.5;
+ if (jx < 0)
+ h = -h;
+ /* |x| in [0,9], return sign(x)*0.5*(E+E/(E+1))) */
+ if (ix < 0x41100000) { /* |x|<9 */
+ if (ix < 0x39800000) /* |x|<2**-12 */
+ /* raise inexact, return x */
+ if (huge+x > one)
+ return x;
+ t = expm1f(fabsf(x));
+ if (ix < 0x3f800000)
+ return h*((float)2.0*t - t*t/(t+one));
+ return h*(t + t/(t+one));
+ }
+
+ /* |x| in [9, logf(maxfloat)] return 0.5*exp(|x|) */
+ if (ix < 0x42b17217)
+ return h*expf(fabsf(x));
+
+ /* |x| in [logf(maxfloat), overflowthresold] */
+ if (ix <= 0x42b2d4fc)
+ return h * 2.0f * __expo2f(fabsf(x)); /* h is for sign only */
+
+ /* |x| > overflowthresold, sinh(x) overflow */
+ return x*huge;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_sinhl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* sinhl(x)
+ * Method :
+ * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2
+ * 1. Replace x by |x| (sinhl(-x) = -sinhl(x)).
+ * 2.
+ * E + E/(E+1)
+ * 0 <= x <= 25 : sinhl(x) := --------------, E=expm1l(x)
+ * 2
+ *
+ * 25 <= x <= lnovft : sinhl(x) := expl(x)/2
+ * lnovft <= x <= ln2ovft: sinhl(x) := expl(x/2)/2 * expl(x/2)
+ * ln2ovft < x : sinhl(x) := x*huge (overflow)
+ *
+ * Special cases:
+ * sinhl(x) is |x| if x is +INF, -INF, or NaN.
+ * only sinhl(0)=0 is exact for finite x.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double sinhl(long double x)
+{
+ return sinh(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double one = 1.0, huge = 1.0e4931L;
+
+long double sinhl(long double x)
+{
+ long double t,w,h;
+ uint32_t jx,ix,i0,i1;
+
+ /* Words of |x|. */
+ GET_LDOUBLE_WORDS(jx, i0, i1, x);
+ ix = jx & 0x7fff;
+
+ /* x is INF or NaN */
+ if (ix == 0x7fff) return x + x;
+
+ h = 0.5;
+ if (jx & 0x8000)
+ h = -h;
+ /* |x| in [0,25], return sign(x)*0.5*(E+E/(E+1))) */
+ if (ix < 0x4003 || (ix == 0x4003 && i0 <= 0xc8000000)) { /* |x| < 25 */
+ if (ix < 0x3fdf) /* |x|<2**-32 */
+ if (huge + x > one)
+ return x;/* sinh(tiny) = tiny with inexact */
+ t = expm1l(fabsl(x));
+ if (ix < 0x3fff)
+ return h*(2.0*t - t*t/(t + one));
+ return h*(t + t/(t + one));
+ }
+
+ /* |x| in [25, log(maxdouble)] return 0.5*exp(|x|) */
+ if (ix < 0x400c || (ix == 0x400c && i0 < 0xb17217f7))
+ return h*expl(fabsl(x));
+
+ /* |x| in [log(maxdouble), overflowthreshold] */
+ if (ix < 0x400c || (ix == 0x400c && (i0 < 0xb174ddc0 ||
+ (i0 == 0xb174ddc0 && i1 <= 0x31aec0ea)))) {
+ w = expl(0.5*fabsl(x));
+ t = h*w;
+ return t*w;
+ }
+
+ /* |x| > overflowthreshold, sinhl(x) overflow */
+ return x*huge;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_sinl.c */
+/*-
+ * Copyright (c) 2007 Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double sinl(long double x)
+{
+ return sin(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__rem_pio2l.h"
+
+long double sinl(long double x)
+{
+ union IEEEl2bits z;
+ int e0, s;
+ long double y[2];
+ long double hi, lo;
+
+ z.e = x;
+ s = z.bits.sign;
+ z.bits.sign = 0;
+
+ /* If x = +-0 or x is a subnormal number, then sin(x) = x */
+ if (z.bits.exp == 0)
+ return x;
+
+ /* If x = NaN or Inf, then sin(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 = __sinl(z.e, 0, 0);
+ return s ? -hi : hi;
+ }
+
+ e0 = __rem_pio2l(x, y);
+ hi = y[0];
+ lo = y[1];
+
+ switch (e0 & 3) {
+ case 0:
+ hi = __sinl(hi, lo, 1);
+ break;
+ case 1:
+ hi = __cosl(hi, lo);
+ break;
+ case 2:
+ hi = - __sinl(hi, lo, 1);
+ break;
+ case 3:
+ hi = - __cosl(hi, lo);
+ break;
+ }
+ return hi;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_sqrt.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* sqrt(x)
+ * Return correctly rounded sqrt.
+ * ------------------------------------------
+ * | Use the hardware sqrt if you have one |
+ * ------------------------------------------
+ * Method:
+ * Bit by bit method using integer arithmetic. (Slow, but portable)
+ * 1. Normalization
+ * Scale x to y in [1,4) with even powers of 2:
+ * find an integer k such that 1 <= (y=x*2^(2k)) < 4, then
+ * sqrt(x) = 2^k * sqrt(y)
+ * 2. Bit by bit computation
+ * Let q = sqrt(y) truncated to i bit after binary point (q = 1),
+ * i 0
+ * i+1 2
+ * s = 2*q , and y = 2 * ( y - q ). (1)
+ * i i i i
+ *
+ * To compute q from q , one checks whether
+ * i+1 i
+ *
+ * -(i+1) 2
+ * (q + 2 ) <= y. (2)
+ * i
+ * -(i+1)
+ * If (2) is false, then q = q ; otherwise q = q + 2 .
+ * i+1 i i+1 i
+ *
+ * With some algebric manipulation, it is not difficult to see
+ * that (2) is equivalent to
+ * -(i+1)
+ * s + 2 <= y (3)
+ * i i
+ *
+ * The advantage of (3) is that s and y can be computed by
+ * i i
+ * the following recurrence formula:
+ * if (3) is false
+ *
+ * s = s , y = y ; (4)
+ * i+1 i i+1 i
+ *
+ * otherwise,
+ * -i -(i+1)
+ * s = s + 2 , y = y - s - 2 (5)
+ * i+1 i i+1 i i
+ *
+ * One may easily use induction to prove (4) and (5).
+ * Note. Since the left hand side of (3) contain only i+2 bits,
+ * it does not necessary to do a full (53-bit) comparison
+ * in (3).
+ * 3. Final rounding
+ * After generating the 53 bits result, we compute one more bit.
+ * Together with the remainder, we can decide whether the
+ * result is exact, bigger than 1/2ulp, or less than 1/2ulp
+ * (it will never equal to 1/2ulp).
+ * The rounding mode can be detected by checking whether
+ * huge + tiny is equal to huge, and whether huge - tiny is
+ * equal to huge for some floating point number "huge" and "tiny".
+ *
+ * Special cases:
+ * sqrt(+-0) = +-0 ... exact
+ * sqrt(inf) = inf
+ * sqrt(-ve) = NaN ... with invalid signal
+ * sqrt(NaN) = NaN ... with invalid signal for signaling NaN
+ */
+
+#include "libm.h"
+
+static const double one = 1.0, tiny = 1.0e-300;
+
+double sqrt(double x)
+{
+ double z;
+ int32_t sign = (int)0x80000000;
+ int32_t ix0,s0,q,m,t,i;
+ uint32_t r,t1,s1,ix1,q1;
+
+ EXTRACT_WORDS(ix0, ix1, x);
+
+ /* take care of Inf and NaN */
+ if ((ix0&0x7ff00000) == 0x7ff00000) {
+ return x*x + x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf, sqrt(-inf)=sNaN */
+ }
+ /* take care of zero */
+ if (ix0 <= 0) {
+ if (((ix0&~sign)|ix1) == 0)
+ return x; /* sqrt(+-0) = +-0 */
+ if (ix0 < 0)
+ return (x-x)/(x-x); /* sqrt(-ve) = sNaN */
+ }
+ /* normalize x */
+ m = ix0>>20;
+ if (m == 0) { /* subnormal x */
+ while (ix0 == 0) {
+ m -= 21;
+ ix0 |= (ix1>>11);
+ ix1 <<= 21;
+ }
+ for (i=0; (ix0&0x00100000) == 0; i++)
+ ix0<<=1;
+ m -= i - 1;
+ ix0 |= ix1>>(32-i);
+ ix1 <<= i;
+ }
+ m -= 1023; /* unbias exponent */
+ ix0 = (ix0&0x000fffff)|0x00100000;
+ if (m & 1) { /* odd m, double x to make it even */
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ }
+ m >>= 1; /* m = [m/2] */
+
+ /* generate sqrt(x) bit by bit */
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */
+ r = 0x00200000; /* r = moving bit from right to left */
+
+ while (r != 0) {
+ t = s0 + r;
+ if (t <= ix0) {
+ s0 = t + r;
+ ix0 -= t;
+ q += r;
+ }
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ r >>= 1;
+ }
+
+ r = sign;
+ while (r != 0) {
+ t1 = s1 + r;
+ t = s0;
+ if (t < ix0 || (t == ix0 && t1 <= ix1)) {
+ s1 = t1 + r;
+ if ((t1&sign) == sign && (s1&sign) == 0)
+ s0++;
+ ix0 -= t;
+ if (ix1 < t1)
+ ix0--;
+ ix1 -= t1;
+ q1 += r;
+ }
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ r >>= 1;
+ }
+
+ /* use floating add to find out rounding direction */
+ if ((ix0|ix1) != 0) {
+ z = one - tiny; /* raise inexact flag */
+ if (z >= one) {
+ z = one + tiny;
+ if (q1 == (uint32_t)0xffffffff) {
+ q1 = 0;
+ q++;
+ } else if (z > one) {
+ if (q1 == (uint32_t)0xfffffffe)
+ q++;
+ q1 += 2;
+ } else
+ q1 += q1 & 1;
+ }
+ }
+ ix0 = (q>>1) + 0x3fe00000;
+ ix1 = q1>>1;
+ if (q&1)
+ ix1 |= sign;
+ ix0 += m << 20;
+ INSERT_WORDS(z, ix0, ix1);
+ return z;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/e_sqrtf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float one = 1.0, tiny = 1.0e-30;
+
+float sqrtf(float x)
+{
+ float z;
+ int32_t sign = (int)0x80000000;
+ int32_t ix,s,q,m,t,i;
+ uint32_t r;
+
+ GET_FLOAT_WORD(ix, x);
+
+ /* take care of Inf and NaN */
+ if ((ix&0x7f800000) == 0x7f800000)
+ return x*x + x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf, sqrt(-inf)=sNaN */
+
+ /* take care of zero */
+ if (ix <= 0) {
+ if ((ix&~sign) == 0)
+ return x; /* sqrt(+-0) = +-0 */
+ if (ix < 0)
+ return (x-x)/(x-x); /* sqrt(-ve) = sNaN */
+ }
+ /* normalize x */
+ m = ix>>23;
+ if (m == 0) { /* subnormal x */
+ for (i = 0; (ix&0x00800000) == 0; i++)
+ ix<<=1;
+ m -= i - 1;
+ }
+ m -= 127; /* unbias exponent */
+ ix = (ix&0x007fffff)|0x00800000;
+ if (m&1) /* odd m, double x to make it even */
+ ix += ix;
+ m >>= 1; /* m = [m/2] */
+
+ /* generate sqrt(x) bit by bit */
+ ix += ix;
+ q = s = 0; /* q = sqrt(x) */
+ r = 0x01000000; /* r = moving bit from right to left */
+
+ while (r != 0) {
+ t = s + r;
+ if (t <= ix) {
+ s = t+r;
+ ix -= t;
+ q += r;
+ }
+ ix += ix;
+ r >>= 1;
+ }
+
+ /* use floating add to find out rounding direction */
+ if (ix != 0) {
+ z = one - tiny; /* raise inexact flag */
+ if (z >= one) {
+ z = one + tiny;
+ if (z > one)
+ q += 2;
+ else
+ q += q & 1;
+ }
+ }
+ ix = (q>>1) + 0x3f000000;
+ ix += m << 23;
+ SET_FLOAT_WORD(z, ix);
+ return z;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_tan.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* tan(x)
+ * Return tangent function of x.
+ *
+ * kernel function:
+ * __tan ... tangent function on [-pi/4,pi/4]
+ * __rem_pio2 ... argument reduction routine
+ *
+ * Method.
+ * Let S,C and T denote the sin, cos and tan respectively on
+ * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
+ * in [-pi/4 , +pi/4], and let n = k mod 4.
+ * We have
+ *
+ * n sin(x) cos(x) tan(x)
+ * ----------------------------------------------------------
+ * 0 S C T
+ * 1 C -S -1/T
+ * 2 -S -C T
+ * 3 -C S -1/T
+ * ----------------------------------------------------------
+ *
+ * Special cases:
+ * Let trig be any of sin, cos, or tan.
+ * trig(+-INF) is NaN, with signals;
+ * trig(NaN) is that NaN;
+ *
+ * Accuracy:
+ * TRIG(x) returns trig(x) nearly rounded
+ */
+
+#include "libm.h"
+
+double tan(double x)
+{
+ double y[2], z = 0.0;
+ int32_t n, ix;
+
+ /* High word of x. */
+ GET_HIGH_WORD(ix, x);
+
+ /* |x| ~< pi/4 */
+ ix &= 0x7fffffff;
+ if (ix <= 0x3fe921fb) {
+ if (ix < 0x3e400000) /* x < 2**-27 */
+ /* raise inexact if x != 0 */
+ if ((int)x == 0)
+ return x;
+ return __tan(x, z, 1);
+ }
+
+ /* tan(Inf or NaN) is NaN */
+ if (ix >= 0x7ff00000)
+ return x - x;
+
+ /* argument reduction needed */
+ n = __rem_pio2(x, y);
+ return __tan(y[0], y[1], 1 - ((n&1)<<1)); /* n even: 1, n odd: -1 */
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_tanf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ * Optimized by Bruce D. Evans.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+/* Small multiples of pi/2 rounded to double precision. */
+static const double
+t1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */
+t2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */
+t3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */
+t4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */
+
+float tanf(float x)
+{
+ double y;
+ int32_t n, hx, ix;
+
+ GET_FLOAT_WORD(hx, x);
+ ix = hx & 0x7fffffff;
+
+ if (ix <= 0x3f490fda) { /* |x| ~<= pi/4 */
+ if (ix < 0x39800000) /* |x| < 2**-12 */
+ /* return x and raise inexact if x != 0 */
+ if ((int)x == 0)
+ return x;
+ return __tandf(x, 1);
+ }
+ if (ix <= 0x407b53d1) { /* |x| ~<= 5*pi/4 */
+ if (ix <= 0x4016cbe3) /* |x| ~<= 3pi/4 */
+ return __tandf((hx > 0 ? x-t1pio2 : x+t1pio2), -1);
+ else
+ return __tandf((hx > 0 ? x-t2pio2 : x+t2pio2), 1);
+ }
+ if (ix <= 0x40e231d5) { /* |x| ~<= 9*pi/4 */
+ if (ix <= 0x40afeddf) /* |x| ~<= 7*pi/4 */
+ return __tandf((hx > 0 ? x-t3pio2 : x+t3pio2), -1);
+ else
+ return __tandf((hx > 0 ? x-t4pio2 : x+t4pio2), 1);
+ }
+
+ /* tan(Inf or NaN) is NaN */
+ if (ix >= 0x7f800000)
+ return x - x;
+
+ /* general argument reduction needed */
+ n = __rem_pio2f(x, &y);
+ /* integer parameter: n even: 1; n odd: -1 */
+ return __tandf(y, 1-((n&1)<<1));
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_tanh.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* Tanh(x)
+ * Return the Hyperbolic Tangent of x
+ *
+ * Method :
+ * x -x
+ * e - e
+ * 0. tanh(x) is defined to be -----------
+ * x -x
+ * e + e
+ * 1. reduce x to non-negative by tanh(-x) = -tanh(x).
+ * 2. 0 <= x < 2**-28 : tanh(x) := x with inexact if x != 0
+ * -t
+ * 2**-28 <= x < 1 : tanh(x) := -----; t = expm1(-2x)
+ * t + 2
+ * 2
+ * 1 <= x < 22 : tanh(x) := 1 - -----; t = expm1(2x)
+ * t + 2
+ * 22 <= x <= INF : tanh(x) := 1.
+ *
+ * Special cases:
+ * tanh(NaN) is NaN;
+ * only tanh(0)=0 is exact for finite argument.
+ */
+
+#include "libm.h"
+
+static const double one = 1.0, two = 2.0, tiny = 1.0e-300, huge = 1.0e300;
+
+double tanh(double x)
+{
+ double t,z;
+ int32_t jx,ix;
+
+ GET_HIGH_WORD(jx, 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 */
+ }
+
+ if (ix < 0x40360000) { /* |x| < 22 */
+ if (ix < 0x3e300000) { /* |x| < 2**-28 */
+ /* tanh(tiny) = tiny with inexact */
+ if (huge+x > one)
+ return x;
+ }
+ 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);
+ }
+ } else { /* |x| >= 22, return +-1 */
+ z = one - tiny; /* raise inexact */
+ }
+ return jx >= 0 ? z : -z;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_tanhf.c */
+/*
+ * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com.
+ */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+#include "libm.h"
+
+static const float one = 1.0, two = 2.0, tiny = 1.0e-30, huge = 1.0e30;
+
+float tanhf(float x)
+{
+ float t,z;
+ int32_t jx,ix;
+
+ GET_FLOAT_WORD(jx, x);
+ ix = jx & 0x7fffffff;
+
+ /* x is INF or NaN */
+ if(ix >= 0x7f800000) {
+ if (jx >= 0)
+ return one/x + one; /* tanh(+-inf)=+-1 */
+ else
+ return one/x - one; /* tanh(NaN) = NaN */
+ }
+
+ if (ix < 0x41100000) { /* |x| < 9 */
+ if (ix < 0x39800000) { /* |x| < 2**-12 */
+ /* tanh(tiny) = tiny with inexact */
+ if (huge+x > one)
+ return x;
+ }
+ if (ix >= 0x3f800000) { /* |x|>=1 */
+ t = expm1f(two*fabsf(x));
+ z = one - two/(t+two);
+ } else {
+ t = expm1f(-two*fabsf(x));
+ z = -t/(t+two);
+ }
+ } else { /* |x| >= 9, return +-1 */
+ z = one - tiny; /* raise inexact */
+ }
+ return jx >= 0 ? z : -z;
+}
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/s_tanhl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/* tanhl(x)
+ * Return the Hyperbolic Tangent of x
+ *
+ * Method :
+ * x -x
+ * e - e
+ * 0. tanhl(x) is defined to be -----------
+ * x -x
+ * e + e
+ * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x).
+ * 2. 0 <= x <= 2**-55 : tanhl(x) := x*(one+x)
+ * -t
+ * 2**-55 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x)
+ * t + 2
+ * 2
+ * 1 <= x <= 23.0 : tanhl(x) := 1- ----- ; t=expm1l(2x)
+ * t + 2
+ * 23.0 < x <= INF : tanhl(x) := 1.
+ *
+ * Special cases:
+ * tanhl(NaN) is NaN;
+ * only tanhl(0)=0 is exact for finite argument.
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double tanhl(long double x)
+{
+ return tanh(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+static const long double one=1.0, two=2.0, tiny = 1.0e-4900L;
+
+long double tanhl(long double x)
+{
+ long double t,z;
+ int32_t se;
+ uint32_t jj0,jj1,ix;
+
+ /* High word of |x|. */
+ GET_LDOUBLE_WORDS(se, jj0, jj1, x);
+ ix = se & 0x7fff;
+
+ /* x is INF or NaN */
+ if (ix == 0x7fff) {
+ /* for NaN it's not important which branch: tanhl(NaN) = NaN */
+ if (se & 0x8000)
+ return one/x-one; /* tanhl(-inf)= -1; */
+ return one/x+one; /* tanhl(+inf)= +1 */
+ }
+
+ /* |x| < 23 */
+ if (ix < 0x4003 || (ix == 0x4003 && jj0 < 0xb8000000u)) {
+ if ((ix|jj0|jj1) == 0) /* x == +- 0 */
+ return x;
+ if (ix < 0x3fc8) /* |x| < 2**-55 */
+ return x*(one+tiny); /* tanh(small) = small */
+ if (ix >= 0x3fff) { /* |x| >= 1 */
+ t = expm1l(two*fabsl(x));
+ z = one - two/(t+two);
+ } else {
+ t = expm1l(-two*fabsl(x));
+ z = -t/(t+two);
+ }
+ /* |x| > 23, return +-1 */
+ } else {
+ z = one - tiny; /* raise inexact flag */
+ }
+ return se & 0x8000 ? -z : z;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_tanl.c */
+/*-
+ * Copyright (c) 2007 Steven G. Kargl
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice unmodified, this list of conditions, and the following
+ * disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+/*
+ * Limited testing on pseudorandom numbers drawn within [0:4e8] shows
+ * an accuracy of <= 1.5 ULP where 247024 values of x out of 40 million
+ * possibles resulted in tan(x) that exceeded 0.5 ULP (ie., 0.6%).
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double tanl(long double x)
+{
+ return tan(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#include "__rem_pio2l.h"
+
+long double tanl(long double x)
+{
+ union IEEEl2bits z;
+ int e0, s;
+ long double y[2];
+ 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 = __tanl(z.e, 0, 0);
+ return s ? -hi : hi;
+ }
+
+ e0 = __rem_pio2l(x, y);
+ hi = y[0];
+ lo = y[1];
+
+ switch (e0 & 3) {
+ case 0:
+ case 2:
+ hi = __tanl(hi, lo, 0);
+ break;
+ case 1:
+ case 3:
+ hi = __tanl(hi, lo, 1);
+ break;
+ }
+ return hi;
+}
+#endif
--- /dev/null
+/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_tgammal.c */
+/*
+ * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+/*
+ * Gamma function
+ *
+ *
+ * SYNOPSIS:
+ *
+ * long double x, y, tgammal();
+ * extern int signgam;
+ *
+ * y = tgammal( x );
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns gamma function of the argument. The result is
+ * correctly signed, and the sign (+1 or -1) is also
+ * returned in a global (extern) variable named signgam.
+ * This variable is also filled in by the logarithmic gamma
+ * function lgamma().
+ *
+ * Arguments |x| <= 13 are reduced by recurrence and the function
+ * approximated by a rational function of degree 7/8 in the
+ * interval (2,3). Large arguments are handled by Stirling's
+ * formula. Large negative arguments are made positive using
+ * a reflection formula.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * IEEE -40,+40 10000 3.6e-19 7.9e-20
+ * IEEE -1755,+1755 10000 4.8e-18 6.5e-19
+ *
+ * Accuracy for large arguments is dominated by error in powl().
+ *
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double tgammal(long double x)
+{
+ return tgamma(x);
+}
+#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
+/*
+tgamma(x+2) = tgamma(x+2) P(x)/Q(x)
+0 <= x <= 1
+Relative error
+n=7, d=8
+Peak error = 1.83e-20
+Relative error spread = 8.4e-23
+*/
+static long double P[8] = {
+ 4.212760487471622013093E-5L,
+ 4.542931960608009155600E-4L,
+ 4.092666828394035500949E-3L,
+ 2.385363243461108252554E-2L,
+ 1.113062816019361559013E-1L,
+ 3.629515436640239168939E-1L,
+ 8.378004301573126728826E-1L,
+ 1.000000000000000000009E0L,
+};
+static long double Q[9] = {
+-1.397148517476170440917E-5L,
+ 2.346584059160635244282E-4L,
+-1.237799246653152231188E-3L,
+-7.955933682494738320586E-4L,
+ 2.773706565840072979165E-2L,
+-4.633887671244534213831E-2L,
+-2.243510905670329164562E-1L,
+ 4.150160950588455434583E-1L,
+ 9.999999999999999999908E-1L,
+};
+
+/*
+static long double P[] = {
+-3.01525602666895735709e0L,
+-3.25157411956062339893e1L,
+-2.92929976820724030353e2L,
+-1.70730828800510297666e3L,
+-7.96667499622741999770e3L,
+-2.59780216007146401957e4L,
+-5.99650230220855581642e4L,
+-7.15743521530849602425e4L
+};
+static long double Q[] = {
+ 1.00000000000000000000e0L,
+-1.67955233807178858919e1L,
+ 8.85946791747759881659e1L,
+ 5.69440799097468430177e1L,
+-1.98526250512761318471e3L,
+ 3.31667508019495079814e3L,
+ 1.60577839621734713377e4L,
+-2.97045081369399940529e4L,
+-7.15743521530849602412e4L
+};
+*/
+#define MAXGAML 1755.455L
+/*static const long double LOGPI = 1.14472988584940017414L;*/
+
+/* Stirling's formula for the gamma function
+tgamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x))
+z(x) = x
+13 <= x <= 1024
+Relative error
+n=8, d=0
+Peak error = 9.44e-21
+Relative error spread = 8.8e-4
+*/
+static long double STIR[9] = {
+ 7.147391378143610789273E-4L,
+-2.363848809501759061727E-5L,
+-5.950237554056330156018E-4L,
+ 6.989332260623193171870E-5L,
+ 7.840334842744753003862E-4L,
+-2.294719747873185405699E-4L,
+-2.681327161876304418288E-3L,
+ 3.472222222230075327854E-3L,
+ 8.333333333333331800504E-2L,
+};
+
+#define MAXSTIR 1024.0L
+static const long double SQTPI = 2.50662827463100050242E0L;
+
+/* 1/tgamma(x) = z P(z)
+ * z(x) = 1/x
+ * 0 < x < 0.03125
+ * Peak relative error 4.2e-23
+ */
+static long double S[9] = {
+-1.193945051381510095614E-3L,
+ 7.220599478036909672331E-3L,
+-9.622023360406271645744E-3L,
+-4.219773360705915470089E-2L,
+ 1.665386113720805206758E-1L,
+-4.200263503403344054473E-2L,
+-6.558780715202540684668E-1L,
+ 5.772156649015328608253E-1L,
+ 1.000000000000000000000E0L,
+};
+
+/* 1/tgamma(-x) = z P(z)
+ * z(x) = 1/x
+ * 0 < x < 0.03125
+ * Peak relative error 5.16e-23
+ * Relative error spread = 2.5e-24
+ */
+static long double SN[9] = {
+ 1.133374167243894382010E-3L,
+ 7.220837261893170325704E-3L,
+ 9.621911155035976733706E-3L,
+-4.219773343731191721664E-2L,
+-1.665386113944413519335E-1L,
+-4.200263503402112910504E-2L,
+ 6.558780715202536547116E-1L,
+ 5.772156649015328608727E-1L,
+-1.000000000000000000000E0L,
+};
+
+static const long double PIL = 3.1415926535897932384626L;
+
+/* Gamma function computed by Stirling's formula.
+ */
+static long double stirf(long double x)
+{
+ long double y, w, v;
+
+ w = 1.0L/x;
+ /* For large x, use rational coefficients from the analytical expansion. */
+ if (x > 1024.0L)
+ w = (((((6.97281375836585777429E-5L * w
+ + 7.84039221720066627474E-4L) * w
+ - 2.29472093621399176955E-4L) * w
+ - 2.68132716049382716049E-3L) * w
+ + 3.47222222222222222222E-3L) * w
+ + 8.33333333333333333333E-2L) * w
+ + 1.0L;
+ else
+ w = 1.0L + w * __polevll(w, STIR, 8);
+ y = expl(x);
+ if (x > MAXSTIR) { /* Avoid overflow in pow() */
+ v = powl(x, 0.5L * x - 0.25L);
+ y = v * (v / y);
+ } else {
+ y = powl(x, x - 0.5L) / y;
+ }
+ y = SQTPI * y * w;
+ return y;
+}
+
+long double tgammal(long double x)
+{
+ long double p, q, z;
+ int i;
+
+ signgam = 1;
+ if (isnan(x))
+ return NAN;
+ if (x == INFINITY)
+ return INFINITY;
+ if (x == -INFINITY)
+ return x - x;
+ q = fabsl(x);
+ if (q > 13.0L) {
+ if (q > MAXGAML)
+ goto goverf;
+ if (x < 0.0L) {
+ p = floorl(q);
+ if (p == q)
+ return (x - x) / (x - x);
+ i = p;
+ if ((i & 1) == 0)
+ signgam = -1;
+ z = q - p;
+ if (z > 0.5L) {
+ p += 1.0L;
+ z = q - p;
+ }
+ z = q * sinl(PIL * z);
+ z = fabsl(z) * stirf(q);
+ if (z <= PIL/LDBL_MAX) {
+goverf:
+ return signgam * INFINITY;
+ }
+ z = PIL/z;
+ } else {
+ z = stirf(x);
+ }
+ return signgam * z;
+ }
+
+ z = 1.0L;
+ while (x >= 3.0L) {
+ x -= 1.0L;
+ z *= x;
+ }
+ while (x < -0.03125L) {
+ z /= x;
+ x += 1.0L;
+ }
+ if (x <= 0.03125L)
+ goto small;
+ while (x < 2.0L) {
+ z /= x;
+ x += 1.0L;
+ }
+ if (x == 2.0L)
+ return z;
+
+ x -= 2.0L;
+ p = __polevll(x, P, 7);
+ q = __polevll(x, Q, 8);
+ z = z * p / q;
+ if(z < 0)
+ signgam = -1;
+ return z;
+
+small:
+ if (x == 0.0L)
+ return (x - x) / (x - x);
+ if (x < 0.0L) {
+ x = -x;
+ q = z / (x * __polevll(x, SN, 8));
+ signgam = -1;
+ } else
+ q = z / (x * __polevll(x, S, 8));
+ return q;
+}
+#endif
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_trunc.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * trunc(x)
+ * Return x rounded toward 0 to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to trunc(x).
+ */
+
+#include "libm.h"
+
+static const double huge = 1.0e300;
+
+double trunc(double x)
+{
+ int32_t i0,i1,j0;
+ uint32_t i;
+
+ EXTRACT_WORDS(i0, i1, x);
+ j0 = ((i0>>20)&0x7ff) - 0x3ff;
+ if (j0 < 20) {
+ if (j0 < 0) { /* |x|<1, return 0*sign(x) */
+ /* raise inexact if x != 0 */
+ if (huge+x > 0.0) {
+ i0 &= 0x80000000U;
+ i1 = 0;
+ }
+ } else {
+ i = 0x000fffff>>j0;
+ if (((i0&i)|i1) == 0)
+ return x; /* x is integral */
+ /* raise inexact */
+ if (huge+x > 0.0) {
+ i0 &= ~i;
+ i1 = 0;
+ }
+ }
+ } else if (j0 > 51) {
+ if (j0 == 0x400)
+ return x + x; /* inf or NaN */
+ return x; /* x is integral */
+ } else {
+ i = (uint32_t)0xffffffff>>(j0-20);
+ if ((i1&i) == 0)
+ return x; /* x is integral */
+ /* raise inexact */
+ if (huge+x > 0.0)
+ i1 &= ~i;
+ }
+ INSERT_WORDS(x, i0, i1);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_truncf.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * truncf(x)
+ * Return x rounded toward 0 to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to truncf(x).
+ */
+
+#include "libm.h"
+
+static const float huge = 1.0e30F;
+
+float truncf(float x)
+{
+ int32_t i0,j0;
+ uint32_t i;
+
+ GET_FLOAT_WORD(i0, x);
+ j0 = ((i0>>23)&0xff) - 0x7f;
+ if (j0 < 23) {
+ if (j0 < 0) { /* |x|<1, return 0*sign(x) */
+ /* raise inexact if x != 0 */
+ if (huge+x > 0.0F)
+ i0 &= 0x80000000;
+ } else {
+ i = 0x007fffff>>j0;
+ if ((i0&i) == 0)
+ return x; /* x is integral */
+ /* raise inexact */
+ if (huge+x > 0.0F)
+ i0 &= ~i;
+ }
+ } else {
+ if (j0 == 0x80)
+ return x + x; /* inf or NaN */
+ return x; /* x is integral */
+ }
+ SET_FLOAT_WORD(x, i0);
+ return x;
+}
--- /dev/null
+/* origin: FreeBSD /usr/src/lib/msun/src/s_truncl.c */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunPro, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+/*
+ * truncl(x)
+ * Return x rounded toward 0 to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to truncl(x).
+ */
+
+#include "libm.h"
+
+#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
+long double truncl(long double x)
+{
+ return trunc(x);
+}
+#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
+#ifdef LDBL_IMPLICIT_NBIT
+#define MANH_SIZE (LDBL_MANH_SIZE + 1)
+#else
+#define MANH_SIZE LDBL_MANH_SIZE
+#endif
+
+static const long double huge = 1.0e300;
+static const float zero[] = { 0.0, -0.0 };
+
+long double truncl(long double x)
+{
+ union IEEEl2bits u = { .e = x };
+ int e = u.bits.exp - LDBL_MAX_EXP + 1;
+
+ if (e < MANH_SIZE - 1) {
+ if (e < 0) {
+ /* raise inexact if x != 0 */
+ if (huge + x > 0.0)
+ u.e = zero[u.bits.sign];
+ } else {
+ uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1);
+ if (((u.bits.manh & m) | u.bits.manl) == 0)
+ return x; /* x is integral */
+ /* raise inexact */
+ if (huge + x > 0.0) {
+ u.bits.manh &= ~m;
+ u.bits.manl = 0;
+ }
+ }
+ } else if (e < LDBL_MANT_DIG - 1) {
+ uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1);
+ if ((u.bits.manl & m) == 0)
+ return x; /* x is integral */
+ /* raise inexact */
+ if (huge + x > 0.0)
+ u.bits.manl &= ~m;
+ }
+ return u.e;
+}
+#endif
+++ /dev/null
-.global sqrt
-.type sqrt,@function
-sqrt: sqrtsd %xmm0, %xmm0
- ret
+++ /dev/null
-.global sqrtf
-.type sqrtf,@function
-sqrtf: sqrtss %xmm0, %xmm0
- ret
--- /dev/null
+.global sqrt
+.type sqrt,@function
+sqrt: sqrtsd %xmm0, %xmm0
+ ret
--- /dev/null
+.global sqrtf
+.type sqrtf,@function
+sqrtf: sqrtss %xmm0, %xmm0
+ ret
--- /dev/null
+.global sqrtl
+.type sqrtl,@function
+sqrtl: fldt 8(%rsp)
+ fsqrt
+ ret
+++ /dev/null
-#include <math.h>
-#include <inttypes.h>
-
-double frexp(double x, int *e)
-{
- union { double d; uint64_t i; } y = { x };
- int ee = y.i>>52 & 0x7ff;
-
- if (!ee) {
- if (x) {
- x = frexp(x*0x1p64, e);
- *e -= 64;
- } else *e = 0;
- return x;
- } else if (ee == 0x7ff) {
- return x;
- }
-
- *e = ee - 0x3fe;
- y.i &= 0x800fffffffffffffull;
- y.i |= 0x3fe0000000000000ull;
- return y.d;
-}
+++ /dev/null
-#include <math.h>
-#include <inttypes.h>
-
-float frexpf(float x, int *e)
-{
- union { float f; uint32_t i; } y = { x };
- int ee = y.i>>23 & 0xff;
-
- if (!ee) {
- if (x) {
- x = frexpf(x*0x1p64, e);
- *e -= 64;
- } else *e = 0;
- return x;
- } else if (ee == 0xff) {
- return x;
- }
-
- *e = ee - 0x7e;
- y.i &= 0x807ffffful;
- y.i |= 0x3f000000ul;
- return y.f;
-}
+++ /dev/null
-#include <math.h>
-#include <inttypes.h>
-#include <float.h>
-
-#if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
-
-/* This version is for 80-bit little endian long double */
-
-long double frexpl(long double x, int *e)
-{
- union { long double ld; uint16_t hw[5]; } y = { x };
- int ee = y.hw[4]&0x7fff;
-
- if (!ee) {
- if (x) {
- x = frexpl(x*0x1p64, e);
- *e -= 64;
- } else *e = 0;
- return x;
- } else if (ee == 0x7fff) {
- return x;
- }
-
- *e = ee - 0x3ffe;
- y.hw[4] &= 0x8000;
- y.hw[4] |= 0x3ffe;
- return y.ld;
-}
-
-#else
-
-long double frexpl(long double x, int *e)
-{
- return frexp(x, e);
-}
-
-#endif
projects / oweals / musl.git / commitdiff