diff options
378 files changed, 20547 insertions, 7738 deletions
diff --git a/include/complex.h b/include/complex.h new file mode 100644 index 00000000..8ee70575 --- /dev/null +++ b/include/complex.h @@ -0,0 +1,103 @@ +#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 diff --git a/include/math.h b/include/math.h index ae84a731..f320b8e9 100644 --- a/include/math.h +++ b/include/math.h @@ -37,27 +37,53 @@ extern "C" { #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; @@ -316,17 +342,46 @@ long double truncl(long double); #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 diff --git a/include/tgmath.h b/include/tgmath.h new file mode 100644 index 00000000..52913913 --- /dev/null +++ b/include/tgmath.h @@ -0,0 +1,187 @@ +#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 diff --git a/src/complex/__cexp.c b/src/complex/__cexp.c new file mode 100644 index 00000000..f603e2be --- /dev/null +++ b/src/complex/__cexp.c @@ -0,0 +1,87 @@ +/* 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); +} diff --git a/src/complex/__cexpf.c b/src/complex/__cexpf.c new file mode 100644 index 00000000..47168e8f --- /dev/null +++ b/src/complex/__cexpf.c @@ -0,0 +1,68 @@ +/* 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); +} diff --git a/src/complex/cabs.c b/src/complex/cabs.c new file mode 100644 index 00000000..f61d364e --- /dev/null +++ b/src/complex/cabs.c @@ -0,0 +1,6 @@ +#include "libm.h" + +double cabs(double complex z) +{ + return hypot(creal(z), cimag(z)); +} diff --git a/src/complex/cabsf.c b/src/complex/cabsf.c new file mode 100644 index 00000000..30b25c70 --- /dev/null +++ b/src/complex/cabsf.c @@ -0,0 +1,6 @@ +#include "libm.h" + +float cabsf(float complex z) +{ + return hypotf(crealf(z), cimagf(z)); +} diff --git a/src/complex/cabsl.c b/src/complex/cabsl.c new file mode 100644 index 00000000..40a067c1 --- /dev/null +++ b/src/complex/cabsl.c @@ -0,0 +1,13 @@ +#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 diff --git a/src/complex/cacos.c b/src/complex/cacos.c new file mode 100644 index 00000000..3aca0519 --- /dev/null +++ b/src/complex/cacos.c @@ -0,0 +1,11 @@ +#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)); +} diff --git a/src/complex/cacosf.c b/src/complex/cacosf.c new file mode 100644 index 00000000..563766e7 --- /dev/null +++ b/src/complex/cacosf.c @@ -0,0 +1,9 @@ +#include "libm.h" + +// FIXME + +float complex cacosf(float complex z) +{ + z = casinf(z); + return cpackf((float)M_PI_2 - crealf(z), -cimagf(z)); +} diff --git a/src/complex/cacosh.c b/src/complex/cacosh.c new file mode 100644 index 00000000..c2dfc1ba --- /dev/null +++ b/src/complex/cacosh.c @@ -0,0 +1,9 @@ +#include "libm.h" + +/* acosh(z) = i acos(z) */ + +double complex cacosh(double complex z) +{ + z = cacos(z); + return cpack(-cimag(z), creal(z)); +} diff --git a/src/complex/cacoshf.c b/src/complex/cacoshf.c new file mode 100644 index 00000000..37ff8800 --- /dev/null +++ b/src/complex/cacoshf.c @@ -0,0 +1,7 @@ +#include "libm.h" + +float complex cacoshf(float complex z) +{ + z = cacosf(z); + return cpackf(-cimagf(z), crealf(z)); +} diff --git a/src/complex/cacoshl.c b/src/complex/cacoshl.c new file mode 100644 index 00000000..2a04e27b --- /dev/null +++ b/src/complex/cacoshl.c @@ -0,0 +1,14 @@ +#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 diff --git a/src/complex/cacosl.c b/src/complex/cacosl.c new file mode 100644 index 00000000..5992e056 --- /dev/null +++ b/src/complex/cacosl.c @@ -0,0 +1,16 @@ +#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 diff --git a/src/complex/carg.c b/src/complex/carg.c new file mode 100644 index 00000000..d2d1b462 --- /dev/null +++ b/src/complex/carg.c @@ -0,0 +1,6 @@ +#include "libm.h" + +double carg(double complex z) +{ + return atan2(cimag(z), creal(z)); +} diff --git a/src/complex/cargf.c b/src/complex/cargf.c new file mode 100644 index 00000000..ce183c4b --- /dev/null +++ b/src/complex/cargf.c @@ -0,0 +1,6 @@ +#include "libm.h" + +float cargf(float complex z) +{ + return atan2f(cimagf(z), crealf(z)); +} diff --git a/src/complex/cargl.c b/src/complex/cargl.c new file mode 100644 index 00000000..e0d50478 --- /dev/null +++ b/src/complex/cargl.c @@ -0,0 +1,13 @@ +#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 diff --git a/src/complex/casin.c b/src/complex/casin.c new file mode 100644 index 00000000..79aff278 --- /dev/null +++ b/src/complex/casin.c @@ -0,0 +1,16 @@ +#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)); +} diff --git a/src/complex/casinf.c b/src/complex/casinf.c new file mode 100644 index 00000000..cb9863f6 --- /dev/null +++ b/src/complex/casinf.c @@ -0,0 +1,14 @@ +#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)); +} diff --git a/src/complex/casinh.c b/src/complex/casinh.c new file mode 100644 index 00000000..f2b3fef8 --- /dev/null +++ b/src/complex/casinh.c @@ -0,0 +1,9 @@ +#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)); +} diff --git a/src/complex/casinhf.c b/src/complex/casinhf.c new file mode 100644 index 00000000..ed4af643 --- /dev/null +++ b/src/complex/casinhf.c @@ -0,0 +1,7 @@ +#include "libm.h" + +float complex casinhf(float complex z) +{ + z = casinf(cpackf(-cimagf(z), crealf(z))); + return cpackf(cimagf(z), -crealf(z)); +} diff --git a/src/complex/casinhl.c b/src/complex/casinhl.c new file mode 100644 index 00000000..e5d80cef --- /dev/null +++ b/src/complex/casinhl.c @@ -0,0 +1,14 @@ +#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 diff --git a/src/complex/casinl.c b/src/complex/casinl.c new file mode 100644 index 00000000..f9aa8ded --- /dev/null +++ b/src/complex/casinl.c @@ -0,0 +1,20 @@ +#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 diff --git a/src/complex/catan.c b/src/complex/catan.c new file mode 100644 index 00000000..39ce6cf2 --- /dev/null +++ b/src/complex/catan.c @@ -0,0 +1,119 @@ +/* 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; +} diff --git a/src/complex/catanf.c b/src/complex/catanf.c new file mode 100644 index 00000000..8533bde3 --- /dev/null +++ b/src/complex/catanf.c @@ -0,0 +1,115 @@ +/* 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; +} diff --git a/src/complex/catanh.c b/src/complex/catanh.c new file mode 100644 index 00000000..b1628022 --- /dev/null +++ b/src/complex/catanh.c @@ -0,0 +1,9 @@ +#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)); +} diff --git a/src/complex/catanhf.c b/src/complex/catanhf.c new file mode 100644 index 00000000..e1d1e648 --- /dev/null +++ b/src/complex/catanhf.c @@ -0,0 +1,7 @@ +#include "libm.h" + +float complex catanhf(float complex z) +{ + z = catanf(cpackf(-cimagf(z), crealf(z))); + return cpackf(cimagf(z), -crealf(z)); +} diff --git a/src/complex/catanhl.c b/src/complex/catanhl.c new file mode 100644 index 00000000..0a9374a3 --- /dev/null +++ b/src/complex/catanhl.c @@ -0,0 +1,14 @@ +#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 diff --git a/src/complex/catanl.c b/src/complex/catanl.c new file mode 100644 index 00000000..5ace7704 --- /dev/null +++ b/src/complex/catanl.c @@ -0,0 +1,126 @@ +/* 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 diff --git a/src/complex/ccos.c b/src/complex/ccos.c new file mode 100644 index 00000000..5754c238 --- /dev/null +++ b/src/complex/ccos.c @@ -0,0 +1,8 @@ +#include "libm.h" + +/* cos(z) = cosh(i z) */ + +double complex ccos(double complex z) +{ + return ccosh(cpack(-cimag(z), creal(z))); +} diff --git a/src/complex/ccosf.c b/src/complex/ccosf.c new file mode 100644 index 00000000..9b72c4f4 --- /dev/null +++ b/src/complex/ccosf.c @@ -0,0 +1,6 @@ +#include "libm.h" + +float complex ccosf(float complex z) +{ + return ccoshf(cpackf(-cimagf(z), crealf(z))); +} diff --git a/src/complex/ccosh.c b/src/complex/ccosh.c new file mode 100644 index 00000000..81f29432 --- /dev/null +++ b/src/complex/ccosh.c @@ -0,0 +1,140 @@ +/* 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)); +} diff --git a/src/complex/ccoshf.c b/src/complex/ccoshf.c new file mode 100644 index 00000000..683e77fa --- /dev/null +++ b/src/complex/ccoshf.c @@ -0,0 +1,90 @@ +/* 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)); +} diff --git a/src/complex/ccoshl.c b/src/complex/ccoshl.c new file mode 100644 index 00000000..9b2aed9e --- /dev/null +++ b/src/complex/ccoshl.c @@ -0,0 +1,7 @@ +#include "libm.h" + +//FIXME +long double complex ccoshl(long double complex z) +{ + return ccosh(z); +} diff --git a/src/complex/ccosl.c b/src/complex/ccosl.c new file mode 100644 index 00000000..e37825a9 --- /dev/null +++ b/src/complex/ccosl.c @@ -0,0 +1,13 @@ +#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 diff --git a/src/complex/cexp.c b/src/complex/cexp.c new file mode 100644 index 00000000..3b8bb752 --- /dev/null +++ b/src/complex/cexp.c @@ -0,0 +1,83 @@ +/* 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)); + } +} diff --git a/src/complex/cexpf.c b/src/complex/cexpf.c new file mode 100644 index 00000000..0cf13a3d --- /dev/null +++ b/src/complex/cexpf.c @@ -0,0 +1,83 @@ +/* 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)); + } +} diff --git a/src/complex/cexpl.c b/src/complex/cexpl.c new file mode 100644 index 00000000..a27f85c0 --- /dev/null +++ b/src/complex/cexpl.c @@ -0,0 +1,7 @@ +#include "libm.h" + +//FIXME +long double complex cexpl(long double complex z) +{ + return cexp(z); +} diff --git a/src/complex/cimag.c b/src/complex/cimag.c new file mode 100644 index 00000000..5e1ad46b --- /dev/null +++ b/src/complex/cimag.c @@ -0,0 +1,7 @@ +#include "libm.h" + +double (cimag)(double complex z) +{ + union dcomplex u = {z}; + return u.a[1]; +} diff --git a/src/complex/cimagf.c b/src/complex/cimagf.c new file mode 100644 index 00000000..99fffc58 --- /dev/null +++ b/src/complex/cimagf.c @@ -0,0 +1,7 @@ +#include "libm.h" + +float (cimagf)(float complex z) +{ + union fcomplex u = {z}; + return u.a[1]; +} diff --git a/src/complex/cimagl.c b/src/complex/cimagl.c new file mode 100644 index 00000000..d9a0780c --- /dev/null +++ b/src/complex/cimagl.c @@ -0,0 +1,7 @@ +#include "libm.h" + +long double (cimagl)(long double complex z) +{ + union lcomplex u = {z}; + return u.a[1]; +} diff --git a/src/complex/clog.c b/src/complex/clog.c new file mode 100644 index 00000000..6f10a115 --- /dev/null +++ b/src/complex/clog.c @@ -0,0 +1,14 @@ +#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); +} diff --git a/src/complex/clogf.c b/src/complex/clogf.c new file mode 100644 index 00000000..f3aec54d --- /dev/null +++ b/src/complex/clogf.c @@ -0,0 +1,12 @@ +#include "libm.h" + +// FIXME + +float complex clogf(float complex z) +{ + float r, phi; + + r = cabsf(z); + phi = cargf(z); + return cpackf(logf(r), phi); +} diff --git a/src/complex/clogl.c b/src/complex/clogl.c new file mode 100644 index 00000000..5b84ba59 --- /dev/null +++ b/src/complex/clogl.c @@ -0,0 +1,18 @@ +#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 diff --git a/src/complex/conj.c b/src/complex/conj.c new file mode 100644 index 00000000..4aceea7b --- /dev/null +++ b/src/complex/conj.c @@ -0,0 +1,6 @@ +#include "libm.h" + +double complex conj(double complex z) +{ + return cpack(creal(z), -cimag(z)); +} diff --git a/src/complex/conjf.c b/src/complex/conjf.c new file mode 100644 index 00000000..31556800 --- /dev/null +++ b/src/complex/conjf.c @@ -0,0 +1,6 @@ +#include "libm.h" + +float complex conjf(float complex z) +{ + return cpackf(crealf(z), -cimagf(z)); +} diff --git a/src/complex/conjl.c b/src/complex/conjl.c new file mode 100644 index 00000000..01332262 --- /dev/null +++ b/src/complex/conjl.c @@ -0,0 +1,6 @@ +#include "libm.h" + +long double complex conjl(long double complex z) +{ + return cpackl(creall(z), -cimagl(z)); +} diff --git a/src/complex/cpow.c b/src/complex/cpow.c new file mode 100644 index 00000000..f863588f --- /dev/null +++ b/src/complex/cpow.c @@ -0,0 +1,8 @@ +#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)); +} diff --git a/src/complex/cpowf.c b/src/complex/cpowf.c new file mode 100644 index 00000000..53c65dcb --- /dev/null +++ b/src/complex/cpowf.c @@ -0,0 +1,6 @@ +#include "libm.h" + +float complex cpowf(float complex z, float complex c) +{ + return cexpf(c * clogf(z)); +} diff --git a/src/complex/cpowl.c b/src/complex/cpowl.c new file mode 100644 index 00000000..c1a80a7b --- /dev/null +++ b/src/complex/cpowl.c @@ -0,0 +1,13 @@ +#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 diff --git a/src/complex/cproj.c b/src/complex/cproj.c new file mode 100644 index 00000000..1cf9bb94 --- /dev/null +++ b/src/complex/cproj.c @@ -0,0 +1,8 @@ +#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; +} diff --git a/src/complex/cprojf.c b/src/complex/cprojf.c new file mode 100644 index 00000000..71129743 --- /dev/null +++ b/src/complex/cprojf.c @@ -0,0 +1,8 @@ +#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; +} diff --git a/src/complex/cprojl.c b/src/complex/cprojl.c new file mode 100644 index 00000000..72e50cf5 --- /dev/null +++ b/src/complex/cprojl.c @@ -0,0 +1,15 @@ +#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 diff --git a/src/complex/creal.c b/src/complex/creal.c new file mode 100644 index 00000000..2bb91812 --- /dev/null +++ b/src/complex/creal.c @@ -0,0 +1,6 @@ +#include <complex.h> + +double creal(double complex z) +{ + return z; +} diff --git a/src/complex/crealf.c b/src/complex/crealf.c new file mode 100644 index 00000000..078232f0 --- /dev/null +++ b/src/complex/crealf.c @@ -0,0 +1,6 @@ +#include <complex.h> + +float crealf(float complex z) +{ + return z; +} diff --git a/src/complex/creall.c b/src/complex/creall.c new file mode 100644 index 00000000..56e64097 --- /dev/null +++ b/src/complex/creall.c @@ -0,0 +1,6 @@ +#include <complex.h> + +long double creall(long double complex z) +{ + return z; +} diff --git a/src/complex/csin.c b/src/complex/csin.c new file mode 100644 index 00000000..246a4595 --- /dev/null +++ b/src/complex/csin.c @@ -0,0 +1,9 @@ +#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)); +} diff --git a/src/complex/csinf.c b/src/complex/csinf.c new file mode 100644 index 00000000..3aabe8f8 --- /dev/null +++ b/src/complex/csinf.c @@ -0,0 +1,7 @@ +#include "libm.h" + +float complex csinf(float complex z) +{ + z = csinhf(cpackf(-cimagf(z), crealf(z))); + return cpackf(cimagf(z), -crealf(z)); +} diff --git a/src/complex/csinh.c b/src/complex/csinh.c new file mode 100644 index 00000000..fe16f06b --- /dev/null +++ b/src/complex/csinh.c @@ -0,0 +1,141 @@ +/* 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)); +} diff --git a/src/complex/csinhf.c b/src/complex/csinhf.c new file mode 100644 index 00000000..bbb116c2 --- /dev/null +++ b/src/complex/csinhf.c @@ -0,0 +1,90 @@ +/* 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)); +} diff --git a/src/complex/csinhl.c b/src/complex/csinhl.c new file mode 100644 index 00000000..c566653b --- /dev/null +++ b/src/complex/csinhl.c @@ -0,0 +1,7 @@ +#include "libm.h" + +//FIXME +long double complex csinhl(long double complex z) +{ + return csinh(z); +} diff --git a/src/complex/csinl.c b/src/complex/csinl.c new file mode 100644 index 00000000..4ad86745 --- /dev/null +++ b/src/complex/csinl.c @@ -0,0 +1,14 @@ +#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 diff --git a/src/complex/csqrt.c b/src/complex/csqrt.c new file mode 100644 index 00000000..21fb879d --- /dev/null +++ b/src/complex/csqrt.c @@ -0,0 +1,100 @@ +/* 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; +} diff --git a/src/complex/csqrtf.c b/src/complex/csqrtf.c new file mode 100644 index 00000000..16487c23 --- /dev/null +++ b/src/complex/csqrtf.c @@ -0,0 +1,82 @@ +/* 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)); + } +} diff --git a/src/complex/csqrtl.c b/src/complex/csqrtl.c new file mode 100644 index 00000000..0600ef3b --- /dev/null +++ b/src/complex/csqrtl.c @@ -0,0 +1,7 @@ +#include "libm.h" + +//FIXME +long double complex csqrtl(long double complex z) +{ + return csqrt(z); +} diff --git a/src/complex/ctan.c b/src/complex/ctan.c new file mode 100644 index 00000000..4741a4df --- /dev/null +++ b/src/complex/ctan.c @@ -0,0 +1,9 @@ +#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)); +} diff --git a/src/complex/ctanf.c b/src/complex/ctanf.c new file mode 100644 index 00000000..9bbeb051 --- /dev/null +++ b/src/complex/ctanf.c @@ -0,0 +1,7 @@ +#include "libm.h" + +float complex ctanf(float complex z) +{ + z = ctanhf(cpackf(-cimagf(z), crealf(z))); + return cpackf(cimagf(z), -crealf(z)); +} diff --git a/src/complex/ctanh.c b/src/complex/ctanh.c new file mode 100644 index 00000000..dd569fc3 --- /dev/null +++ b/src/complex/ctanh.c @@ -0,0 +1,127 @@ +/* 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); +} diff --git a/src/complex/ctanhf.c b/src/complex/ctanhf.c new file mode 100644 index 00000000..7d746134 --- /dev/null +++ b/src/complex/ctanhf.c @@ -0,0 +1,66 @@ +/* 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); +} diff --git a/src/complex/ctanhl.c b/src/complex/ctanhl.c new file mode 100644 index 00000000..89a75d13 --- /dev/null +++ b/src/complex/ctanhl.c @@ -0,0 +1,7 @@ +#include "libm.h" + +//FIXME +long double complex ctanhl(long double complex z) +{ + return ctanh(z); +} diff --git a/src/complex/ctanl.c b/src/complex/ctanl.c new file mode 100644 index 00000000..4b4c99b6 --- /dev/null +++ b/src/complex/ctanl.c @@ -0,0 +1,14 @@ +#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 diff --git a/src/internal/libm.h b/src/internal/libm.h new file mode 100644 index 00000000..021c4e2a --- /dev/null +++ b/src/internal/libm.h @@ -0,0 +1,186 @@ +/* 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 diff --git a/src/internal/longdbl.h b/src/internal/longdbl.h new file mode 100644 index 00000000..25ec8021 --- /dev/null +++ b/src/internal/longdbl.h @@ -0,0 +1,137 @@ +#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 diff --git a/src/math/k_cos.c b/src/math/__cos.c index 22e9841e..ba439857 100644 --- a/src/math/k_cos.c +++ b/src/math/__cos.c @@ -1,21 +1,19 @@ - -/* @(#)k_cos.c 1.3 95/01/18 */ +/* 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 + * software is freely granted, provided that this notice * is preserved. * ==================================================== */ - /* - * __kernel_cos( x, y ) + * __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. + * Input y is the tail of x. * * Algorithm * 1. Since cos(-x) = cos(x), we need only to consider positive x. @@ -25,29 +23,32 @@ * 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 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) ~ 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. + * 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 <math.h> -#include "math_private.h" +#include "libm.h" static const double one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ @@ -58,28 +59,14 @@ 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 __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)); - } + 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)); } diff --git a/src/math/__cosdf.c b/src/math/__cosdf.c new file mode 100644 index 00000000..a3b399e6 --- /dev/null +++ b/src/math/__cosdf.c @@ -0,0 +1,36 @@ +/* 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; +} diff --git a/src/math/__cosl.c b/src/math/__cosl.c new file mode 100644 index 00000000..9ea51ecf --- /dev/null +++ b/src/math/__cosl.c @@ -0,0 +1,76 @@ +/* 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 diff --git a/src/math/__expo2.c b/src/math/__expo2.c new file mode 100644 index 00000000..ef14e5f5 --- /dev/null +++ b/src/math/__expo2.c @@ -0,0 +1,51 @@ +/* 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; +} diff --git a/src/math/__expo2f.c b/src/math/__expo2f.c new file mode 100644 index 00000000..192838f7 --- /dev/null +++ b/src/math/__expo2f.c @@ -0,0 +1,51 @@ +/* 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; +} diff --git a/src/math/__fpclassify.c b/src/math/__fpclassify.c index 16051100..c9dd0275 100644 --- a/src/math/__fpclassify.c +++ b/src/math/__fpclassify.c @@ -1,14 +1,10 @@ -#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; } diff --git a/src/math/__fpclassifyf.c b/src/math/__fpclassifyf.c index bf59d0d4..8149087b 100644 --- a/src/math/__fpclassifyf.c +++ b/src/math/__fpclassifyf.c @@ -1,14 +1,10 @@ -#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; } diff --git a/src/math/__fpclassifyl.c b/src/math/__fpclassifyl.c index a4e354ce..a5ad36f2 100644 --- a/src/math/__fpclassifyl.c +++ b/src/math/__fpclassifyl.c @@ -1,16 +1,27 @@ -#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 diff --git a/src/math/__invtrigl.c b/src/math/__invtrigl.c new file mode 100644 index 00000000..a821842c --- /dev/null +++ b/src/math/__invtrigl.c @@ -0,0 +1,82 @@ +/* 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 diff --git a/src/math/__invtrigl.h b/src/math/__invtrigl.h new file mode 100644 index 00000000..c3ad3c49 --- /dev/null +++ b/src/math/__invtrigl.h @@ -0,0 +1,109 @@ +/* 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 diff --git a/src/math/__log1p.h b/src/math/__log1p.h new file mode 100644 index 00000000..ec2c77b9 --- /dev/null +++ b/src/math/__log1p.h @@ -0,0 +1,94 @@ +/* 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); +} diff --git a/src/math/__log1pf.h b/src/math/__log1pf.h new file mode 100644 index 00000000..110acecb --- /dev/null +++ b/src/math/__log1pf.h @@ -0,0 +1,35 @@ +/* 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); +} diff --git a/src/math/__polevll.c b/src/math/__polevll.c new file mode 100644 index 00000000..08e68d40 --- /dev/null +++ b/src/math/__polevll.c @@ -0,0 +1,90 @@ +/* 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; +} diff --git a/src/math/__rem_pio2.c b/src/math/__rem_pio2.c new file mode 100644 index 00000000..a7d779e0 --- /dev/null +++ b/src/math/__rem_pio2.c @@ -0,0 +1,176 @@ +/* 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; +} diff --git a/src/math/__rem_pio2_large.c b/src/math/__rem_pio2_large.c new file mode 100644 index 00000000..35835f83 --- /dev/null +++ b/src/math/__rem_pio2_large.c @@ -0,0 +1,447 @@ +/* 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; +} diff --git a/src/math/__rem_pio2f.c b/src/math/__rem_pio2f.c new file mode 100644 index 00000000..965dc46a --- /dev/null +++ b/src/math/__rem_pio2f.c @@ -0,0 +1,78 @@ +/* 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; +} diff --git a/src/math/__rem_pio2l.h b/src/math/__rem_pio2l.h new file mode 100644 index 00000000..37f3bd28 --- /dev/null +++ b/src/math/__rem_pio2l.h @@ -0,0 +1,150 @@ +/* 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 diff --git a/src/math/__signbit.c b/src/math/__signbit.c new file mode 100644 index 00000000..ffe717ce --- /dev/null +++ b/src/math/__signbit.c @@ -0,0 +1,13 @@ +#include "libm.h" + +// FIXME: macro +int __signbit(double x) +{ + union { + double d; + uint64_t i; + } y = { x }; + return y.i>>63; +} + + diff --git a/src/math/__signbitf.c b/src/math/__signbitf.c new file mode 100644 index 00000000..ff3e81ff --- /dev/null +++ b/src/math/__signbitf.c @@ -0,0 +1,11 @@ +#include "libm.h" + +// FIXME +int __signbitf(float x) +{ + union { + float f; + uint32_t i; + } y = { x }; + return y.i>>31; +} diff --git a/src/math/__signbitl.c b/src/math/__signbitl.c new file mode 100644 index 00000000..81adb6ce --- /dev/null +++ b/src/math/__signbitl.c @@ -0,0 +1,11 @@ +#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 diff --git a/src/math/k_sin.c b/src/math/__sin.c index 9def2589..80f3273c 100644 --- a/src/math/k_sin.c +++ b/src/math/__sin.c @@ -1,49 +1,48 @@ - -/* @(#)k_sin.c 1.3 95/01/18 */ +/* 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 + * 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 +/* __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). + * 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. + * 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 | - * + * | x | + * * 4. sin(x+y) = sin(x) + sin'(x')*y * ~ sin(x) + (1-x*x/2)*y - * For better accuracy, let + * 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" +#include "libm.h" static const double -half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ +half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */ S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */ S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */ @@ -51,18 +50,16 @@ 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 __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); + 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); } diff --git a/src/math/__sindf.c b/src/math/__sindf.c new file mode 100644 index 00000000..83c0d7a5 --- /dev/null +++ b/src/math/__sindf.c @@ -0,0 +1,36 @@ +/* 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; +} diff --git a/src/math/__sinl.c b/src/math/__sinl.c new file mode 100644 index 00000000..71851d81 --- /dev/null +++ b/src/math/__sinl.c @@ -0,0 +1,61 @@ +/* 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 diff --git a/src/math/__tan.c b/src/math/__tan.c new file mode 100644 index 00000000..f1be2ec8 --- /dev/null +++ b/src/math/__tan.c @@ -0,0 +1,122 @@ +/* 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); + } +} diff --git a/src/math/__tandf.c b/src/math/__tandf.c new file mode 100644 index 00000000..36a8214e --- /dev/null +++ b/src/math/__tandf.c @@ -0,0 +1,55 @@ +/* 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; +} diff --git a/src/math/__tanl.c b/src/math/__tanl.c new file mode 100644 index 00000000..f842543e --- /dev/null +++ b/src/math/__tanl.c @@ -0,0 +1,118 @@ +/* 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 diff --git a/src/math/acos.c b/src/math/acos.c new file mode 100644 index 00000000..b97100e8 --- /dev/null +++ b/src/math/acos.c @@ -0,0 +1,101 @@ +/* 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); + } +} diff --git a/src/math/acosf.c b/src/math/acosf.c new file mode 100644 index 00000000..dd3bba29 --- /dev/null +++ b/src/math/acosf.c @@ -0,0 +1,75 @@ +/* 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); + } +} diff --git a/src/math/acosh.c b/src/math/acosh.c new file mode 100644 index 00000000..a7c87e3c --- /dev/null +++ b/src/math/acosh.c @@ -0,0 +1,55 @@ +/* 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)); + } +} diff --git a/src/math/acoshf.c b/src/math/acoshf.c new file mode 100644 index 00000000..30a3a943 --- /dev/null +++ b/src/math/acoshf.c @@ -0,0 +1,43 @@ +/* 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)); + } +} diff --git a/src/math/acoshl.c b/src/math/acoshl.c new file mode 100644 index 00000000..d8310a73 --- /dev/null +++ b/src/math/acoshl.c @@ -0,0 +1,60 @@ +/* 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 diff --git a/src/math/acosl.c b/src/math/acosl.c new file mode 100644 index 00000000..21e6c95e --- /dev/null +++ b/src/math/acosl.c @@ -0,0 +1,91 @@ +/* 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 diff --git a/src/math/e_asin.c b/src/math/asin.c index 4bf162a1..04bd0c14 100644 --- a/src/math/e_asin.c +++ b/src/math/asin.c @@ -1,23 +1,21 @@ - -/* @(#)e_asin.c 1.3 95/01/18 */ +/* 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 + * software is freely granted, provided that this notice * is preserved. * ==================================================== */ - /* asin(x) - * Method : + * 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 + * 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) * @@ -41,17 +39,15 @@ * */ - -#include <math.h> -#include "math_private.h" +#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 */ - /* coefficient for R(x^2) */ +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 */ @@ -63,47 +59,51 @@ qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */ qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */ qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */ -double -asin(double x) +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; + 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; } diff --git a/src/math/asinf.c b/src/math/asinf.c new file mode 100644 index 00000000..729dd37f --- /dev/null +++ b/src/math/asinf.c @@ -0,0 +1,64 @@ +/* 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; +} diff --git a/src/math/asinh.c b/src/math/asinh.c new file mode 100644 index 00000000..92aa9446 --- /dev/null +++ b/src/math/asinh.c @@ -0,0 +1,56 @@ +/* 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; +} diff --git a/src/math/asinhf.c b/src/math/asinhf.c new file mode 100644 index 00000000..5f4bb39c --- /dev/null +++ b/src/math/asinhf.c @@ -0,0 +1,49 @@ +/* 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; +} diff --git a/src/math/asinhl.c b/src/math/asinhl.c new file mode 100644 index 00000000..b2edf904 --- /dev/null +++ b/src/math/asinhl.c @@ -0,0 +1,63 @@ +/* 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 diff --git a/src/math/asinl.c b/src/math/asinl.c new file mode 100644 index 00000000..370997bc --- /dev/null +++ b/src/math/asinl.c @@ -0,0 +1,80 @@ +/* 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 diff --git a/src/math/s_atan.c b/src/math/atan.c index 1faac024..d31782c2 100644 --- a/src/math/s_atan.c +++ b/src/math/atan.c @@ -1,4 +1,4 @@ -/* @(#)s_atan.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_atan.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,7 +9,6 @@ * is preserved. * ==================================================== */ - /* atan(x) * Method * 1. Reduce x to positive by atan(x) = -atan(-x). @@ -30,8 +29,8 @@ * to produce the hexadecimal values shown. */ -#include <math.h> -#include "math_private.h" + +#include "libm.h" static const double atanhi[] = { 4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */ @@ -61,55 +60,64 @@ static const double aT[] = { 1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */ }; - static const double -one = 1.0, -huge = 1.0e300; +static const double +one = 1.0, +huge = 1.0e300; -double -atan(double x) +double atan(double x) { - double w,s1,s2,z; - int32_t ix,hx,id; + 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_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; - } + 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; } diff --git a/src/math/atan2.c b/src/math/atan2.c new file mode 100644 index 00000000..3c35fbf0 --- /dev/null +++ b/src/math/atan2.c @@ -0,0 +1,119 @@ +/* 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(-,-) */ + } +} diff --git a/src/math/atan2f.c b/src/math/atan2f.c new file mode 100644 index 00000000..4d78840b --- /dev/null +++ b/src/math/atan2f.c @@ -0,0 +1,93 @@ +/* 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(-,-) */ + } +} diff --git a/src/math/atan2l.c b/src/math/atan2l.c new file mode 100644 index 00000000..64ec12e7 --- /dev/null +++ b/src/math/atan2l.c @@ -0,0 +1,114 @@ +/* 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 diff --git a/src/math/atanf.c b/src/math/atanf.c new file mode 100644 index 00000000..8c2b46b0 --- /dev/null +++ b/src/math/atanf.c @@ -0,0 +1,97 @@ +/* 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; +} diff --git a/src/math/e_atanh.c b/src/math/atanh.c index 45f1c966..29290463 100644 --- a/src/math/e_atanh.c +++ b/src/math/atanh.c @@ -1,17 +1,15 @@ - -/* @(#)e_atanh.c 1.3 95/01/18 */ +/* 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 + * software is freely granted, provided that this notice * is preserved. * ==================================================== * */ - /* atanh(x) * Method : * 1.Reduced x to positive by atanh(-x) = -atanh(x) @@ -19,7 +17,7 @@ * 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)) * @@ -30,30 +28,32 @@ * */ -#include <math.h> -#include "math_private.h" +#include "libm.h" static const double one = 1.0, huge = 1e300; static const double zero = 0.0; -double -atanh(double x) +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; + 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; } diff --git a/src/math/atanhf.c b/src/math/atanhf.c new file mode 100644 index 00000000..2efbd79c --- /dev/null +++ b/src/math/atanhf.c @@ -0,0 +1,43 @@ +/* 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; +} diff --git a/src/math/atanhl.c b/src/math/atanhl.c new file mode 100644 index 00000000..af0f856d --- /dev/null +++ b/src/math/atanhl.c @@ -0,0 +1,64 @@ +/* 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 diff --git a/src/math/atanl.c b/src/math/atanl.c new file mode 100644 index 00000000..4e99955e --- /dev/null +++ b/src/math/atanl.c @@ -0,0 +1,91 @@ +/* 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 diff --git a/src/math/cbrt.c b/src/math/cbrt.c new file mode 100644 index 00000000..f4253428 --- /dev/null +++ b/src/math/cbrt.c @@ -0,0 +1,105 @@ +/* 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; +} diff --git a/src/math/cbrtf.c b/src/math/cbrtf.c new file mode 100644 index 00000000..4a984b10 --- /dev/null +++ b/src/math/cbrtf.c @@ -0,0 +1,69 @@ +/* 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; +} diff --git a/src/math/cbrtl.c b/src/math/cbrtl.c new file mode 100644 index 00000000..d138b9f2 --- /dev/null +++ b/src/math/cbrtl.c @@ -0,0 +1,157 @@ +/* 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 diff --git a/src/math/ceil.c b/src/math/ceil.c new file mode 100644 index 00000000..c2ab4a54 --- /dev/null +++ b/src/math/ceil.c @@ -0,0 +1,83 @@ +/* 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; +} diff --git a/src/math/ceilf.c b/src/math/ceilf.c new file mode 100644 index 00000000..d83066a5 --- /dev/null +++ b/src/math/ceilf.c @@ -0,0 +1,55 @@ +/* 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; +} diff --git a/src/math/ceill.c b/src/math/ceill.c new file mode 100644 index 00000000..b938cc7f --- /dev/null +++ b/src/math/ceill.c @@ -0,0 +1,103 @@ +/* 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 diff --git a/src/math/copysign.c b/src/math/copysign.c new file mode 100644 index 00000000..038b8b4c --- /dev/null +++ b/src/math/copysign.c @@ -0,0 +1,11 @@ +#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; +} diff --git a/src/math/copysignf.c b/src/math/copysignf.c new file mode 100644 index 00000000..47ab37e4 --- /dev/null +++ b/src/math/copysignf.c @@ -0,0 +1,11 @@ +#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; +} diff --git a/src/math/copysignl.c b/src/math/copysignl.c new file mode 100644 index 00000000..72a21488 --- /dev/null +++ b/src/math/copysignl.c @@ -0,0 +1,16 @@ +#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 diff --git a/src/math/s_cos.c b/src/math/cos.c index 1893ab13..76990e7f 100644 --- a/src/math/s_cos.c +++ b/src/math/cos.c @@ -1,4 +1,4 @@ -/* @(#)s_cos.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_cos.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,14 +9,13 @@ * 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 + * __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 @@ -41,34 +40,36 @@ * TRIG(x) returns trig(x) nearly rounded */ -#include <math.h> -#include "math_private.h" +#include "libm.h" -double -cos(double x) +double cos(double x) { - double y[2],z=0.0; - int32_t n, ix; + double y[2],z=0.0; + int32_t n, ix; - /* High word of x. */ - GET_HIGH_WORD(ix,x); + GET_HIGH_WORD(ix, x); - /* |x| ~< pi/4 */ - ix &= 0x7fffffff; - if(ix <= 0x3fe921fb) return __kernel_cos(x,z); + /* |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 */ - else if (ix>=0x7ff00000) return x-x; + /* cos(Inf or NaN) is NaN */ + 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); - } - } + /* 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); + } } diff --git a/src/math/cosf.c b/src/math/cosf.c new file mode 100644 index 00000000..4d94130f --- /dev/null +++ b/src/math/cosf.c @@ -0,0 +1,73 @@ +/* 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); + } +} diff --git a/src/math/cosh.c b/src/math/cosh.c new file mode 100644 index 00000000..5f38b276 --- /dev/null +++ b/src/math/cosh.c @@ -0,0 +1,74 @@ +/* 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; +} diff --git a/src/math/coshf.c b/src/math/coshf.c new file mode 100644 index 00000000..9e87afcd --- /dev/null +++ b/src/math/coshf.c @@ -0,0 +1,57 @@ +/* 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; +} diff --git a/src/math/coshl.c b/src/math/coshl.c new file mode 100644 index 00000000..bcc9128a --- /dev/null +++ b/src/math/coshl.c @@ -0,0 +1,86 @@ +/* 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 diff --git a/src/math/cosl.c b/src/math/cosl.c new file mode 100644 index 00000000..2c650cdc --- /dev/null +++ b/src/math/cosl.c @@ -0,0 +1,83 @@ +/* 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 diff --git a/src/math/e_acos.c b/src/math/e_acos.c deleted file mode 100644 index e0236391..00000000 --- a/src/math/e_acos.c +++ /dev/null @@ -1,99 +0,0 @@ -/* @(#)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); - } -} diff --git a/src/math/e_acosf.c b/src/math/e_acosf.c deleted file mode 100644 index 4c59781b..00000000 --- a/src/math/e_acosf.c +++ /dev/null @@ -1,77 +0,0 @@ -/* 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); - } -} diff --git a/src/math/e_acosh.c b/src/math/e_acosh.c deleted file mode 100644 index 8b454e75..00000000 --- a/src/math/e_acosh.c +++ /dev/null @@ -1,59 +0,0 @@ - -/* @(#)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)); - } -} diff --git a/src/math/e_acoshf.c b/src/math/e_acoshf.c deleted file mode 100644 index b7f1df69..00000000 --- a/src/math/e_acoshf.c +++ /dev/null @@ -1,45 +0,0 @@ -/* 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)); - } -} diff --git a/src/math/e_asinf.c b/src/math/e_asinf.c deleted file mode 100644 index 9c693970..00000000 --- a/src/math/e_asinf.c +++ /dev/null @@ -1,80 +0,0 @@ -/* 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; -} diff --git a/src/math/e_atan2.c b/src/math/e_atan2.c deleted file mode 100644 index dd021164..00000000 --- a/src/math/e_atan2.c +++ /dev/null @@ -1,120 +0,0 @@ - -/* @(#)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(-,-) */ - } -} diff --git a/src/math/e_atan2f.c b/src/math/e_atan2f.c deleted file mode 100644 index 535e10a0..00000000 --- a/src/math/e_atan2f.c +++ /dev/null @@ -1,93 +0,0 @@ -/* 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(-,-) */ - } -} diff --git a/src/math/e_atanhf.c b/src/math/e_atanhf.c deleted file mode 100644 index 7356cfc9..00000000 --- a/src/math/e_atanhf.c +++ /dev/null @@ -1,42 +0,0 @@ -/* 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; -} diff --git a/src/math/e_cosh.c b/src/math/e_cosh.c deleted file mode 100644 index ad425bd3..00000000 --- a/src/math/e_cosh.c +++ /dev/null @@ -1,82 +0,0 @@ - -/* @(#)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; -} diff --git a/src/math/e_coshf.c b/src/math/e_coshf.c deleted file mode 100644 index 6db10885..00000000 --- a/src/math/e_coshf.c +++ /dev/null @@ -1,59 +0,0 @@ -/* 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; -} diff --git a/src/math/e_exp.c b/src/math/e_exp.c deleted file mode 100644 index 66107b95..00000000 --- a/src/math/e_exp.c +++ /dev/null @@ -1,155 +0,0 @@ - -/* @(#)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; - } -} diff --git a/src/math/e_expf.c b/src/math/e_expf.c deleted file mode 100644 index 99818edc..00000000 --- a/src/math/e_expf.c +++ /dev/null @@ -1,91 +0,0 @@ -/* 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; - } -} diff --git a/src/math/e_fmod.c b/src/math/e_fmod.c deleted file mode 100644 index 99afe489..00000000 --- a/src/math/e_fmod.c +++ /dev/null @@ -1,129 +0,0 @@ - -/* @(#)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 */ -} diff --git a/src/math/e_fmodf.c b/src/math/e_fmodf.c deleted file mode 100644 index fe86cb04..00000000 --- a/src/math/e_fmodf.c +++ /dev/null @@ -1,101 +0,0 @@ -/* 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 */ -} diff --git a/src/math/e_hypot.c b/src/math/e_hypot.c deleted file mode 100644 index e925adc3..00000000 --- a/src/math/e_hypot.c +++ /dev/null @@ -1,121 +0,0 @@ - -/* @(#)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; -} diff --git a/src/math/e_hypotf.c b/src/math/e_hypotf.c deleted file mode 100644 index 13773554..00000000 --- a/src/math/e_hypotf.c +++ /dev/null @@ -1,79 +0,0 @@ -/* 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; -} diff --git a/src/math/e_log.c b/src/math/e_log.c deleted file mode 100644 index 9eb0e444..00000000 --- a/src/math/e_log.c +++ /dev/null @@ -1,131 +0,0 @@ - -/* @(#)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); - } -} diff --git a/src/math/e_log10.c b/src/math/e_log10.c deleted file mode 100644 index 3be179f7..00000000 --- a/src/math/e_log10.c +++ /dev/null @@ -1,83 +0,0 @@ - -/* @(#)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; -} diff --git a/src/math/e_log10f.c b/src/math/e_log10f.c deleted file mode 100644 index 8fc5c5ca..00000000 --- a/src/math/e_log10f.c +++ /dev/null @@ -1,51 +0,0 @@ -/* 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; -} diff --git a/src/math/e_logf.c b/src/math/e_logf.c deleted file mode 100644 index 46a8b8ce..00000000 --- a/src/math/e_logf.c +++ /dev/null @@ -1,81 +0,0 @@ -/* 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); - } -} diff --git a/src/math/e_pow.c b/src/math/e_pow.c deleted file mode 100644 index aad24287..00000000 --- a/src/math/e_pow.c +++ /dev/null @@ -1,300 +0,0 @@ -/* @(#)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; -} diff --git a/src/math/e_powf.c b/src/math/e_powf.c deleted file mode 100644 index ae61c246..00000000 --- a/src/math/e_powf.c +++ /dev/null @@ -1,243 +0,0 @@ -/* 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; -} diff --git a/src/math/e_rem_pio2.c b/src/math/e_rem_pio2.c deleted file mode 100644 index 9eee36ae..00000000 --- a/src/math/e_rem_pio2.c +++ /dev/null @@ -1,163 +0,0 @@ - -/* @(#)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; -} diff --git a/src/math/e_rem_pio2f.c b/src/math/e_rem_pio2f.c deleted file mode 100644 index 4992ea0c..00000000 --- a/src/math/e_rem_pio2f.c +++ /dev/null @@ -1,175 +0,0 @@ -/* 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; -} diff --git a/src/math/e_remainder.c b/src/math/e_remainder.c deleted file mode 100644 index 9cb56919..00000000 --- a/src/math/e_remainder.c +++ /dev/null @@ -1,69 +0,0 @@ - -/* @(#)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; -} diff --git a/src/math/e_remainderf.c b/src/math/e_remainderf.c deleted file mode 100644 index c292367d..00000000 --- a/src/math/e_remainderf.c +++ /dev/null @@ -1,61 +0,0 @@ -/* 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; -} diff --git a/src/math/e_scalb.c b/src/math/e_scalb.c deleted file mode 100644 index cee2b44f..00000000 --- a/src/math/e_scalb.c +++ /dev/null @@ -1,35 +0,0 @@ - -/* @(#)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); -} diff --git a/src/math/e_scalbf.c b/src/math/e_scalbf.c deleted file mode 100644 index de7d7f67..00000000 --- a/src/math/e_scalbf.c +++ /dev/null @@ -1,31 +0,0 @@ -/* 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); -} diff --git a/src/math/e_sinh.c b/src/math/e_sinh.c deleted file mode 100644 index 3a574274..00000000 --- a/src/math/e_sinh.c +++ /dev/null @@ -1,75 +0,0 @@ - -/* @(#)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; -} diff --git a/src/math/e_sinhf.c b/src/math/e_sinhf.c deleted file mode 100644 index fe60608a..00000000 --- a/src/math/e_sinhf.c +++ /dev/null @@ -1,56 +0,0 @@ -/* 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; -} diff --git a/src/math/e_sqrt.c b/src/math/e_sqrt.c deleted file mode 100644 index 2bc68747..00000000 --- a/src/math/e_sqrt.c +++ /dev/null @@ -1,442 +0,0 @@ - -/* @(#)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). - - */ - diff --git a/src/math/e_sqrtf.c b/src/math/e_sqrtf.c deleted file mode 100644 index 03a15beb..00000000 --- a/src/math/e_sqrtf.c +++ /dev/null @@ -1,85 +0,0 @@ -/* 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; -} diff --git a/src/math/s_erf.c b/src/math/erf.c index e321feea..18ee01cf 100644 --- a/src/math/s_erf.c +++ b/src/math/erf.c @@ -1,4 +1,4 @@ -/* @(#)s_erf.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_erf.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,7 +9,6 @@ * is preserved. * ==================================================== */ - /* double erf(double x) * double erfc(double x) * x @@ -104,22 +103,20 @@ * erfc/erf(NaN) is NaN */ - -#include <math.h> -#include "math_private.h" +#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 */ +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 */ +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 */ @@ -183,116 +180,127 @@ sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */ sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */ sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */ -double -erf(double x) +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 */ - } + int32_t hx,ix,i; + double R,S,P,Q,s,y,z,r; - 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; + 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) +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; - } + int32_t hx,ix; + double R,S,P,Q,s,y,z,r; - 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; - } + 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; } diff --git a/src/math/erff.c b/src/math/erff.c new file mode 100644 index 00000000..e4e353d7 --- /dev/null +++ b/src/math/erff.c @@ -0,0 +1,217 @@ +/* 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; +} diff --git a/src/math/erfl.c b/src/math/erfl.c new file mode 100644 index 00000000..c38d7450 --- /dev/null +++ b/src/math/erfl.c @@ -0,0 +1,390 @@ +/* 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 diff --git a/src/math/exp.c b/src/math/exp.c new file mode 100644 index 00000000..c1c9a63c --- /dev/null +++ b/src/math/exp.c @@ -0,0 +1,157 @@ +/* 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; +} diff --git a/src/math/exp2.c b/src/math/exp2.c new file mode 100644 index 00000000..bf7421ee --- /dev/null +++ b/src/math/exp2.c @@ -0,0 +1,384 @@ +/* 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; +} diff --git a/src/math/exp2f.c b/src/math/exp2f.c new file mode 100644 index 00000000..211d1875 --- /dev/null +++ b/src/math/exp2f.c @@ -0,0 +1,130 @@ +/* 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; +} diff --git a/src/math/exp2l.c b/src/math/exp2l.c new file mode 100644 index 00000000..ce085a73 --- /dev/null +++ b/src/math/exp2l.c @@ -0,0 +1,277 @@ +/* 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 diff --git a/src/math/expf.c b/src/math/expf.c new file mode 100644 index 00000000..a0eaa7a7 --- /dev/null +++ b/src/math/expf.c @@ -0,0 +1,95 @@ +/* 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; +} diff --git a/src/math/expl.c b/src/math/expl.c new file mode 100644 index 00000000..898cf1a5 --- /dev/null +++ b/src/math/expl.c @@ -0,0 +1,127 @@ +/* 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 diff --git a/src/math/s_expm1.c b/src/math/expm1.c index 6f1f6675..ffa82264 100644 --- a/src/math/s_expm1.c +++ b/src/math/expm1.c @@ -1,4 +1,4 @@ -/* @(#)s_expm1.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_expm1.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,7 +9,6 @@ * is preserved. * ==================================================== */ - /* expm1(x) * Returns exp(x)-1, the exponential of x minus 1. * @@ -42,7 +41,7 @@ * 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) + * z = r*r, * with error bounded by * | 5 | -61 * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2 @@ -105,113 +104,117 @@ * to produce the hexadecimal values shown. */ -#include <math.h> -#include "math_private.h" +#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 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 */ +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 expm1(double x) { - double y,hi,lo,c=0.0,t,e,hxs,hfx,r1; - int32_t k,xsb; - uint32_t hx; + 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| */ - 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; - /* 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 */ - } - } + 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; - } - 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; + /* 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) 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; + /* 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; } diff --git a/src/math/expm1f.c b/src/math/expm1f.c new file mode 100644 index 00000000..cfab6975 --- /dev/null +++ b/src/math/expm1f.c @@ -0,0 +1,125 @@ +/* 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; +} diff --git a/src/math/expm1l.c b/src/math/expm1l.c new file mode 100644 index 00000000..2f94dfa2 --- /dev/null +++ b/src/math/expm1l.c @@ -0,0 +1,123 @@ +/* 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 diff --git a/src/math/fabs.c b/src/math/fabs.c new file mode 100644 index 00000000..6e28f1e5 --- /dev/null +++ b/src/math/fabs.c @@ -0,0 +1,10 @@ +#include "libm.h" + +double fabs(double x) +{ + union dshape u; + + u.value = x; + u.bits &= (uint64_t)-1 / 2; + return u.value; +} diff --git a/src/math/fabsf.c b/src/math/fabsf.c new file mode 100644 index 00000000..516f1104 --- /dev/null +++ b/src/math/fabsf.c @@ -0,0 +1,10 @@ +#include "libm.h" + +float fabsf(float x) +{ + union fshape u; + + u.value = x; + u.bits &= (uint32_t)-1 / 2; + return u.value; +} diff --git a/src/math/fabsl.c b/src/math/fabsl.c new file mode 100644 index 00000000..711d908a --- /dev/null +++ b/src/math/fabsl.c @@ -0,0 +1,15 @@ +#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 diff --git a/src/math/fdim.c b/src/math/fdim.c new file mode 100644 index 00000000..fb25521c --- /dev/null +++ b/src/math/fdim.c @@ -0,0 +1,10 @@ +#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; +} diff --git a/src/math/fdimf.c b/src/math/fdimf.c new file mode 100644 index 00000000..5cfeac6b --- /dev/null +++ b/src/math/fdimf.c @@ -0,0 +1,10 @@ +#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; +} diff --git a/src/math/fdiml.c b/src/math/fdiml.c new file mode 100644 index 00000000..cda3022e --- /dev/null +++ b/src/math/fdiml.c @@ -0,0 +1,17 @@ +#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 diff --git a/src/math/floor.c b/src/math/floor.c new file mode 100644 index 00000000..521a148e --- /dev/null +++ b/src/math/floor.c @@ -0,0 +1,82 @@ +/* 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; +} diff --git a/src/math/floorf.c b/src/math/floorf.c new file mode 100644 index 00000000..958abf5b --- /dev/null +++ b/src/math/floorf.c @@ -0,0 +1,64 @@ +/* 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; +} diff --git a/src/math/floorl.c b/src/math/floorl.c new file mode 100644 index 00000000..08f6ba27 --- /dev/null +++ b/src/math/floorl.c @@ -0,0 +1,102 @@ +/* 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 diff --git a/src/math/fma.c b/src/math/fma.c new file mode 100644 index 00000000..c53f3148 --- /dev/null +++ b/src/math/fma.c @@ -0,0 +1,270 @@ +/* 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)); +} diff --git a/src/math/fmaf.c b/src/math/fmaf.c new file mode 100644 index 00000000..0dccf108 --- /dev/null +++ b/src/math/fmaf.c @@ -0,0 +1,64 @@ +/* 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); +} diff --git a/src/math/fmal.c b/src/math/fmal.c new file mode 100644 index 00000000..200bd5a5 --- /dev/null +++ b/src/math/fmal.c @@ -0,0 +1,266 @@ +/* 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 diff --git a/src/math/fmax.c b/src/math/fmax.c new file mode 100644 index 00000000..0b6bf6f3 --- /dev/null +++ b/src/math/fmax.c @@ -0,0 +1,13 @@ +#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; +} diff --git a/src/math/fmaxf.c b/src/math/fmaxf.c new file mode 100644 index 00000000..7767c303 --- /dev/null +++ b/src/math/fmaxf.c @@ -0,0 +1,13 @@ +#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; +} diff --git a/src/math/fmaxl.c b/src/math/fmaxl.c new file mode 100644 index 00000000..8a1e3652 --- /dev/null +++ b/src/math/fmaxl.c @@ -0,0 +1,20 @@ +#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 diff --git a/src/math/fmin.c b/src/math/fmin.c new file mode 100644 index 00000000..d1f16454 --- /dev/null +++ b/src/math/fmin.c @@ -0,0 +1,13 @@ +#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; +} diff --git a/src/math/fminf.c b/src/math/fminf.c new file mode 100644 index 00000000..0964cdb3 --- /dev/null +++ b/src/math/fminf.c @@ -0,0 +1,13 @@ +#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; +} diff --git a/src/math/fminl.c b/src/math/fminl.c new file mode 100644 index 00000000..ae7159a5 --- /dev/null +++ b/src/math/fminl.c @@ -0,0 +1,20 @@ +#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 diff --git a/src/math/fmod.c b/src/math/fmod.c new file mode 100644 index 00000000..6856844e --- /dev/null +++ b/src/math/fmod.c @@ -0,0 +1,146 @@ +/* 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 */ +} diff --git a/src/math/fmodf.c b/src/math/fmodf.c new file mode 100644 index 00000000..4b50a3d3 --- /dev/null +++ b/src/math/fmodf.c @@ -0,0 +1,105 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_fmodf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* < |