diff options
| author | Rich Felker <dalias@aerifal.cx> | 2012-03-13 01:17:53 -0400 |
|---|---|---|
| committer | Rich Felker <dalias@aerifal.cx> | 2012-03-13 01:17:53 -0400 |
| commit | b69f695acedd4ce2798ef9ea28d834ceccc789bd (patch) | |
| tree | eafd98b9b75160210f3295ac074d699f863d958e /src | |
| parent | d46cf2e14cc4df7cc75e77d7009fcb6df1f48a33 (diff) | |
| download | musl-b69f695acedd4ce2798ef9ea28d834ceccc789bd.tar.gz musl-b69f695acedd4ce2798ef9ea28d834ceccc789bd.tar.xz musl-b69f695acedd4ce2798ef9ea28d834ceccc789bd.zip | |
first commit of the new libm!
thanks to the hard work of Szabolcs Nagy (nsz), identifying the best (from correctness and license standpoint) implementations from freebsd and openbsd and cleaning them up! musl should now fully support c99 float and long double math functions, and has near-complete complex math support. tgmath should also work (fully on gcc-compatible compilers, and mostly on any c99 compiler). based largely on commit 0376d44a890fea261506f1fc63833e7a686dca19 from nsz's libm git repo, with some additions (dummy versions of a few missing long double complex functions, etc.) by me. various cleanups still need to be made, including re-adding (if they're correct) some asm functions that were dropped.
Diffstat (limited to 'src')
375 files changed, 20193 insertions, 7729 deletions
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. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * fmodf(x,y) + * Return x mod y in exact arithmetic + * Method: shift and subtract + */ + +#include "libm.h" + +static const float one = 1.0, Zero[] = {0.0, -0.0,}; + +float fmodf(float x, float y) +{ + int32_t n,hx,hy,hz,ix,iy,sx,i; + + GET_FLOAT_WORD(hx, x); + GET_FLOAT_WORD(hy, y); + sx = hx & 0x80000000; /* sign of x */ + hx ^= sx; /* |x| */ + hy &= 0x7fffffff; /* |y| */ + + /* purge off exception values */ + if (hy == 0 || hx >= 0x7f800000 || /* y=0,or x not finite */ + hy > 0x7f800000) /* or y is NaN */ + return (x*y)/(x*y); + if (hx < hy) /* |x| < |y| */ + return x; + if (hx == hy) /* |x| = |y|, return x*0 */ + return Zero[(uint32_t)sx>>31]; + + /* determine ix = ilogb(x) */ + if (hx < 0x00800000) { /* subnormal x */ + for (ix = -126, i = hx<<8; i > 0; i <<= 1) + ix -= 1; + } else + ix = (hx>>23) - 127; + + /* determine iy = ilogb(y) */ + if (hy < 0x00800000) { /* subnormal y */ + for (iy = -126, i = hy<<8; i >= 0; i <<= 1) + iy -= 1; + } else + iy = (hy>>23) - 127; + + /* set up {hx,lx}, {hy,ly} and align y to x */ + if (ix >= -126) + hx = 0x00800000|(0x007fffff&hx); + else { /* subnormal x, shift x to normal */ + n = -126-ix; + hx = hx<<n; + } + if (iy >= -126) + hy = 0x00800000|(0x007fffff&hy); + else { /* subnormal y, shift y to normal */ + n = -126-iy; + hy = hy<<n; + } + + /* fix point fmod */ + n = ix - iy; + while (n--) { + hz = hx-hy; + if (hz<0) + hx = hx+hx; + else { + if(hz == 0) /* return sign(x)*0 */ + return Zero[(uint32_t)sx>>31]; + hx = hz+hz; + } + } + hz = hx-hy; + if (hz >= 0) + hx = hz; + + /* convert back to floating value and restore the sign */ + if (hx == 0) /* return sign(x)*0 */ + return Zero[(uint32_t)sx>>31]; + while (hx < 0x00800000) { /* normalize x */ + hx = hx+hx; + iy -= 1; + } + if (iy >= -126) { /* normalize output */ + hx = ((hx-0x00800000)|((iy+127)<<23)); + SET_FLOAT_WORD(x, hx|sx); + } else { /* subnormal output */ + n = -126 - iy; + hx >>= n; + SET_FLOAT_WORD(x, hx|sx); + x *= one; /* create necessary signal */ + } + return x; /* exact output */ +} diff --git a/src/math/fmodl.c b/src/math/fmodl.c new file mode 100644 index 00000000..2e3eec1f --- /dev/null +++ b/src/math/fmodl.c @@ -0,0 +1,159 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_fmodl.c */ +/*- + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double fmodl(long double x, long double y) +{ + return fmod(x, y); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 + +#define BIAS (LDBL_MAX_EXP - 1) + +#if LDBL_MANL_SIZE > 32 +typedef uint64_t manl_t; +#else +typedef uint32_t manl_t; +#endif + +#if LDBL_MANH_SIZE > 32 +typedef uint64_t manh_t; +#else +typedef uint32_t manh_t; +#endif + +/* + * These macros add and remove an explicit integer bit in front of the + * fractional mantissa, if the architecture doesn't have such a bit by + * default already. + */ +#ifdef LDBL_IMPLICIT_NBIT +#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) +#define HFRAC_BITS LDBL_MANH_SIZE +#else +#define SET_NBIT(hx) (hx) +#define HFRAC_BITS (LDBL_MANH_SIZE - 1) +#endif + +#define MANL_SHIFT (LDBL_MANL_SIZE - 1) + +static const long double one = 1.0, Zero[] = {0.0, -0.0,}; + +/* + * fmodl(x,y) + * Return x mod y in exact arithmetic + * Method: shift and subtract + * + * Assumptions: + * - The low part of the mantissa fits in a manl_t exactly. + * - The high part of the mantissa fits in an int64_t with enough room + * for an explicit integer bit in front of the fractional bits. + */ +long double fmodl(long double x, long double y) +{ + union IEEEl2bits ux, uy; + int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ + manh_t hy; + manl_t lx,ly,lz; + int ix,iy,n,sx; + + ux.e = x; + uy.e = y; + sx = ux.bits.sign; + + /* purge off exception values */ + if ((uy.bits.exp|uy.bits.manh|uy.bits.manl) == 0 || /* y=0 */ + ux.bits.exp == BIAS + LDBL_MAX_EXP || /* or x not finite */ + (uy.bits.exp == BIAS + LDBL_MAX_EXP && + ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) /* or y is NaN */ + return (x*y)/(x*y); + if (ux.bits.exp <= uy.bits.exp) { + if (ux.bits.exp < uy.bits.exp || + (ux.bits.manh<=uy.bits.manh && + (ux.bits.manh<uy.bits.manh || + ux.bits.manl<uy.bits.manl))) /* |x|<|y| return x or x-y */ + return x; + if (ux.bits.manh==uy.bits.manh && ux.bits.manl==uy.bits.manl) + return Zero[sx]; /* |x| = |y| return x*0 */ + } + + /* determine ix = ilogb(x) */ + if (ux.bits.exp == 0) { /* subnormal x */ + ux.e *= 0x1.0p512; + ix = ux.bits.exp - (BIAS + 512); + } else { + ix = ux.bits.exp - BIAS; + } + + /* determine iy = ilogb(y) */ + if (uy.bits.exp == 0) { /* subnormal y */ + uy.e *= 0x1.0p512; + iy = uy.bits.exp - (BIAS + 512); + } else { + iy = uy.bits.exp - BIAS; + } + + /* set up {hx,lx}, {hy,ly} and align y to x */ + hx = SET_NBIT(ux.bits.manh); + hy = SET_NBIT(uy.bits.manh); + lx = ux.bits.manl; + ly = uy.bits.manl; + + /* fix point fmod */ + n = ix - iy; + + while (n--) { + hz = hx-hy; + lz = lx-ly; + if (lx < ly) + hz -= 1; + if (hz < 0) { + hx = hx+hx+(lx>>MANL_SHIFT); + lx = lx+lx; + } else { + if ((hz|lz)==0) /* return sign(x)*0 */ + return Zero[sx]; + hx = hz+hz+(lz>>MANL_SHIFT); + lx = lz+lz; + } + } + hz = hx-hy; + lz = lx-ly; + if (lx < ly) + hz -= 1; + if (hz >= 0) { + hx = hz; + lx = lz; + } + + /* convert back to floating value and restore the sign */ + if ((hx|lx) == 0) /* return sign(x)*0 */ + return Zero[sx]; + while (hx < (1ULL<<HFRAC_BITS)) { /* normalize x */ + hx = hx+hx+(lx>>MANL_SHIFT); + lx = lx+lx; + iy -= 1; + } + ux.bits.manh = hx; /* The mantissa is truncated here if needed. */ + ux.bits.manl = lx; + if (iy < LDBL_MIN_EXP) { + ux.bits.exp = iy + (BIAS + 512); + ux.e *= 0x1p-512; + } else { + ux.bits.exp = iy + BIAS; + } + x = ux.e * one; /* create necessary signal */ + return x; /* exact output */ +} +#endif diff --git a/src/stdlib/frexp.c b/src/math/frexp.c index ae82cb30..27b6266e 100644 --- a/src/stdlib/frexp.c +++ b/src/math/frexp.c @@ -1,5 +1,5 @@ #include <math.h> -#include <inttypes.h> +#include <stdint.h> double frexp(double x, int *e) { diff --git a/src/stdlib/frexpf.c b/src/math/frexpf.c index ee5e910a..07870975 100644 --- a/src/stdlib/frexpf.c +++ b/src/math/frexpf.c @@ -1,5 +1,5 @@ #include <math.h> -#include <inttypes.h> +#include <stdint.h> float frexpf(float x, int *e) { diff --git a/src/stdlib/frexpl.c b/src/math/frexpl.c index 3472bf70..f9d90a6d 100644 --- a/src/stdlib/frexpl.c +++ b/src/math/frexpl.c @@ -1,5 +1,5 @@ #include <math.h> -#include <inttypes.h> +#include <stdint.h> #include <float.h> #if LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 diff --git a/src/math/hypot.c b/src/math/hypot.c new file mode 100644 index 00000000..ba4c7575 --- /dev/null +++ b/src/math/hypot.c @@ -0,0 +1,128 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_hypot.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* hypot(x,y) + * + * Method : + * If (assume round-to-nearest) z=x*x+y*y + * has error less than sqrt(2)/2 ulp, then + * sqrt(z) has error less than 1 ulp (exercise). + * + * So, compute sqrt(x*x+y*y) with some care as + * follows to get the error below 1 ulp: + * + * Assume x>y>0; + * (if possible, set rounding to round-to-nearest) + * 1. if x > 2y use + * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y + * where x1 = x with lower 32 bits cleared, x2 = x-x1; else + * 2. if x <= 2y use + * t1*y1+((x-y)*(x-y)+(t1*y2+t2*y)) + * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1, + * y1= y with lower 32 bits chopped, y2 = y-y1. + * + * NOTE: scaling may be necessary if some argument is too + * large or too tiny + * + * Special cases: + * hypot(x,y) is INF if x or y is +INF or -INF; else + * hypot(x,y) is NAN if x or y is NAN. + * + * Accuracy: + * hypot(x,y) returns sqrt(x^2+y^2) with error less + * than 1 ulps (units in the last place) + */ + +#include "libm.h" + +double hypot(double x, double y) +{ + double a,b,t1,t2,y1,y2,w; + int32_t j,k,ha,hb; + + GET_HIGH_WORD(ha, x); + ha &= 0x7fffffff; + GET_HIGH_WORD(hb, y); + hb &= 0x7fffffff; + if (hb > ha) { + a = y; + b = x; + j=ha; ha=hb; hb=j; + } else { + a = x; + b = y; + } + a = fabs(a); + b = fabs(b); + if (ha - hb > 0x3c00000) /* x/y > 2**60 */ + return a+b; + k = 0; + if (ha > 0x5f300000) { /* a > 2**500 */ + if(ha >= 0x7ff00000) { /* Inf or NaN */ + uint32_t low; + /* Use original arg order iff result is NaN; quieten sNaNs. */ + w = fabs(x+0.0) - fabs(y+0.0); + GET_LOW_WORD(low, a); + if (((ha&0xfffff)|low) == 0) w = a; + GET_LOW_WORD(low, b); + if (((hb^0x7ff00000)|low) == 0) w = b; + return w; + } + /* scale a and b by 2**-600 */ + ha -= 0x25800000; hb -= 0x25800000; k += 600; + SET_HIGH_WORD(a, ha); + SET_HIGH_WORD(b, hb); + } + if (hb < 0x20b00000) { /* b < 2**-500 */ + if (hb <= 0x000fffff) { /* subnormal b or 0 */ + uint32_t low; + GET_LOW_WORD(low, b); + if ((hb|low) == 0) + return a; + t1 = 0; + SET_HIGH_WORD(t1, 0x7fd00000); /* t1 = 2^1022 */ + b *= t1; + a *= t1; + k -= 1022; + } else { /* scale a and b by 2^600 */ + ha += 0x25800000; /* a *= 2^600 */ + hb += 0x25800000; /* b *= 2^600 */ + k -= 600; + SET_HIGH_WORD(a, ha); + SET_HIGH_WORD(b, hb); + } + } + /* medium size a and b */ + w = a - b; + if (w > b) { + t1 = 0; + SET_HIGH_WORD(t1, ha); + t2 = a-t1; + w = sqrt(t1*t1-(b*(-b)-t2*(a+t1))); + } else { + a = a + a; + y1 = 0; + SET_HIGH_WORD(y1, hb); + y2 = b - y1; + t1 = 0; + SET_HIGH_WORD(t1, ha+0x00100000); + t2 = a - t1; + w = sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b))); + } + if (k != 0) { + uint32_t high; + t1 = 1.0; + GET_HIGH_WORD(high, t1); + SET_HIGH_WORD(t1, high+(k<<20)); + return t1*w; + } + return w; +} diff --git a/src/math/hypotf.c b/src/math/hypotf.c new file mode 100644 index 00000000..40acd917 --- /dev/null +++ b/src/math/hypotf.c @@ -0,0 +1,88 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_hypotf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +float hypotf(float x, float y) +{ + float a,b,t1,t2,y1,y2,w; + int32_t j,k,ha,hb; + + GET_FLOAT_WORD(ha,x); + ha &= 0x7fffffff; + GET_FLOAT_WORD(hb,y); + hb &= 0x7fffffff; + if (hb > ha) { + a = y; + b = x; + j=ha; ha=hb; hb=j; + } else { + a = x; + b = y; + } + a = fabsf(a); + b = fabsf(b); + if (ha - hb > 0xf000000) /* x/y > 2**30 */ + return a+b; + k = 0; + if (ha > 0x58800000) { /* a > 2**50 */ + if(ha >= 0x7f800000) { /* Inf or NaN */ + /* Use original arg order iff result is NaN; quieten sNaNs. */ + w = fabsf(x+0.0F) - fabsf(y+0.0F); + if (ha == 0x7f800000) w = a; + if (hb == 0x7f800000) w = b; + return w; + } + /* scale a and b by 2**-68 */ + ha -= 0x22000000; hb -= 0x22000000; k += 68; + SET_FLOAT_WORD(a, ha); + SET_FLOAT_WORD(b, hb); + } + if (hb < 0x26800000) { /* b < 2**-50 */ + if (hb <= 0x007fffff) { /* subnormal b or 0 */ + if (hb == 0) + return a; + SET_FLOAT_WORD(t1, 0x7e800000); /* t1 = 2^126 */ + b *= t1; + a *= t1; + k -= 126; + } else { /* scale a and b by 2^68 */ + ha += 0x22000000; /* a *= 2^68 */ + hb += 0x22000000; /* b *= 2^68 */ + k -= 68; + SET_FLOAT_WORD(a, ha); + SET_FLOAT_WORD(b, hb); + } + } + /* medium size a and b */ + w = a - b; + if (w > b) { + SET_FLOAT_WORD(t1, ha&0xfffff000); + t2 = a - t1; + w = sqrtf(t1*t1-(b*(-b)-t2*(a+t1))); + } else { + a = a + a; + SET_FLOAT_WORD(y1, hb&0xfffff000); + y2 = b - y1; + SET_FLOAT_WORD(t1,(ha+0x00800000)&0xfffff000); + t2 = a - t1; + w = sqrtf(t1*y1-(w*(-w)-(t1*y2+t2*b))); + } + if (k != 0) { + SET_FLOAT_WORD(t1, 0x3f800000+(k<<23)); + return t1*w; + } + return w; +} diff --git a/src/math/hypotl.c b/src/math/hypotl.c new file mode 100644 index 00000000..f4a64f74 --- /dev/null +++ b/src/math/hypotl.c @@ -0,0 +1,148 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_hypotl.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* long double version of hypot(). See comments in hypot.c. */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double hypotl(long double x, long double y) +{ + return hypot(x, y); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 + +#define GET_LDBL_EXPSIGN(i, v) do { \ + union IEEEl2bits uv; \ + \ + uv.e = v; \ + i = uv.xbits.expsign; \ +} while (0) + +#define GET_LDBL_MAN(h, l, v) do { \ + union IEEEl2bits uv; \ + \ + uv.e = v; \ + h = uv.bits.manh; \ + l = uv.bits.manl; \ +} while (0) + +#define SET_LDBL_EXPSIGN(v, i) do { \ + union IEEEl2bits uv; \ + \ + uv.e = v; \ + uv.xbits.expsign = i; \ + v = uv.e; \ +} while (0) + +#undef GET_HIGH_WORD +#define GET_HIGH_WORD(i, v) GET_LDBL_EXPSIGN(i, v) +#undef SET_HIGH_WORD +#define SET_HIGH_WORD(v, i) SET_LDBL_EXPSIGN(v, i) + +#define DESW(exp) (exp) /* delta expsign word */ +#define ESW(exp) (MAX_EXP - 1 + (exp)) /* expsign word */ +#define MANT_DIG LDBL_MANT_DIG +#define MAX_EXP LDBL_MAX_EXP + +#if LDBL_MANL_SIZE > 32 +typedef uint64_t man_t; +#else +typedef uint32_t man_t; +#endif + +long double hypotl(long double x, long double y) +{ + long double a=x,b=y,t1,t2,y1,y2,w; + int32_t j,k,ha,hb; + + GET_HIGH_WORD(ha, x); + ha &= 0x7fff; + GET_HIGH_WORD(hb, y); + hb &= 0x7fff; + if (hb > ha) { + a = y; + b = x; + j=ha; ha=hb; hb=j; + } else { + a = x; + b = y; + } + a = fabsl(a); + b = fabsl(b); + if (ha - hb > DESW(MANT_DIG+7)) /* x/y > 2**(MANT_DIG+7) */ + return a+b; + k = 0; + if (ha > ESW(MAX_EXP/2-12)) { /* a>2**(MAX_EXP/2-12) */ + if (ha >= ESW(MAX_EXP)) { /* Inf or NaN */ + man_t manh, manl; + /* Use original arg order iff result is NaN; quieten sNaNs. */ + w = fabsl(x+0.0)-fabsl(y+0.0); + GET_LDBL_MAN(manh,manl,a); + if (manh == LDBL_NBIT && manl == 0) w = a; + GET_LDBL_MAN(manh,manl,b); + if (hb >= ESW(MAX_EXP) && manh == LDBL_NBIT && manl == 0) w = b; + return w; + } + /* scale a and b by 2**-(MAX_EXP/2+88) */ + ha -= DESW(MAX_EXP/2+88); hb -= DESW(MAX_EXP/2+88); + k += MAX_EXP/2+88; + SET_HIGH_WORD(a, ha); + SET_HIGH_WORD(b, hb); + } + if (hb < ESW(-(MAX_EXP/2-12))) { /* b < 2**-(MAX_EXP/2-12) */ + if (hb <= 0) { /* subnormal b or 0 */ + man_t manh, manl; + GET_LDBL_MAN(manh,manl,b); + if ((manh|manl) == 0) + return a; + t1 = 0; + SET_HIGH_WORD(t1, ESW(MAX_EXP-2)); /* t1 = 2^(MAX_EXP-2) */ + b *= t1; + a *= t1; + k -= MAX_EXP-2; + } else { /* scale a and b by 2^(MAX_EXP/2+88) */ + ha += DESW(MAX_EXP/2+88); + hb += DESW(MAX_EXP/2+88); + k -= MAX_EXP/2+88; + SET_HIGH_WORD(a, ha); + SET_HIGH_WORD(b, hb); + } + } + /* medium size a and b */ + w = a - b; + if (w > b) { + t1 = a; + union IEEEl2bits uv; + uv.e = t1; uv.bits.manl = 0; t1 = uv.e; + t2 = a-t1; + w = sqrtl(t1*t1-(b*(-b)-t2*(a+t1))); + } else { + a = a+a; + y1 = b; + union IEEEl2bits uv; + uv.e = y1; uv.bits.manl = 0; y1 = uv.e; + y2 = b - y1; + t1 = a; + uv.e = t1; uv.bits.manl = 0; t1 = uv.e; + t2 = a - t1; + w = sqrtl(t1*y1-(w*(-w)-(t1*y2+t2*b))); + } + if(k!=0) { + uint32_t high; + t1 = 1.0; + GET_HIGH_WORD(high, t1); + SET_HIGH_WORD(t1, high+DESW(k)); + return t1*w; + } + return w; +} +#endif diff --git a/src/math/i386/e_exp.s b/src/math/i386/e_exp.s deleted file mode 100644 index c50abc5e..00000000 --- a/src/math/i386/e_exp.s +++ /dev/null @@ -1,38 +0,0 @@ -.global expf -.type expf,@function -expf: - mov 4(%esp),%eax - flds 4(%esp) - shr $23,%eax - inc %al - jz 1f - jmp 0f - -.global exp -.type exp,@function -exp: - mov 8(%esp),%eax - fldl 4(%esp) - shl %eax - cmp $0xffe00000,%eax - jae 1f - -0: fldl2e - fmulp - fst %st(1) - frndint - fst %st(2) - fsubrp - f2xm1 - fld1 - faddp - fscale - fstp %st(1) - ret - -1: fsts 4(%esp) - cmpl $0xff800000,4(%esp) - jnz 1f - fstp %st(0) - fldz -1: ret diff --git a/src/math/i386/e_expf.s b/src/math/i386/e_expf.s deleted file mode 100644 index 8b137891..00000000 --- a/src/math/i386/e_expf.s +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/math/i386/e_log.s b/src/math/i386/e_log.s deleted file mode 100644 index fcccf030..00000000 --- a/src/math/i386/e_log.s +++ /dev/null @@ -1,7 +0,0 @@ -.global log -.type log,@function -log: - fldln2 - fldl 4(%esp) - fyl2x - ret diff --git a/src/math/i386/e_log10.s b/src/math/i386/e_log10.s deleted file mode 100644 index 28eb5b2f..00000000 --- a/src/math/i386/e_log10.s +++ /dev/null @@ -1,7 +0,0 @@ -.global log10 -.type log10,@function -log10: - fldlg2 - fldl 4(%esp) - fyl2x - ret diff --git a/src/math/i386/e_log10f.s b/src/math/i386/e_log10f.s deleted file mode 100644 index c0c0c67e..00000000 --- a/src/math/i386/e_log10f.s +++ /dev/null @@ -1,7 +0,0 @@ -.global log10f -.type log10f,@function -log10f: - fldlg2 - flds 4(%esp) - fyl2x - ret diff --git a/src/math/i386/e_logf.s b/src/math/i386/e_logf.s deleted file mode 100644 index da7ff3ae..00000000 --- a/src/math/i386/e_logf.s +++ /dev/null @@ -1,7 +0,0 @@ -.global logf -.type logf,@function -logf: - fldln2 - flds 4(%esp) - fyl2x - ret diff --git a/src/math/i386/e_remainder.s b/src/math/i386/e_remainder.s deleted file mode 100644 index 36d55f98..00000000 --- a/src/math/i386/e_remainder.s +++ /dev/null @@ -1,18 +0,0 @@ -.global remainderf -.type remainderf,@function -remainderf: - flds 8(%esp) - flds 4(%esp) - jmp 1f - -.global remainder -.type remainder,@function -remainder: - fldl 12(%esp) - fldl 4(%esp) -1: fprem1 - fstsw %ax - sahf - jp 1b - fstp %st(1) - ret diff --git a/src/math/i386/s_ceil.s b/src/math/i386/s_ceil.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_ceil.s +++ /dev/null diff --git a/src/math/i386/s_ceilf.s b/src/math/i386/s_ceilf.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_ceilf.s +++ /dev/null diff --git a/src/math/i386/s_fabs.s b/src/math/i386/s_fabs.s deleted file mode 100644 index d66ea9a1..00000000 --- a/src/math/i386/s_fabs.s +++ /dev/null @@ -1,6 +0,0 @@ -.global fabs -.type fabs,@function -fabs: - fldl 4(%esp) - fabs - ret diff --git a/src/math/i386/s_fabsf.s b/src/math/i386/s_fabsf.s deleted file mode 100644 index a981c422..00000000 --- a/src/math/i386/s_fabsf.s +++ /dev/null @@ -1,6 +0,0 @@ -.global fabsf -.type fabsf,@function -fabsf: - flds 4(%esp) - fabs - ret diff --git a/src/math/i386/s_floor.s b/src/math/i386/s_floor.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_floor.s +++ /dev/null diff --git a/src/math/i386/s_floorf.s b/src/math/i386/s_floorf.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_floorf.s +++ /dev/null diff --git a/src/math/i386/s_ldexp.s b/src/math/i386/s_ldexp.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_ldexp.s +++ /dev/null diff --git a/src/math/i386/s_ldexpf.s b/src/math/i386/s_ldexpf.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_ldexpf.s +++ /dev/null diff --git a/src/math/i386/s_rint.s b/src/math/i386/s_rint.s deleted file mode 100644 index bb99a11c..00000000 --- a/src/math/i386/s_rint.s +++ /dev/null @@ -1,6 +0,0 @@ -.global rint -.type rint,@function -rint: - fldl 4(%esp) - frndint - ret diff --git a/src/math/i386/s_rintf.s b/src/math/i386/s_rintf.s deleted file mode 100644 index bce4c5a6..00000000 --- a/src/math/i386/s_rintf.s +++ /dev/null @@ -1,6 +0,0 @@ -.global rintf -.type rintf,@function -rintf: - flds 4(%esp) - frndint - ret diff --git a/src/math/i386/s_scalbln.s b/src/math/i386/s_scalbln.s deleted file mode 100644 index 2641e694..00000000 --- a/src/math/i386/s_scalbln.s +++ /dev/null @@ -1,14 +0,0 @@ -.global ldexp -.global scalbn -.global scalbln -.type ldexp,@function -.type scalbn,@function -.type scalbln,@function -ldexp: -scalbn: -scalbln: - fildl 12(%esp) - fldl 4(%esp) - fscale - fstp %st(1) - ret diff --git a/src/math/i386/s_scalblnf.s b/src/math/i386/s_scalblnf.s deleted file mode 100644 index 775765a3..00000000 --- a/src/math/i386/s_scalblnf.s +++ /dev/null @@ -1,14 +0,0 @@ -.global ldexpf -.global scalbnf -.global scalblnf -.type ldexpf,@function -.type scalbnf,@function -.type scalblnf,@function -ldexpf: -scalbnf: -scalblnf: - fildl 8(%esp) - flds 4(%esp) - fscale - fstp %st(1) - ret diff --git a/src/math/i386/s_trunc.s b/src/math/i386/s_trunc.s deleted file mode 100644 index bdd6ab4c..00000000 --- a/src/math/i386/s_trunc.s +++ /dev/null @@ -1,42 +0,0 @@ -.global ceilf -.type ceilf,@function -ceilf: flds 4(%esp) - jmp 1f - -.global ceil -.type ceil,@function -ceil: fldl 4(%esp) -1: mov $0x08fb,%edx - jmp 0f - -.global floorf -.type floorf,@function -floorf: flds 4(%esp) - jmp 1f - -.global floor -.type floor,@function -floor: fldl 4(%esp) -1: mov $0x04f7,%edx - jmp 0f - -.global truncf -.type truncf,@function -truncf: flds 4(%esp) - jmp 1f - -.global trunc -.type trunc,@function -trunc: fldl 4(%esp) -1: mov $0x0cff,%edx - -0: fstcw 4(%esp) - mov 5(%esp),%ah - or %dh,%ah - and %dl,%ah - xchg %ah,5(%esp) - fldcw 4(%esp) - frndint - mov %ah,5(%esp) - fldcw 4(%esp) - ret diff --git a/src/math/i386/s_truncf.s b/src/math/i386/s_truncf.s deleted file mode 100644 index e69de29b..00000000 --- a/src/math/i386/s_truncf.s +++ /dev/null diff --git a/src/math/i386/e_sqrt.s b/src/math/i386/sqrt.s index c6e55303..c6e55303 100644 --- a/src/math/i386/e_sqrt.s +++ b/src/math/i386/sqrt.s diff --git a/src/math/i386/e_sqrtf.s b/src/math/i386/sqrtf.s index b79bd949..b79bd949 100644 --- a/src/math/i386/e_sqrtf.s +++ b/src/math/i386/sqrtf.s diff --git a/src/math/i386/sqrtl.s b/src/math/i386/sqrtl.s new file mode 100644 index 00000000..e0d42616 --- /dev/null +++ b/src/math/i386/sqrtl.s @@ -0,0 +1,5 @@ +.global sqrtl +.type sqrtl,@function +sqrtl: fldt 4(%esp) + fsqrt + ret diff --git a/src/math/ilogb.c b/src/math/ilogb.c new file mode 100644 index 00000000..c5915a0c --- /dev/null +++ b/src/math/ilogb.c @@ -0,0 +1,21 @@ +#include <limits.h> +#include "libm.h" + +int ilogb(double x) +{ + union dshape u = {x}; + int e = u.bits>>52 & 0x7ff; + + if (!e) { + u.bits <<= 12; + if (u.bits == 0) + return FP_ILOGB0; + /* subnormal x */ + // FIXME: scale up subnormals with a *0x1p53 or find top set bit with a better method + for (e = -0x3ff; u.bits < (uint64_t)1<<63; e--, u.bits<<=1); + return e; + } + if (e == 0x7ff) + return u.bits<<12 ? FP_ILOGBNAN : INT_MAX; + return e - 0x3ff; +} diff --git a/src/math/ilogbf.c b/src/math/ilogbf.c new file mode 100644 index 00000000..272cbdac --- /dev/null +++ b/src/math/ilogbf.c @@ -0,0 +1,20 @@ +#include <limits.h> +#include "libm.h" + +int ilogbf(float x) +{ + union fshape u = {x}; + int e = u.bits>>23 & 0xff; + + if (!e) { + u.bits <<= 9; + if (u.bits == 0) + return FP_ILOGB0; + /* subnormal x */ + for (e = -0x7f; u.bits < (uint32_t)1<<31; e--, u.bits<<=1); + return e; + } + if (e == 0xff) + return u.bits<<9 ? FP_ILOGBNAN : INT_MAX; + return e - 0x7f; +} diff --git a/src/math/ilogbl.c b/src/math/ilogbl.c new file mode 100644 index 00000000..ed9ddcbc --- /dev/null +++ b/src/math/ilogbl.c @@ -0,0 +1,28 @@ +#include <limits.h> +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +int ilogbl(long double x) +{ + return ilogb(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +int ilogbl(long double x) +{ + union ldshape u = {x}; + uint64_t m = u.bits.m; + int e = u.bits.exp; + + if (!e) { + if (m == 0) + return FP_ILOGB0; + /* subnormal x */ + for (e = -0x3fff+1; m < (uint64_t)1<<63; e--, m<<=1); + return e; + } + if (e == 0x7fff) + /* in ld80 msb is set in inf */ + return m & (uint64_t)-1>>1 ? FP_ILOGBNAN : INT_MAX; + return e - 0x3fff; +} +#endif diff --git a/src/math/j0.c b/src/math/j0.c new file mode 100644 index 00000000..b5490641 --- /dev/null +++ b/src/math/j0.c @@ -0,0 +1,389 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_j0.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* j0(x), y0(x) + * Bessel function of the first and second kinds of order zero. + * Method -- j0(x): + * 1. For tiny x, we use j0(x) = 1 - x^2/4 + x^4/64 - ... + * 2. Reduce x to |x| since j0(x)=j0(-x), and + * for x in (0,2) + * j0(x) = 1-z/4+ z^2*R0/S0, where z = x*x; + * (precision: |j0-1+z/4-z^2R0/S0 |<2**-63.67 ) + * for x in (2,inf) + * j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0)) + * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) + * as follow: + * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) + * = 1/sqrt(2) * (cos(x) + sin(x)) + * sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * (To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one.) + * + * 3 Special cases + * j0(nan)= nan + * j0(0) = 1 + * j0(inf) = 0 + * + * Method -- y0(x): + * 1. For x<2. + * Since + * y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...) + * therefore y0(x)-2/pi*j0(x)*ln(x) is an even function. + * We use the following function to approximate y0, + * y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2 + * where + * U(z) = u00 + u01*z + ... + u06*z^6 + * V(z) = 1 + v01*z + ... + v04*z^4 + * with absolute approximation error bounded by 2**-72. + * Note: For tiny x, U/V = u0 and j0(x)~1, hence + * y0(tiny) = u0 + (2/pi)*ln(tiny), (choose tiny<2**-27) + * 2. For x>=2. + * y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0)) + * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0) + * by the method mentioned above. + * 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0. + */ + +#include "libm.h" + +static double pzero(double), qzero(double); + +static const double +huge = 1e300, +one = 1.0, +invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ +tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ +/* R0/S0 on [0, 2.00] */ +R02 = 1.56249999999999947958e-02, /* 0x3F8FFFFF, 0xFFFFFFFD */ +R03 = -1.89979294238854721751e-04, /* 0xBF28E6A5, 0xB61AC6E9 */ +R04 = 1.82954049532700665670e-06, /* 0x3EBEB1D1, 0x0C503919 */ +R05 = -4.61832688532103189199e-09, /* 0xBE33D5E7, 0x73D63FCE */ +S01 = 1.56191029464890010492e-02, /* 0x3F8FFCE8, 0x82C8C2A4 */ +S02 = 1.16926784663337450260e-04, /* 0x3F1EA6D2, 0xDD57DBF4 */ +S03 = 5.13546550207318111446e-07, /* 0x3EA13B54, 0xCE84D5A9 */ +S04 = 1.16614003333790000205e-09; /* 0x3E1408BC, 0xF4745D8F */ + +static const double zero = 0.0; + +double j0(double x) +{ + double z, s,c,ss,cc,r,u,v; + int32_t hx,ix; + + GET_HIGH_WORD(hx, x); + ix = hx & 0x7fffffff; + if (ix >= 0x7ff00000) + return one/(x*x); + x = fabs(x); + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + s = sin(x); + c = cos(x); + ss = s-c; + cc = s+c; + if (ix < 0x7fe00000) { /* make sure x+x does not overflow */ + z = -cos(x+x); + if ((s*c) < zero) + cc = z/ss; + else + ss = z/cc; + } + /* + * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) + * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) + */ + if (ix > 0x48000000) + z = (invsqrtpi*cc)/sqrt(x); + else { + u = pzero(x); + v = qzero(x); + z = invsqrtpi*(u*cc-v*ss)/sqrt(x); + } + return z; + } + if (ix < 0x3f200000) { /* |x| < 2**-13 */ + /* raise inexact if x != 0 */ + if (huge+x > one) { + if (ix < 0x3e400000) /* |x| < 2**-27 */ + return one; + return one - 0.25*x*x; + } + } + z = x*x; + r = z*(R02+z*(R03+z*(R04+z*R05))); + s = one+z*(S01+z*(S02+z*(S03+z*S04))); + if (ix < 0x3FF00000) { /* |x| < 1.00 */ + return one + z*(-0.25+(r/s)); + } else { + u = 0.5*x; + return (one+u)*(one-u) + z*(r/s); + } +} + +static const double +u00 = -7.38042951086872317523e-02, /* 0xBFB2E4D6, 0x99CBD01F */ +u01 = 1.76666452509181115538e-01, /* 0x3FC69D01, 0x9DE9E3FC */ +u02 = -1.38185671945596898896e-02, /* 0xBF8C4CE8, 0xB16CFA97 */ +u03 = 3.47453432093683650238e-04, /* 0x3F36C54D, 0x20B29B6B */ +u04 = -3.81407053724364161125e-06, /* 0xBECFFEA7, 0x73D25CAD */ +u05 = 1.95590137035022920206e-08, /* 0x3E550057, 0x3B4EABD4 */ +u06 = -3.98205194132103398453e-11, /* 0xBDC5E43D, 0x693FB3C8 */ +v01 = 1.27304834834123699328e-02, /* 0x3F8A1270, 0x91C9C71A */ +v02 = 7.60068627350353253702e-05, /* 0x3F13ECBB, 0xF578C6C1 */ +v03 = 2.59150851840457805467e-07, /* 0x3E91642D, 0x7FF202FD */ +v04 = 4.41110311332675467403e-10; /* 0x3DFE5018, 0x3BD6D9EF */ + +double y0(double x) +{ + double z,s,c,ss,cc,u,v; + int32_t hx,ix,lx; + + EXTRACT_WORDS(hx, lx, x); + ix = 0x7fffffff & hx; + /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ + if (ix >= 0x7ff00000) + return one/(x+x*x); + if ((ix|lx) == 0) + return -one/zero; + if (hx < 0) + return zero/zero; + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) + * where x0 = x-pi/4 + * Better formula: + * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) + * = 1/sqrt(2) * (sin(x) + cos(x)) + * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one. + */ + s = sin(x); + c = cos(x); + ss = s-c; + cc = s+c; + /* + * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) + * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) + */ + if (ix < 0x7fe00000) { /* make sure x+x does not overflow */ + z = -cos(x+x); + if (s*c < zero) + cc = z/ss; + else + ss = z/cc; + } + if (ix > 0x48000000) + z = (invsqrtpi*ss)/sqrt(x); + else { + u = pzero(x); + v = qzero(x); + z = invsqrtpi*(u*ss+v*cc)/sqrt(x); + } + return z; + } + if (ix <= 0x3e400000) { /* x < 2**-27 */ + return u00 + tpi*log(x); + } + z = x*x; + u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06))))); + v = one+z*(v01+z*(v02+z*(v03+z*v04))); + return u/v + tpi*(j0(x)*log(x)); +} + +/* The asymptotic expansions of pzero is + * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. + * For x >= 2, We approximate pzero by + * pzero(x) = 1 + (R/S) + * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10 + * S = 1 + pS0*s^2 + ... + pS4*s^10 + * and + * | pzero(x)-1-R/S | <= 2 ** ( -60.26) + */ +static const double pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ + -7.03124999999900357484e-02, /* 0xBFB1FFFF, 0xFFFFFD32 */ + -8.08167041275349795626e+00, /* 0xC02029D0, 0xB44FA779 */ + -2.57063105679704847262e+02, /* 0xC0701102, 0x7B19E863 */ + -2.48521641009428822144e+03, /* 0xC0A36A6E, 0xCD4DCAFC */ + -5.25304380490729545272e+03, /* 0xC0B4850B, 0x36CC643D */ +}; +static const double pS8[5] = { + 1.16534364619668181717e+02, /* 0x405D2233, 0x07A96751 */ + 3.83374475364121826715e+03, /* 0x40ADF37D, 0x50596938 */ + 4.05978572648472545552e+04, /* 0x40E3D2BB, 0x6EB6B05F */ + 1.16752972564375915681e+05, /* 0x40FC810F, 0x8F9FA9BD */ + 4.76277284146730962675e+04, /* 0x40E74177, 0x4F2C49DC */ +}; + +static const double pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + -1.14125464691894502584e-11, /* 0xBDA918B1, 0x47E495CC */ + -7.03124940873599280078e-02, /* 0xBFB1FFFF, 0xE69AFBC6 */ + -4.15961064470587782438e+00, /* 0xC010A370, 0xF90C6BBF */ + -6.76747652265167261021e+01, /* 0xC050EB2F, 0x5A7D1783 */ + -3.31231299649172967747e+02, /* 0xC074B3B3, 0x6742CC63 */ + -3.46433388365604912451e+02, /* 0xC075A6EF, 0x28A38BD7 */ +}; +static const double pS5[5] = { + 6.07539382692300335975e+01, /* 0x404E6081, 0x0C98C5DE */ + 1.05125230595704579173e+03, /* 0x40906D02, 0x5C7E2864 */ + 5.97897094333855784498e+03, /* 0x40B75AF8, 0x8FBE1D60 */ + 9.62544514357774460223e+03, /* 0x40C2CCB8, 0xFA76FA38 */ + 2.40605815922939109441e+03, /* 0x40A2CC1D, 0xC70BE864 */ +}; + +static const double pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ + -2.54704601771951915620e-09, /* 0xBE25E103, 0x6FE1AA86 */ + -7.03119616381481654654e-02, /* 0xBFB1FFF6, 0xF7C0E24B */ + -2.40903221549529611423e+00, /* 0xC00345B2, 0xAEA48074 */ + -2.19659774734883086467e+01, /* 0xC035F74A, 0x4CB94E14 */ + -5.80791704701737572236e+01, /* 0xC04D0A22, 0x420A1A45 */ + -3.14479470594888503854e+01, /* 0xC03F72AC, 0xA892D80F */ +}; +static const double pS3[5] = { + 3.58560338055209726349e+01, /* 0x4041ED92, 0x84077DD3 */ + 3.61513983050303863820e+02, /* 0x40769839, 0x464A7C0E */ + 1.19360783792111533330e+03, /* 0x4092A66E, 0x6D1061D6 */ + 1.12799679856907414432e+03, /* 0x40919FFC, 0xB8C39B7E */ + 1.73580930813335754692e+02, /* 0x4065B296, 0xFC379081 */ +}; + +static const double pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + -8.87534333032526411254e-08, /* 0xBE77D316, 0xE927026D */ + -7.03030995483624743247e-02, /* 0xBFB1FF62, 0x495E1E42 */ + -1.45073846780952986357e+00, /* 0xBFF73639, 0x8A24A843 */ + -7.63569613823527770791e+00, /* 0xC01E8AF3, 0xEDAFA7F3 */ + -1.11931668860356747786e+01, /* 0xC02662E6, 0xC5246303 */ + -3.23364579351335335033e+00, /* 0xC009DE81, 0xAF8FE70F */ +}; +static const double pS2[5] = { + 2.22202997532088808441e+01, /* 0x40363865, 0x908B5959 */ + 1.36206794218215208048e+02, /* 0x4061069E, 0x0EE8878F */ + 2.70470278658083486789e+02, /* 0x4070E786, 0x42EA079B */ + 1.53875394208320329881e+02, /* 0x40633C03, 0x3AB6FAFF */ + 1.46576176948256193810e+01, /* 0x402D50B3, 0x44391809 */ +}; + +static double pzero(double x) +{ + const double *p,*q; + double z,r,s; + int32_t ix; + + GET_HIGH_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x40200000){p = pR8; q = pS8;} + else if (ix >= 0x40122E8B){p = pR5; q = pS5;} + else if (ix >= 0x4006DB6D){p = pR3; q = pS3;} + else if (ix >= 0x40000000){p = pR2; q = pS2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); + return one + r/s; +} + + +/* For x >= 8, the asymptotic expansions of qzero is + * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. + * We approximate pzero by + * qzero(x) = s*(-1.25 + (R/S)) + * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10 + * S = 1 + qS0*s^2 + ... + qS5*s^12 + * and + * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22) + */ +static const double qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ + 7.32421874999935051953e-02, /* 0x3FB2BFFF, 0xFFFFFE2C */ + 1.17682064682252693899e+01, /* 0x40278952, 0x5BB334D6 */ + 5.57673380256401856059e+02, /* 0x40816D63, 0x15301825 */ + 8.85919720756468632317e+03, /* 0x40C14D99, 0x3E18F46D */ + 3.70146267776887834771e+04, /* 0x40E212D4, 0x0E901566 */ +}; +static const double qS8[6] = { + 1.63776026895689824414e+02, /* 0x406478D5, 0x365B39BC */ + 8.09834494656449805916e+03, /* 0x40BFA258, 0x4E6B0563 */ + 1.42538291419120476348e+05, /* 0x41016652, 0x54D38C3F */ + 8.03309257119514397345e+05, /* 0x412883DA, 0x83A52B43 */ + 8.40501579819060512818e+05, /* 0x4129A66B, 0x28DE0B3D */ + -3.43899293537866615225e+05, /* 0xC114FD6D, 0x2C9530C5 */ +}; + +static const double qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + 1.84085963594515531381e-11, /* 0x3DB43D8F, 0x29CC8CD9 */ + 7.32421766612684765896e-02, /* 0x3FB2BFFF, 0xD172B04C */ + 5.83563508962056953777e+00, /* 0x401757B0, 0xB9953DD3 */ + 1.35111577286449829671e+02, /* 0x4060E392, 0x0A8788E9 */ + 1.02724376596164097464e+03, /* 0x40900CF9, 0x9DC8C481 */ + 1.98997785864605384631e+03, /* 0x409F17E9, 0x53C6E3A6 */ +}; +static const double qS5[6] = { + 8.27766102236537761883e+01, /* 0x4054B1B3, 0xFB5E1543 */ + 2.07781416421392987104e+03, /* 0x40A03BA0, 0xDA21C0CE */ + 1.88472887785718085070e+04, /* 0x40D267D2, 0x7B591E6D */ + 5.67511122894947329769e+04, /* 0x40EBB5E3, 0x97E02372 */ + 3.59767538425114471465e+04, /* 0x40E19118, 0x1F7A54A0 */ + -5.35434275601944773371e+03, /* 0xC0B4EA57, 0xBEDBC609 */ +}; + +static const double qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ + 4.37741014089738620906e-09, /* 0x3E32CD03, 0x6ADECB82 */ + 7.32411180042911447163e-02, /* 0x3FB2BFEE, 0x0E8D0842 */ + 3.34423137516170720929e+00, /* 0x400AC0FC, 0x61149CF5 */ + 4.26218440745412650017e+01, /* 0x40454F98, 0x962DAEDD */ + 1.70808091340565596283e+02, /* 0x406559DB, 0xE25EFD1F */ + 1.66733948696651168575e+02, /* 0x4064D77C, 0x81FA21E0 */ +}; +static const double qS3[6] = { + 4.87588729724587182091e+01, /* 0x40486122, 0xBFE343A6 */ + 7.09689221056606015736e+02, /* 0x40862D83, 0x86544EB3 */ + 3.70414822620111362994e+03, /* 0x40ACF04B, 0xE44DFC63 */ + 6.46042516752568917582e+03, /* 0x40B93C6C, 0xD7C76A28 */ + 2.51633368920368957333e+03, /* 0x40A3A8AA, 0xD94FB1C0 */ + -1.49247451836156386662e+02, /* 0xC062A7EB, 0x201CF40F */ +}; + +static const double qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + 1.50444444886983272379e-07, /* 0x3E84313B, 0x54F76BDB */ + 7.32234265963079278272e-02, /* 0x3FB2BEC5, 0x3E883E34 */ + 1.99819174093815998816e+00, /* 0x3FFFF897, 0xE727779C */ + 1.44956029347885735348e+01, /* 0x402CFDBF, 0xAAF96FE5 */ + 3.16662317504781540833e+01, /* 0x403FAA8E, 0x29FBDC4A */ + 1.62527075710929267416e+01, /* 0x403040B1, 0x71814BB4 */ +}; +static const double qS2[6] = { + 3.03655848355219184498e+01, /* 0x403E5D96, 0xF7C07AED */ + 2.69348118608049844624e+02, /* 0x4070D591, 0xE4D14B40 */ + 8.44783757595320139444e+02, /* 0x408A6645, 0x22B3BF22 */ + 8.82935845112488550512e+02, /* 0x408B977C, 0x9C5CC214 */ + 2.12666388511798828631e+02, /* 0x406A9553, 0x0E001365 */ + -5.31095493882666946917e+00, /* 0xC0153E6A, 0xF8B32931 */ +}; + +static double qzero(double x) +{ + const double *p,*q; + double s,r,z; + int32_t ix; + + GET_HIGH_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x40200000){p = qR8; q = qS8;} + else if (ix >= 0x40122E8B){p = qR5; q = qS5;} + else if (ix >= 0x4006DB6D){p = qR3; q = qS3;} + else if (ix >= 0x40000000){p = qR2; q = qS2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); + return (-.125 + r/s)/x; +} diff --git a/src/math/j0f.c b/src/math/j0f.c new file mode 100644 index 00000000..77a2d734 --- /dev/null +++ b/src/math/j0f.c @@ -0,0 +1,347 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_j0f.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static float pzerof(float), qzerof(float); + +static const float +huge = 1e30, +one = 1.0, +invsqrtpi = 5.6418961287e-01, /* 0x3f106ebb */ +tpi = 6.3661974669e-01, /* 0x3f22f983 */ +/* R0/S0 on [0, 2.00] */ +R02 = 1.5625000000e-02, /* 0x3c800000 */ +R03 = -1.8997929874e-04, /* 0xb947352e */ +R04 = 1.8295404516e-06, /* 0x35f58e88 */ +R05 = -4.6183270541e-09, /* 0xb19eaf3c */ +S01 = 1.5619102865e-02, /* 0x3c7fe744 */ +S02 = 1.1692678527e-04, /* 0x38f53697 */ +S03 = 5.1354652442e-07, /* 0x3509daa6 */ +S04 = 1.1661400734e-09; /* 0x30a045e8 */ + +static const float zero = 0.0; + +float j0f(float x) +{ + float z, s,c,ss,cc,r,u,v; + int32_t hx,ix; + + GET_FLOAT_WORD(hx, x); + ix = hx & 0x7fffffff; + if (ix >= 0x7f800000) + return one/(x*x); + x = fabsf(x); + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + s = sinf(x); + c = cosf(x); + ss = s-c; + cc = s+c; + if (ix < 0x7f000000) { /* make sure x+x does not overflow */ + z = -cosf(x+x); + if (s*c < zero) + cc = z/ss; + else + ss = z/cc; + } + /* + * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) + * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) + */ + if (ix > 0x80000000) + z = (invsqrtpi*cc)/sqrtf(x); + else { + u = pzerof(x); + v = qzerof(x); + z = invsqrtpi*(u*cc-v*ss)/sqrtf(x); + } + return z; + } + if (ix < 0x39000000) { /* |x| < 2**-13 */ + /* raise inexact if x != 0 */ + if (huge+x > one) { + if (ix < 0x32000000) /* |x| < 2**-27 */ + return one; + return one - (float)0.25*x*x; + } + } + z = x*x; + r = z*(R02+z*(R03+z*(R04+z*R05))); + s = one+z*(S01+z*(S02+z*(S03+z*S04))); + if(ix < 0x3F800000) { /* |x| < 1.00 */ + return one + z*((float)-0.25+(r/s)); + } else { + u = (float)0.5*x; + return (one+u)*(one-u) + z*(r/s); + } +} + +static const float +u00 = -7.3804296553e-02, /* 0xbd9726b5 */ +u01 = 1.7666645348e-01, /* 0x3e34e80d */ +u02 = -1.3818567619e-02, /* 0xbc626746 */ +u03 = 3.4745343146e-04, /* 0x39b62a69 */ +u04 = -3.8140706238e-06, /* 0xb67ff53c */ +u05 = 1.9559013964e-08, /* 0x32a802ba */ +u06 = -3.9820518410e-11, /* 0xae2f21eb */ +v01 = 1.2730483897e-02, /* 0x3c509385 */ +v02 = 7.6006865129e-05, /* 0x389f65e0 */ +v03 = 2.5915085189e-07, /* 0x348b216c */ +v04 = 4.4111031494e-10; /* 0x2ff280c2 */ + +float y0f(float x) +{ + float z,s,c,ss,cc,u,v; + int32_t hx,ix; + + GET_FLOAT_WORD(hx, x); + ix = 0x7fffffff & hx; + /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */ + if (ix >= 0x7f800000) + return one/(x+x*x); + if (ix == 0) + return -one/zero; + if (hx < 0) + return zero/zero; + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0)) + * where x0 = x-pi/4 + * Better formula: + * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4) + * = 1/sqrt(2) * (sin(x) + cos(x)) + * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one. + */ + s = sinf(x); + c = cosf(x); + ss = s-c; + cc = s+c; + /* + * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x) + * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x) + */ + if (ix < 0x7f000000) { /* make sure x+x not overflow */ + z = -cosf(x+x); + if (s*c < zero) + cc = z/ss; + else + ss = z/cc; + } + if (ix > 0x80000000) + z = (invsqrtpi*ss)/sqrtf(x); + else { + u = pzerof(x); + v = qzerof(x); + z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); + } + return z; + } + if (ix <= 0x32000000) { /* x < 2**-27 */ + return u00 + tpi*logf(x); + } + z = x*x; + u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06))))); + v = one+z*(v01+z*(v02+z*(v03+z*v04))); + return u/v + tpi*(j0f(x)*logf(x)); +} + +/* The asymptotic expansions of pzero is + * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x. + * For x >= 2, We approximate pzero by + * pzero(x) = 1 + (R/S) + * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10 + * S = 1 + pS0*s^2 + ... + pS4*s^10 + * and + * | pzero(x)-1-R/S | <= 2 ** ( -60.26) + */ +static const float pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.0000000000e+00, /* 0x00000000 */ + -7.0312500000e-02, /* 0xbd900000 */ + -8.0816707611e+00, /* 0xc1014e86 */ + -2.5706311035e+02, /* 0xc3808814 */ + -2.4852163086e+03, /* 0xc51b5376 */ + -5.2530439453e+03, /* 0xc5a4285a */ +}; +static const float pS8[5] = { + 1.1653436279e+02, /* 0x42e91198 */ + 3.8337448730e+03, /* 0x456f9beb */ + 4.0597855469e+04, /* 0x471e95db */ + 1.1675296875e+05, /* 0x47e4087c */ + 4.7627726562e+04, /* 0x473a0bba */ +}; +static const float pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + -1.1412546255e-11, /* 0xad48c58a */ + -7.0312492549e-02, /* 0xbd8fffff */ + -4.1596107483e+00, /* 0xc0851b88 */ + -6.7674766541e+01, /* 0xc287597b */ + -3.3123129272e+02, /* 0xc3a59d9b */ + -3.4643338013e+02, /* 0xc3ad3779 */ +}; +static const float pS5[5] = { + 6.0753936768e+01, /* 0x42730408 */ + 1.0512523193e+03, /* 0x44836813 */ + 5.9789707031e+03, /* 0x45bad7c4 */ + 9.6254453125e+03, /* 0x461665c8 */ + 2.4060581055e+03, /* 0x451660ee */ +}; + +static const float pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ + -2.5470459075e-09, /* 0xb12f081b */ + -7.0311963558e-02, /* 0xbd8fffb8 */ + -2.4090321064e+00, /* 0xc01a2d95 */ + -2.1965976715e+01, /* 0xc1afba52 */ + -5.8079170227e+01, /* 0xc2685112 */ + -3.1447946548e+01, /* 0xc1fb9565 */ +}; +static const float pS3[5] = { + 3.5856033325e+01, /* 0x420f6c94 */ + 3.6151397705e+02, /* 0x43b4c1ca */ + 1.1936077881e+03, /* 0x44953373 */ + 1.1279968262e+03, /* 0x448cffe6 */ + 1.7358093262e+02, /* 0x432d94b8 */ +}; + +static const float pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + -8.8753431271e-08, /* 0xb3be98b7 */ + -7.0303097367e-02, /* 0xbd8ffb12 */ + -1.4507384300e+00, /* 0xbfb9b1cc */ + -7.6356959343e+00, /* 0xc0f4579f */ + -1.1193166733e+01, /* 0xc1331736 */ + -3.2336456776e+00, /* 0xc04ef40d */ +}; +static const float pS2[5] = { + 2.2220300674e+01, /* 0x41b1c32d */ + 1.3620678711e+02, /* 0x430834f0 */ + 2.7047027588e+02, /* 0x43873c32 */ + 1.5387539673e+02, /* 0x4319e01a */ + 1.4657617569e+01, /* 0x416a859a */ +}; + +static float pzerof(float x) +{ + const float *p,*q; + float z,r,s; + int32_t ix; + + GET_FLOAT_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x41000000){p = pR8; q = pS8;} + else if (ix >= 0x40f71c58){p = pR5; q = pS5;} + else if (ix >= 0x4036db68){p = pR3; q = pS3;} + else if (ix >= 0x40000000){p = pR2; q = pS2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); + return one + r/s; +} + + +/* For x >= 8, the asymptotic expansions of qzero is + * -1/8 s + 75/1024 s^3 - ..., where s = 1/x. + * We approximate pzero by + * qzero(x) = s*(-1.25 + (R/S)) + * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10 + * S = 1 + qS0*s^2 + ... + qS5*s^12 + * and + * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22) + */ +static const float qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.0000000000e+00, /* 0x00000000 */ + 7.3242187500e-02, /* 0x3d960000 */ + 1.1768206596e+01, /* 0x413c4a93 */ + 5.5767340088e+02, /* 0x440b6b19 */ + 8.8591972656e+03, /* 0x460a6cca */ + 3.7014625000e+04, /* 0x471096a0 */ +}; +static const float qS8[6] = { + 1.6377603149e+02, /* 0x4323c6aa */ + 8.0983447266e+03, /* 0x45fd12c2 */ + 1.4253829688e+05, /* 0x480b3293 */ + 8.0330925000e+05, /* 0x49441ed4 */ + 8.4050156250e+05, /* 0x494d3359 */ + -3.4389928125e+05, /* 0xc8a7eb69 */ +}; + +static const float qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + 1.8408595828e-11, /* 0x2da1ec79 */ + 7.3242180049e-02, /* 0x3d95ffff */ + 5.8356351852e+00, /* 0x40babd86 */ + 1.3511157227e+02, /* 0x43071c90 */ + 1.0272437744e+03, /* 0x448067cd */ + 1.9899779053e+03, /* 0x44f8bf4b */ +}; +static const float qS5[6] = { + 8.2776611328e+01, /* 0x42a58da0 */ + 2.0778142090e+03, /* 0x4501dd07 */ + 1.8847289062e+04, /* 0x46933e94 */ + 5.6751113281e+04, /* 0x475daf1d */ + 3.5976753906e+04, /* 0x470c88c1 */ + -5.3543427734e+03, /* 0xc5a752be */ +}; + +static const float qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */ + 4.3774099900e-09, /* 0x3196681b */ + 7.3241114616e-02, /* 0x3d95ff70 */ + 3.3442313671e+00, /* 0x405607e3 */ + 4.2621845245e+01, /* 0x422a7cc5 */ + 1.7080809021e+02, /* 0x432acedf */ + 1.6673394775e+02, /* 0x4326bbe4 */ +}; +static const float qS3[6] = { + 4.8758872986e+01, /* 0x42430916 */ + 7.0968920898e+02, /* 0x44316c1c */ + 3.7041481934e+03, /* 0x4567825f */ + 6.4604252930e+03, /* 0x45c9e367 */ + 2.5163337402e+03, /* 0x451d4557 */ + -1.4924745178e+02, /* 0xc3153f59 */ +}; + +static const float qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + 1.5044444979e-07, /* 0x342189db */ + 7.3223426938e-02, /* 0x3d95f62a */ + 1.9981917143e+00, /* 0x3fffc4bf */ + 1.4495602608e+01, /* 0x4167edfd */ + 3.1666231155e+01, /* 0x41fd5471 */ + 1.6252708435e+01, /* 0x4182058c */ +}; +static const float qS2[6] = { + 3.0365585327e+01, /* 0x41f2ecb8 */ + 2.6934811401e+02, /* 0x4386ac8f */ + 8.4478375244e+02, /* 0x44533229 */ + 8.8293585205e+02, /* 0x445cbbe5 */ + 2.1266638184e+02, /* 0x4354aa98 */ + -5.3109550476e+00, /* 0xc0a9f358 */ +}; + +static float qzerof(float x) +{ + const float *p,*q; + float s,r,z; + int32_t ix; + + GET_FLOAT_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x41000000){p = qR8; q = qS8;} + else if (ix >= 0x40f71c58){p = qR5; q = qS5;} + else if (ix >= 0x4036db68){p = qR3; q = qS3;} + else if (ix >= 0x40000000){p = qR2; q = qS2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); + return (-(float).125 + r/s)/x; +} diff --git a/src/math/j1.c b/src/math/j1.c new file mode 100644 index 00000000..29ccff0c --- /dev/null +++ b/src/math/j1.c @@ -0,0 +1,385 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_j1.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* j1(x), y1(x) + * Bessel function of the first and second kinds of order zero. + * Method -- j1(x): + * 1. For tiny x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ... + * 2. Reduce x to |x| since j1(x)=-j1(-x), and + * for x in (0,2) + * j1(x) = x/2 + x*z*R0/S0, where z = x*x; + * (precision: |j1/x - 1/2 - R0/S0 |<2**-61.51 ) + * for x in (2,inf) + * j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1)) + * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) + * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) + * as follow: + * cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = -1/sqrt(2) * (sin(x) + cos(x)) + * (To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one.) + * + * 3 Special cases + * j1(nan)= nan + * j1(0) = 0 + * j1(inf) = 0 + * + * Method -- y1(x): + * 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN + * 2. For x<2. + * Since + * y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...) + * therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function. + * We use the following function to approximate y1, + * y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2 + * where for x in [0,2] (abs err less than 2**-65.89) + * U(z) = U0[0] + U0[1]*z + ... + U0[4]*z^4 + * V(z) = 1 + v0[0]*z + ... + v0[4]*z^5 + * Note: For tiny x, 1/x dominate y1 and hence + * y1(tiny) = -2/pi/tiny, (choose tiny<2**-54) + * 3. For x>=2. + * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1)) + * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1) + * by method mentioned above. + */ + +#include "libm.h" + +static double pone(double), qone(double); + +static const double +huge = 1e300, +one = 1.0, +invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ +tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */ +/* R0/S0 on [0,2] */ +r00 = -6.25000000000000000000e-02, /* 0xBFB00000, 0x00000000 */ +r01 = 1.40705666955189706048e-03, /* 0x3F570D9F, 0x98472C61 */ +r02 = -1.59955631084035597520e-05, /* 0xBEF0C5C6, 0xBA169668 */ +r03 = 4.96727999609584448412e-08, /* 0x3E6AAAFA, 0x46CA0BD9 */ +s01 = 1.91537599538363460805e-02, /* 0x3F939D0B, 0x12637E53 */ +s02 = 1.85946785588630915560e-04, /* 0x3F285F56, 0xB9CDF664 */ +s03 = 1.17718464042623683263e-06, /* 0x3EB3BFF8, 0x333F8498 */ +s04 = 5.04636257076217042715e-09, /* 0x3E35AC88, 0xC97DFF2C */ +s05 = 1.23542274426137913908e-11; /* 0x3DAB2ACF, 0xCFB97ED8 */ + +static const double zero = 0.0; + +double j1(double x) +{ + double z,s,c,ss,cc,r,u,v,y; + int32_t hx,ix; + + GET_HIGH_WORD(hx, x); + ix = hx & 0x7fffffff; + if (ix >= 0x7ff00000) + return one/x; + y = fabs(x); + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + s = sin(y); + c = cos(y); + ss = -s-c; + cc = s-c; + if (ix < 0x7fe00000) { /* make sure y+y not overflow */ + z = cos(y+y); + if (s*c > zero) + cc = z/ss; + else + ss = z/cc; + } + /* + * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) + * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) + */ + if (ix > 0x48000000) + z = (invsqrtpi*cc)/sqrt(y); + else { + u = pone(y); + v = qone(y); + z = invsqrtpi*(u*cc-v*ss)/sqrt(y); + } + if (hx < 0) + return -z; + else + return z; + } + if (ix < 0x3e400000) { /* |x| < 2**-27 */ + /* raise inexact if x!=0 */ + if (huge+x > one) + return 0.5*x; + } + z = x*x; + r = z*(r00+z*(r01+z*(r02+z*r03))); + s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05)))); + r *= x; + return x*0.5 + r/s; +} + +static const double U0[5] = { + -1.96057090646238940668e-01, /* 0xBFC91866, 0x143CBC8A */ + 5.04438716639811282616e-02, /* 0x3FA9D3C7, 0x76292CD1 */ + -1.91256895875763547298e-03, /* 0xBF5F55E5, 0x4844F50F */ + 2.35252600561610495928e-05, /* 0x3EF8AB03, 0x8FA6B88E */ + -9.19099158039878874504e-08, /* 0xBE78AC00, 0x569105B8 */ +}; +static const double V0[5] = { + 1.99167318236649903973e-02, /* 0x3F94650D, 0x3F4DA9F0 */ + 2.02552581025135171496e-04, /* 0x3F2A8C89, 0x6C257764 */ + 1.35608801097516229404e-06, /* 0x3EB6C05A, 0x894E8CA6 */ + 6.22741452364621501295e-09, /* 0x3E3ABF1D, 0x5BA69A86 */ + 1.66559246207992079114e-11, /* 0x3DB25039, 0xDACA772A */ +}; + + +double y1(double x) +{ + double z,s,c,ss,cc,u,v; + int32_t hx,ix,lx; + + EXTRACT_WORDS(hx, lx, x); + ix = 0x7fffffff & hx; + /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ + if (ix >= 0x7ff00000) + return one/(x+x*x); + if ((ix|lx) == 0) + return -one/zero; + if (hx < 0) + return zero/zero; + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + s = sin(x); + c = cos(x); + ss = -s-c; + cc = s-c; + if (ix < 0x7fe00000) { /* make sure x+x not overflow */ + z = cos(x+x); + if (s*c > zero) + cc = z/ss; + else + ss = z/cc; + } + /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) + * where x0 = x-3pi/4 + * Better formula: + * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = -1/sqrt(2) * (cos(x) + sin(x)) + * To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one. + */ + if (ix > 0x48000000) + z = (invsqrtpi*ss)/sqrt(x); + else { + u = pone(x); + v = qone(x); + z = invsqrtpi*(u*ss+v*cc)/sqrt(x); + } + return z; + } + if (ix <= 0x3c900000) /* x < 2**-54 */ + return -tpi/x; + z = x*x; + u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4]))); + v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4])))); + return x*(u/v) + tpi*(j1(x)*log(x)-one/x); +} + +/* For x >= 8, the asymptotic expansions of pone is + * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. + * We approximate pone by + * pone(x) = 1 + (R/S) + * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10 + * S = 1 + ps0*s^2 + ... + ps4*s^10 + * and + * | pone(x)-1-R/S | <= 2 ** ( -60.06) + */ + +static const double pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ + 1.17187499999988647970e-01, /* 0x3FBDFFFF, 0xFFFFFCCE */ + 1.32394806593073575129e+01, /* 0x402A7A9D, 0x357F7FCE */ + 4.12051854307378562225e+02, /* 0x4079C0D4, 0x652EA590 */ + 3.87474538913960532227e+03, /* 0x40AE457D, 0xA3A532CC */ + 7.91447954031891731574e+03, /* 0x40BEEA7A, 0xC32782DD */ +}; +static const double ps8[5] = { + 1.14207370375678408436e+02, /* 0x405C8D45, 0x8E656CAC */ + 3.65093083420853463394e+03, /* 0x40AC85DC, 0x964D274F */ + 3.69562060269033463555e+04, /* 0x40E20B86, 0x97C5BB7F */ + 9.76027935934950801311e+04, /* 0x40F7D42C, 0xB28F17BB */ + 3.08042720627888811578e+04, /* 0x40DE1511, 0x697A0B2D */ +}; + +static const double pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + 1.31990519556243522749e-11, /* 0x3DAD0667, 0xDAE1CA7D */ + 1.17187493190614097638e-01, /* 0x3FBDFFFF, 0xE2C10043 */ + 6.80275127868432871736e+00, /* 0x401B3604, 0x6E6315E3 */ + 1.08308182990189109773e+02, /* 0x405B13B9, 0x452602ED */ + 5.17636139533199752805e+02, /* 0x40802D16, 0xD052D649 */ + 5.28715201363337541807e+02, /* 0x408085B8, 0xBB7E0CB7 */ +}; +static const double ps5[5] = { + 5.92805987221131331921e+01, /* 0x404DA3EA, 0xA8AF633D */ + 9.91401418733614377743e+02, /* 0x408EFB36, 0x1B066701 */ + 5.35326695291487976647e+03, /* 0x40B4E944, 0x5706B6FB */ + 7.84469031749551231769e+03, /* 0x40BEA4B0, 0xB8A5BB15 */ + 1.50404688810361062679e+03, /* 0x40978030, 0x036F5E51 */ +}; + +static const double pr3[6] = { + 3.02503916137373618024e-09, /* 0x3E29FC21, 0xA7AD9EDD */ + 1.17186865567253592491e-01, /* 0x3FBDFFF5, 0x5B21D17B */ + 3.93297750033315640650e+00, /* 0x400F76BC, 0xE85EAD8A */ + 3.51194035591636932736e+01, /* 0x40418F48, 0x9DA6D129 */ + 9.10550110750781271918e+01, /* 0x4056C385, 0x4D2C1837 */ + 4.85590685197364919645e+01, /* 0x4048478F, 0x8EA83EE5 */ +}; +static const double ps3[5] = { + 3.47913095001251519989e+01, /* 0x40416549, 0xA134069C */ + 3.36762458747825746741e+02, /* 0x40750C33, 0x07F1A75F */ + 1.04687139975775130551e+03, /* 0x40905B7C, 0x5037D523 */ + 8.90811346398256432622e+02, /* 0x408BD67D, 0xA32E31E9 */ + 1.03787932439639277504e+02, /* 0x4059F26D, 0x7C2EED53 */ +}; + +static const double pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + 1.07710830106873743082e-07, /* 0x3E7CE9D4, 0xF65544F4 */ + 1.17176219462683348094e-01, /* 0x3FBDFF42, 0xBE760D83 */ + 2.36851496667608785174e+00, /* 0x4002F2B7, 0xF98FAEC0 */ + 1.22426109148261232917e+01, /* 0x40287C37, 0x7F71A964 */ + 1.76939711271687727390e+01, /* 0x4031B1A8, 0x177F8EE2 */ + 5.07352312588818499250e+00, /* 0x40144B49, 0xA574C1FE */ +}; +static const double ps2[5] = { + 2.14364859363821409488e+01, /* 0x40356FBD, 0x8AD5ECDC */ + 1.25290227168402751090e+02, /* 0x405F5293, 0x14F92CD5 */ + 2.32276469057162813669e+02, /* 0x406D08D8, 0xD5A2DBD9 */ + 1.17679373287147100768e+02, /* 0x405D6B7A, 0xDA1884A9 */ + 8.36463893371618283368e+00, /* 0x4020BAB1, 0xF44E5192 */ +}; + +static double pone(double x) +{ + const double *p,*q; + double z,r,s; + int32_t ix; + + GET_HIGH_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x40200000){p = pr8; q = ps8;} + else if (ix >= 0x40122E8B){p = pr5; q = ps5;} + else if (ix >= 0x4006DB6D){p = pr3; q = ps3;} + else if (ix >= 0x40000000){p = pr2; q = ps2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); + return one+ r/s; +} + +/* For x >= 8, the asymptotic expansions of qone is + * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. + * We approximate pone by + * qone(x) = s*(0.375 + (R/S)) + * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10 + * S = 1 + qs1*s^2 + ... + qs6*s^12 + * and + * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13) + */ + +static const double qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */ + -1.02539062499992714161e-01, /* 0xBFBA3FFF, 0xFFFFFDF3 */ + -1.62717534544589987888e+01, /* 0xC0304591, 0xA26779F7 */ + -7.59601722513950107896e+02, /* 0xC087BCD0, 0x53E4B576 */ + -1.18498066702429587167e+04, /* 0xC0C724E7, 0x40F87415 */ + -4.84385124285750353010e+04, /* 0xC0E7A6D0, 0x65D09C6A */ +}; +static const double qs8[6] = { + 1.61395369700722909556e+02, /* 0x40642CA6, 0xDE5BCDE5 */ + 7.82538599923348465381e+03, /* 0x40BE9162, 0xD0D88419 */ + 1.33875336287249578163e+05, /* 0x4100579A, 0xB0B75E98 */ + 7.19657723683240939863e+05, /* 0x4125F653, 0x72869C19 */ + 6.66601232617776375264e+05, /* 0x412457D2, 0x7719AD5C */ + -2.94490264303834643215e+05, /* 0xC111F969, 0x0EA5AA18 */ +}; + +static const double qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + -2.08979931141764104297e-11, /* 0xBDB6FA43, 0x1AA1A098 */ + -1.02539050241375426231e-01, /* 0xBFBA3FFF, 0xCB597FEF */ + -8.05644828123936029840e+00, /* 0xC0201CE6, 0xCA03AD4B */ + -1.83669607474888380239e+02, /* 0xC066F56D, 0x6CA7B9B0 */ + -1.37319376065508163265e+03, /* 0xC09574C6, 0x6931734F */ + -2.61244440453215656817e+03, /* 0xC0A468E3, 0x88FDA79D */ +}; +static const double qs5[6] = { + 8.12765501384335777857e+01, /* 0x405451B2, 0xFF5A11B2 */ + 1.99179873460485964642e+03, /* 0x409F1F31, 0xE77BF839 */ + 1.74684851924908907677e+04, /* 0x40D10F1F, 0x0D64CE29 */ + 4.98514270910352279316e+04, /* 0x40E8576D, 0xAABAD197 */ + 2.79480751638918118260e+04, /* 0x40DB4B04, 0xCF7C364B */ + -4.71918354795128470869e+03, /* 0xC0B26F2E, 0xFCFFA004 */ +}; + +static const double qr3[6] = { + -5.07831226461766561369e-09, /* 0xBE35CFA9, 0xD38FC84F */ + -1.02537829820837089745e-01, /* 0xBFBA3FEB, 0x51AEED54 */ + -4.61011581139473403113e+00, /* 0xC01270C2, 0x3302D9FF */ + -5.78472216562783643212e+01, /* 0xC04CEC71, 0xC25D16DA */ + -2.28244540737631695038e+02, /* 0xC06C87D3, 0x4718D55F */ + -2.19210128478909325622e+02, /* 0xC06B66B9, 0x5F5C1BF6 */ +}; +static const double qs3[6] = { + 4.76651550323729509273e+01, /* 0x4047D523, 0xCCD367E4 */ + 6.73865112676699709482e+02, /* 0x40850EEB, 0xC031EE3E */ + 3.38015286679526343505e+03, /* 0x40AA684E, 0x448E7C9A */ + 5.54772909720722782367e+03, /* 0x40B5ABBA, 0xA61D54A6 */ + 1.90311919338810798763e+03, /* 0x409DBC7A, 0x0DD4DF4B */ + -1.35201191444307340817e+02, /* 0xC060E670, 0x290A311F */ +}; + +static const double qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + -1.78381727510958865572e-07, /* 0xBE87F126, 0x44C626D2 */ + -1.02517042607985553460e-01, /* 0xBFBA3E8E, 0x9148B010 */ + -2.75220568278187460720e+00, /* 0xC0060484, 0x69BB4EDA */ + -1.96636162643703720221e+01, /* 0xC033A9E2, 0xC168907F */ + -4.23253133372830490089e+01, /* 0xC04529A3, 0xDE104AAA */ + -2.13719211703704061733e+01, /* 0xC0355F36, 0x39CF6E52 */ +}; +static const double qs2[6] = { + 2.95333629060523854548e+01, /* 0x403D888A, 0x78AE64FF */ + 2.52981549982190529136e+02, /* 0x406F9F68, 0xDB821CBA */ + 7.57502834868645436472e+02, /* 0x4087AC05, 0xCE49A0F7 */ + 7.39393205320467245656e+02, /* 0x40871B25, 0x48D4C029 */ + 1.55949003336666123687e+02, /* 0x40637E5E, 0x3C3ED8D4 */ + -4.95949898822628210127e+00, /* 0xC013D686, 0xE71BE86B */ +}; + +static double qone(double x) +{ + const double *p,*q; + double s,r,z; + int32_t ix; + + GET_HIGH_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x40200000){p = qr8; q = qs8;} + else if (ix >= 0x40122E8B){p = qr5; q = qs5;} + else if (ix >= 0x4006DB6D){p = qr3; q = qs3;} + else if (ix >= 0x40000000){p = qr2; q = qs2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); + return (.375 + r/s)/x; +} diff --git a/src/math/j1f.c b/src/math/j1f.c new file mode 100644 index 00000000..0323ec78 --- /dev/null +++ b/src/math/j1f.c @@ -0,0 +1,342 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_j1f.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static float ponef(float), qonef(float); + +static const float +huge = 1e30, +one = 1.0, +invsqrtpi = 5.6418961287e-01, /* 0x3f106ebb */ +tpi = 6.3661974669e-01, /* 0x3f22f983 */ +/* R0/S0 on [0,2] */ +r00 = -6.2500000000e-02, /* 0xbd800000 */ +r01 = 1.4070566976e-03, /* 0x3ab86cfd */ +r02 = -1.5995563444e-05, /* 0xb7862e36 */ +r03 = 4.9672799207e-08, /* 0x335557d2 */ +s01 = 1.9153760746e-02, /* 0x3c9ce859 */ +s02 = 1.8594678841e-04, /* 0x3942fab6 */ +s03 = 1.1771846857e-06, /* 0x359dffc2 */ +s04 = 5.0463624390e-09, /* 0x31ad6446 */ +s05 = 1.2354227016e-11; /* 0x2d59567e */ + +static const float zero = 0.0; + +float j1f(float x) +{ + float z,s,c,ss,cc,r,u,v,y; + int32_t hx,ix; + + GET_FLOAT_WORD(hx, x); + ix = hx & 0x7fffffff; + if (ix >= 0x7f800000) + return one/x; + y = fabsf(x); + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + s = sinf(y); + c = cosf(y); + ss = -s-c; + cc = s-c; + if (ix < 0x7f000000) { /* make sure y+y not overflow */ + z = cosf(y+y); + if (s*c > zero) + cc = z/ss; + else + ss = z/cc; + } + /* + * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x) + * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x) + */ + if (ix > 0x80000000) + z = (invsqrtpi*cc)/sqrtf(y); + else { + u = ponef(y); + v = qonef(y); + z = invsqrtpi*(u*cc-v*ss)/sqrtf(y); + } + if (hx < 0) + return -z; + return z; + } + if (ix < 0x32000000) { /* |x| < 2**-27 */ + /* raise inexact if x!=0 */ + if (huge+x > one) + return (float)0.5*x; + } + z = x*x; + r = z*(r00+z*(r01+z*(r02+z*r03))); + s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05)))); + r *= x; + return x*(float)0.5 + r/s; +} + +static const float U0[5] = { + -1.9605709612e-01, /* 0xbe48c331 */ + 5.0443872809e-02, /* 0x3d4e9e3c */ + -1.9125689287e-03, /* 0xbafaaf2a */ + 2.3525259166e-05, /* 0x37c5581c */ + -9.1909917899e-08, /* 0xb3c56003 */ +}; +static const float V0[5] = { + 1.9916731864e-02, /* 0x3ca3286a */ + 2.0255257550e-04, /* 0x3954644b */ + 1.3560879779e-06, /* 0x35b602d4 */ + 6.2274145840e-09, /* 0x31d5f8eb */ + 1.6655924903e-11, /* 0x2d9281cf */ +}; + +float y1f(float x) +{ + float z,s,c,ss,cc,u,v; + int32_t hx,ix; + + GET_FLOAT_WORD(hx, x); + ix = 0x7fffffff & hx; + /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */ + if (ix >= 0x7f800000) + return one/(x+x*x); + if (ix == 0) + return -one/zero; + if (hx < 0) + return zero/zero; + if (ix >= 0x40000000) { /* |x| >= 2.0 */ + s = sinf(x); + c = cosf(x); + ss = -s-c; + cc = s-c; + if (ix < 0x7f000000) { /* make sure x+x not overflow */ + z = cosf(x+x); + if (s*c > zero) + cc = z/ss; + else + ss = z/cc; + } + /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0)) + * where x0 = x-3pi/4 + * Better formula: + * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4) + * = 1/sqrt(2) * (sin(x) - cos(x)) + * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4) + * = -1/sqrt(2) * (cos(x) + sin(x)) + * To avoid cancellation, use + * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x)) + * to compute the worse one. + */ + if (ix > 0x48000000) + z = (invsqrtpi*ss)/sqrtf(x); + else { + u = ponef(x); + v = qonef(x); + z = invsqrtpi*(u*ss+v*cc)/sqrtf(x); + } + return z; + } + if (ix <= 0x24800000) /* x < 2**-54 */ + return -tpi/x; + z = x*x; + u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4]))); + v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4])))); + return x*(u/v) + tpi*(j1f(x)*logf(x)-one/x); +} + +/* For x >= 8, the asymptotic expansions of pone is + * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x. + * We approximate pone by + * pone(x) = 1 + (R/S) + * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10 + * S = 1 + ps0*s^2 + ... + ps4*s^10 + * and + * | pone(x)-1-R/S | <= 2 ** ( -60.06) + */ + +static const float pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.0000000000e+00, /* 0x00000000 */ + 1.1718750000e-01, /* 0x3df00000 */ + 1.3239480972e+01, /* 0x4153d4ea */ + 4.1205184937e+02, /* 0x43ce06a3 */ + 3.8747453613e+03, /* 0x45722bed */ + 7.9144794922e+03, /* 0x45f753d6 */ +}; +static const float ps8[5] = { + 1.1420736694e+02, /* 0x42e46a2c */ + 3.6509309082e+03, /* 0x45642ee5 */ + 3.6956207031e+04, /* 0x47105c35 */ + 9.7602796875e+04, /* 0x47bea166 */ + 3.0804271484e+04, /* 0x46f0a88b */ +}; + +static const float pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + 1.3199052094e-11, /* 0x2d68333f */ + 1.1718749255e-01, /* 0x3defffff */ + 6.8027510643e+00, /* 0x40d9b023 */ + 1.0830818176e+02, /* 0x42d89dca */ + 5.1763616943e+02, /* 0x440168b7 */ + 5.2871520996e+02, /* 0x44042dc6 */ +}; +static const float ps5[5] = { + 5.9280597687e+01, /* 0x426d1f55 */ + 9.9140142822e+02, /* 0x4477d9b1 */ + 5.3532670898e+03, /* 0x45a74a23 */ + 7.8446904297e+03, /* 0x45f52586 */ + 1.5040468750e+03, /* 0x44bc0180 */ +}; + +static const float pr3[6] = { + 3.0250391081e-09, /* 0x314fe10d */ + 1.1718686670e-01, /* 0x3defffab */ + 3.9329774380e+00, /* 0x407bb5e7 */ + 3.5119403839e+01, /* 0x420c7a45 */ + 9.1055007935e+01, /* 0x42b61c2a */ + 4.8559066772e+01, /* 0x42423c7c */ +}; +static const float ps3[5] = { + 3.4791309357e+01, /* 0x420b2a4d */ + 3.3676245117e+02, /* 0x43a86198 */ + 1.0468714600e+03, /* 0x4482dbe3 */ + 8.9081134033e+02, /* 0x445eb3ed */ + 1.0378793335e+02, /* 0x42cf936c */ +}; + +static const float pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + 1.0771083225e-07, /* 0x33e74ea8 */ + 1.1717621982e-01, /* 0x3deffa16 */ + 2.3685150146e+00, /* 0x401795c0 */ + 1.2242610931e+01, /* 0x4143e1bc */ + 1.7693971634e+01, /* 0x418d8d41 */ + 5.0735230446e+00, /* 0x40a25a4d */ +}; +static const float ps2[5] = { + 2.1436485291e+01, /* 0x41ab7dec */ + 1.2529022980e+02, /* 0x42fa9499 */ + 2.3227647400e+02, /* 0x436846c7 */ + 1.1767937469e+02, /* 0x42eb5bd7 */ + 8.3646392822e+00, /* 0x4105d590 */ +}; + +static float ponef(float x) +{ + const float *p,*q; + float z,r,s; + int32_t ix; + + GET_FLOAT_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x41000000){p = pr8; q = ps8;} + else if (ix >= 0x40f71c58){p = pr5; q = ps5;} + else if (ix >= 0x4036db68){p = pr3; q = ps3;} + else if (ix >= 0x40000000){p = pr2; q = ps2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4])))); + return one + r/s; +} + +/* For x >= 8, the asymptotic expansions of qone is + * 3/8 s - 105/1024 s^3 - ..., where s = 1/x. + * We approximate pone by + * qone(x) = s*(0.375 + (R/S)) + * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10 + * S = 1 + qs1*s^2 + ... + qs6*s^12 + * and + * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13) + */ + +static const float qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */ + 0.0000000000e+00, /* 0x00000000 */ + -1.0253906250e-01, /* 0xbdd20000 */ + -1.6271753311e+01, /* 0xc1822c8d */ + -7.5960174561e+02, /* 0xc43de683 */ + -1.1849806641e+04, /* 0xc639273a */ + -4.8438511719e+04, /* 0xc73d3683 */ +}; +static const float qs8[6] = { + 1.6139537048e+02, /* 0x43216537 */ + 7.8253862305e+03, /* 0x45f48b17 */ + 1.3387534375e+05, /* 0x4802bcd6 */ + 7.1965775000e+05, /* 0x492fb29c */ + 6.6660125000e+05, /* 0x4922be94 */ + -2.9449025000e+05, /* 0xc88fcb48 */ +}; + +static const float qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */ + -2.0897993405e-11, /* 0xadb7d219 */ + -1.0253904760e-01, /* 0xbdd1fffe */ + -8.0564479828e+00, /* 0xc100e736 */ + -1.8366960144e+02, /* 0xc337ab6b */ + -1.3731937256e+03, /* 0xc4aba633 */ + -2.6124443359e+03, /* 0xc523471c */ +}; +static const float qs5[6] = { + 8.1276550293e+01, /* 0x42a28d98 */ + 1.9917987061e+03, /* 0x44f8f98f */ + 1.7468484375e+04, /* 0x468878f8 */ + 4.9851425781e+04, /* 0x4742bb6d */ + 2.7948074219e+04, /* 0x46da5826 */ + -4.7191835938e+03, /* 0xc5937978 */ +}; + +static const float qr3[6] = { + -5.0783124372e-09, /* 0xb1ae7d4f */ + -1.0253783315e-01, /* 0xbdd1ff5b */ + -4.6101160049e+00, /* 0xc0938612 */ + -5.7847221375e+01, /* 0xc267638e */ + -2.2824453735e+02, /* 0xc3643e9a */ + -2.1921012878e+02, /* 0xc35b35cb */ +}; +static const float qs3[6] = { + 4.7665153503e+01, /* 0x423ea91e */ + 6.7386511230e+02, /* 0x4428775e */ + 3.3801528320e+03, /* 0x45534272 */ + 5.5477290039e+03, /* 0x45ad5dd5 */ + 1.9031191406e+03, /* 0x44ede3d0 */ + -1.3520118713e+02, /* 0xc3073381 */ +}; + +static const float qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */ + -1.7838172539e-07, /* 0xb43f8932 */ + -1.0251704603e-01, /* 0xbdd1f475 */ + -2.7522056103e+00, /* 0xc0302423 */ + -1.9663616180e+01, /* 0xc19d4f16 */ + -4.2325313568e+01, /* 0xc2294d1f */ + -2.1371921539e+01, /* 0xc1aaf9b2 */ +}; +static const float qs2[6] = { + 2.9533363342e+01, /* 0x41ec4454 */ + 2.5298155212e+02, /* 0x437cfb47 */ + 7.5750280762e+02, /* 0x443d602e */ + 7.3939318848e+02, /* 0x4438d92a */ + 1.5594900513e+02, /* 0x431bf2f2 */ + -4.9594988823e+00, /* 0xc09eb437 */ +}; + +static float qonef(float x) +{ + const float *p,*q; + float s,r,z; + int32_t ix; + + GET_FLOAT_WORD(ix, x); + ix &= 0x7fffffff; + if (ix >= 0x40200000){p = qr8; q = qs8;} + else if (ix >= 0x40f71c58){p = qr5; q = qs5;} + else if (ix >= 0x4036db68){p = qr3; q = qs3;} + else if (ix >= 0x40000000){p = qr2; q = qs2;} + z = one/(x*x); + r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5])))); + s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5]))))); + return ((float).375 + r/s)/x; +} diff --git a/src/math/jn.c b/src/math/jn.c new file mode 100644 index 00000000..082a17bc --- /dev/null +++ b/src/math/jn.c @@ -0,0 +1,282 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_jn.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * jn(n, x), yn(n, x) + * floating point Bessel's function of the 1st and 2nd kind + * of order n + * + * Special cases: + * y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal; + * y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal. + * Note 2. About jn(n,x), yn(n,x) + * For n=0, j0(x) is called, + * for n=1, j1(x) is called, + * for n<x, forward recursion us used starting + * from values of j0(x) and j1(x). + * for n>x, a continued fraction approximation to + * j(n,x)/j(n-1,x) is evaluated and then backward + * recursion is used starting from a supposed value + * for j(n,x). The resulting value of j(0,x) is + * compared with the actual value to correct the + * supposed value of j(n,x). + * + * yn(n,x) is similar in all respects, except + * that forward recursion is used for all + * values of n>1. + * + */ + +#include "libm.h" + +static const double +invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */ +two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */ +one = 1.00000000000000000000e+00; /* 0x3FF00000, 0x00000000 */ + +static const double zero = 0.00000000000000000000e+00; + +double jn(int n, double x) +{ + int32_t i,hx,ix,lx,sgn; + double a, b, temp, di; + double z, w; + + /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) + * Thus, J(-n,x) = J(n,-x) + */ + EXTRACT_WORDS(hx, lx, x); + ix = 0x7fffffff & hx; + /* if J(n,NaN) is NaN */ + if ((ix|((uint32_t)(lx|-lx))>>31) > 0x7ff00000) + return x+x; + if (n < 0) { + n = -n; + x = -x; + hx ^= 0x80000000; + } + if (n == 0) return j0(x); + if (n == 1) return j1(x); + + sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */ + x = fabs(x); + if ((ix|lx) == 0 || ix >= 0x7ff00000) /* if x is 0 or inf */ + b = zero; + else if ((double)n <= x) { + /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ + if (ix >= 0x52D00000) { /* x > 2**302 */ + /* (x >> n**2) + * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Let s=sin(x), c=cos(x), + * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then + * + * n sin(xn)*sqt2 cos(xn)*sqt2 + * ---------------------------------- + * 0 s-c c+s + * 1 -s-c -c+s + * 2 -s+c -c-s + * 3 s+c c-s + */ + switch(n&3) { + case 0: temp = cos(x)+sin(x); break; + case 1: temp = -cos(x)+sin(x); break; + case 2: temp = -cos(x)-sin(x); break; + case 3: temp = cos(x)-sin(x); break; + } + b = invsqrtpi*temp/sqrt(x); + } else { + a = j0(x); + b = j1(x); + for (i=1; i<n; i++){ + temp = b; + b = b*((double)(i+i)/x) - a; /* avoid underflow */ + a = temp; + } + } + } else { + if (ix < 0x3e100000) { /* x < 2**-29 */ + /* x is tiny, return the first Taylor expansion of J(n,x) + * J(n,x) = 1/n!*(x/2)^n - ... + */ + if (n > 33) /* underflow */ + b = zero; + else { + temp = x*0.5; + b = temp; + for (a=one,i=2; i<=n; i++) { + a *= (double)i; /* a = n! */ + b *= temp; /* b = (x/2)^n */ + } + b = b/a; + } + } else { + /* use backward recurrence */ + /* x x^2 x^2 + * J(n,x)/J(n-1,x) = ---- ------ ------ ..... + * 2n - 2(n+1) - 2(n+2) + * + * 1 1 1 + * (for large x) = ---- ------ ------ ..... + * 2n 2(n+1) 2(n+2) + * -- - ------ - ------ - + * x x x + * + * Let w = 2n/x and h=2/x, then the above quotient + * is equal to the continued fraction: + * 1 + * = ----------------------- + * 1 + * w - ----------------- + * 1 + * w+h - --------- + * w+2h - ... + * + * To determine how many terms needed, let + * Q(0) = w, Q(1) = w(w+h) - 1, + * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), + * When Q(k) > 1e4 good for single + * When Q(k) > 1e9 good for double + * When Q(k) > 1e17 good for quadruple + */ + /* determine k */ + double t,v; + double q0,q1,h,tmp; + int32_t k,m; + + w = (n+n)/(double)x; h = 2.0/(double)x; + q0 = w; + z = w+h; + q1 = w*z - 1.0; + k = 1; + while (q1 < 1.0e9) { + k += 1; + z += h; + tmp = z*q1 - q0; + q0 = q1; + q1 = tmp; + } + m = n+n; + for (t=zero, i = 2*(n+k); i>=m; i -= 2) + t = one/(i/x-t); + a = t; + b = one; + /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) + * Hence, if n*(log(2n/x)) > ... + * single 8.8722839355e+01 + * double 7.09782712893383973096e+02 + * long double 1.1356523406294143949491931077970765006170e+04 + * then recurrent value may overflow and the result is + * likely underflow to zero + */ + tmp = n; + v = two/x; + tmp = tmp*log(fabs(v*tmp)); + if (tmp < 7.09782712893383973096e+02) { + for (i=n-1,di=(double)(i+i); i>0; i--) { + temp = b; + b *= di; + b = b/x - a; + a = temp; + di -= two; + } + } else { + for (i=n-1,di=(double)(i+i); i>0; i--) { + temp = b; + b *= di; + b = b/x - a; + a = temp; + di -= two; + /* scale b to avoid spurious overflow */ + if (b > 1e100) { + a /= b; + t /= b; + b = one; + } + } + } + z = j0(x); + w = j1(x); + if (fabs(z) >= fabs(w)) + b = t*z/b; + else + b = t*w/a; + } + } + if (sgn==1) return -b; + return b; +} + + + +double yn(int n, double x) +{ + int32_t i,hx,ix,lx; + int32_t sign; + double a, b, temp; + + EXTRACT_WORDS(hx, lx, x); + ix = 0x7fffffff & hx; + /* if Y(n,NaN) is NaN */ + if ((ix|((uint32_t)(lx|-lx))>>31) > 0x7ff00000) + return x+x; + if ((ix|lx) == 0) + return -one/zero; + if (hx < 0) + return zero/zero; + sign = 1; + if (n < 0) { + n = -n; + sign = 1 - ((n&1)<<1); + } + if (n == 0) + return y0(x); + if (n == 1) + return sign*y1(x); + if (ix == 0x7ff00000) + return zero; + if (ix >= 0x52D00000) { /* x > 2**302 */ + /* (x >> n**2) + * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi) + * Let s=sin(x), c=cos(x), + * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then + * + * n sin(xn)*sqt2 cos(xn)*sqt2 + * ---------------------------------- + * 0 s-c c+s + * 1 -s-c -c+s + * 2 -s+c -c-s + * 3 s+c c-s + */ + switch(n&3) { + case 0: temp = sin(x)-cos(x); break; + case 1: temp = -sin(x)-cos(x); break; + case 2: temp = -sin(x)+cos(x); break; + case 3: temp = sin(x)+cos(x); break; + } + b = invsqrtpi*temp/sqrt(x); + } else { + uint32_t high; + a = y0(x); + b = y1(x); + /* quit if b is -inf */ + GET_HIGH_WORD(high, b); + for (i=1; i<n && high!=0xfff00000; i++){ + temp = b; + b = ((double)(i+i)/x)*b - a; + GET_HIGH_WORD(high, b); + a = temp; + } + } + if (sign > 0) return b; + return -b; +} diff --git a/src/math/jnf.c b/src/math/jnf.c new file mode 100644 index 00000000..7db93ae7 --- /dev/null +++ b/src/math/jnf.c @@ -0,0 +1,213 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_jnf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +two = 2.0000000000e+00, /* 0x40000000 */ +one = 1.0000000000e+00; /* 0x3F800000 */ + +static const float zero = 0.0000000000e+00; + +float jnf(int n, float x) +{ + int32_t i,hx,ix, sgn; + float a, b, temp, di; + float z, w; + + /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x) + * Thus, J(-n,x) = J(n,-x) + */ + GET_FLOAT_WORD(hx, x); + ix = 0x7fffffff & hx; + /* if J(n,NaN) is NaN */ + if (ix > 0x7f800000) + return x+x; + if (n < 0) { + n = -n; + x = -x; + hx ^= 0x80000000; + } + if (n == 0) return j0f(x); + if (n == 1) return j1f(x); + + sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */ + x = fabsf(x); + if (ix == 0 || ix >= 0x7f800000) /* if x is 0 or inf */ + b = zero; + else if((float)n <= x) { + /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */ + a = j0f(x); + b = j1f(x); + for (i=1; i<n; i++){ + temp = b; + b = b*((float)(i+i)/x) - a; /* avoid underflow */ + a = temp; + } + } else { + if (ix < 0x30800000) { /* x < 2**-29 */ + /* x is tiny, return the first Taylor expansion of J(n,x) + * J(n,x) = 1/n!*(x/2)^n - ... + */ + if (n > 33) /* underflow */ + b = zero; + else { + temp = x*(float)0.5; + b = temp; + for (a=one,i=2; i<=n; i++) { + a *= (float)i; /* a = n! */ + b *= temp; /* b = (x/2)^n */ + } + b = b/a; + } + } else { + /* use backward recurrence */ + /* x x^2 x^2 + * J(n,x)/J(n-1,x) = ---- ------ ------ ..... + * 2n - 2(n+1) - 2(n+2) + * + * 1 1 1 + * (for large x) = ---- ------ ------ ..... + * 2n 2(n+1) 2(n+2) + * -- - ------ - ------ - + * x x x + * + * Let w = 2n/x and h=2/x, then the above quotient + * is equal to the continued fraction: + * 1 + * = ----------------------- + * 1 + * w - ----------------- + * 1 + * w+h - --------- + * w+2h - ... + * + * To determine how many terms needed, let + * Q(0) = w, Q(1) = w(w+h) - 1, + * Q(k) = (w+k*h)*Q(k-1) - Q(k-2), + * When Q(k) > 1e4 good for single + * When Q(k) > 1e9 good for double + * When Q(k) > 1e17 good for quadruple + */ + /* determine k */ + float t,v; + float q0,q1,h,tmp; + int32_t k,m; + + w = (n+n)/(float)x; + h = (float)2.0/(float)x; + z = w+h; + q0 = w; + q1 = w*z - (float)1.0; + k = 1; + while (q1 < (float)1.0e9) { + k += 1; + z += h; + tmp = z*q1 - q0; + q0 = q1; + q1 = tmp; + } + m = n+n; + for (t=zero, i = 2*(n+k); i>=m; i -= 2) + t = one/(i/x-t); + a = t; + b = one; + /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n) + * Hence, if n*(log(2n/x)) > ... + * single 8.8722839355e+01 + * double 7.09782712893383973096e+02 + * long double 1.1356523406294143949491931077970765006170e+04 + * then recurrent value may overflow and the result is + * likely underflow to zero + */ + tmp = n; + v = two/x; + tmp = tmp*logf(fabsf(v*tmp)); + if (tmp < (float)8.8721679688e+01) { + for (i=n-1,di=(float)(i+i); i>0; i--) { + temp = b; + b *= di; + b = b/x - a; + a = temp; + di -= two; + } + } else { + for (i=n-1,di=(float)(i+i); i>0; i--){ + temp = b; + b *= di; + b = b/x - a; + a = temp; + di -= two; + /* scale b to avoid spurious overflow */ + if (b > (float)1e10) { + a /= b; + t /= b; + b = one; + } + } + } + z = j0f(x); + w = j1f(x); + if (fabsf(z) >= fabsf(w)) + b = t*z/b; + else + b = t*w/a; + } + } + if (sgn == 1) return -b; + return b; +} + +float ynf(int n, float x) +{ + int32_t i,hx,ix,ib; + int32_t sign; + float a, b, temp; + + GET_FLOAT_WORD(hx, x); + ix = 0x7fffffff & hx; + /* if Y(n,NaN) is NaN */ + if (ix > 0x7f800000) + return x+x; + if (ix == 0) + return -one/zero; + if (hx < 0) + return zero/zero; + sign = 1; + if (n < 0) { + n = -n; + sign = 1 - ((n&1)<<1); + } + if (n == 0) + return y0f(x); + if (n == 1) + return sign*y1f(x); + if (ix == 0x7f800000) + return zero; + + a = y0f(x); + b = y1f(x); + /* quit if b is -inf */ + GET_FLOAT_WORD(ib,b); + for (i = 1; i < n && ib != 0xff800000; i++){ + temp = b; + b = ((float)(i+i)/x)*b - a; + GET_FLOAT_WORD(ib, b); + a = temp; + } + if (sign > 0) + return b; + return -b; +} diff --git a/src/math/k_cosf.c b/src/math/k_cosf.c deleted file mode 100644 index 61dc3749..00000000 --- a/src/math/k_cosf.c +++ /dev/null @@ -1,52 +0,0 @@ -/* k_cosf.c -- float version of k_cos.c - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -one = 1.0000000000e+00, /* 0x3f800000 */ -C1 = 4.1666667908e-02, /* 0x3d2aaaab */ -C2 = -1.3888889225e-03, /* 0xbab60b61 */ -C3 = 2.4801587642e-05, /* 0x37d00d01 */ -C4 = -2.7557314297e-07, /* 0xb493f27c */ -C5 = 2.0875723372e-09, /* 0x310f74f6 */ -C6 = -1.1359647598e-11; /* 0xad47d74e */ - -float -__kernel_cosf(float x, float y) -{ - float a,hz,z,r,qx; - int32_t ix; - GET_FLOAT_WORD(ix,x); - ix &= 0x7fffffff; /* ix = |x|'s high word*/ - if(ix<0x32000000) { /* if x < 2**27 */ - if(((int)x)==0) return one; /* generate inexact */ - } - z = x*x; - r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6))))); - if(ix < 0x3e99999a) /* if |x| < 0.3 */ - return one - ((float)0.5*z - (z*r - x*y)); - else { - if(ix > 0x3f480000) { /* x > 0.78125 */ - qx = (float)0.28125; - } else { - SET_FLOAT_WORD(qx,ix-0x01000000); /* x/4 */ - } - hz = (float)0.5*z-qx; - a = one-qx; - return a - (hz - (z*r-x*y)); - } -} diff --git a/src/math/k_rem_pio2.c b/src/math/k_rem_pio2.c deleted file mode 100644 index d993e4f2..00000000 --- a/src/math/k_rem_pio2.c +++ /dev/null @@ -1,300 +0,0 @@ - -/* @(#)k_rem_pio2.c 1.3 95/01/18 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunSoft, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * __kernel_rem_pio2(x,y,e0,nx,prec,ipio2) - * double x[],y[]; int e0,nx,prec; int ipio2[]; - * - * __kernel_rem_pio2 return the last three digits of N with - * y = x - N*pi/2 - * so that |y| < pi/2. - * - * The method is to compute the integer (mod 8) and fraction parts of - * (2/pi)*x without doing the full multiplication. In general we - * skip the part of the product that are known to be a huge integer ( - * more accurately, = 0 mod 8 ). Thus the number of operations are - * independent of the exponent of the input. - * - * (2/pi) is represented by an array of 24-bit integers in ipio2[]. - * - * Input parameters: - * x[] The input value (must be positive) is broken into nx - * pieces of 24-bit integers in double precision format. - * x[i] will be the i-th 24 bit of x. The scaled exponent - * of x[0] is given in input parameter e0 (i.e., x[0]*2^e0 - * match x's up to 24 bits. - * - * Example of breaking a double positive z into x[0]+x[1]+x[2]: - * e0 = ilogb(z)-23 - * z = scalbn(z,-e0) - * for i = 0,1,2 - * x[i] = floor(z) - * z = (z-x[i])*2**24 - * - * - * y[] ouput result in an array of double precision numbers. - * The dimension of y[] is: - * 24-bit precision 1 - * 53-bit precision 2 - * 64-bit precision 2 - * 113-bit precision 3 - * The actual value is the sum of them. Thus for 113-bit - * precison, one may have to do something like: - * - * long double t,w,r_head, r_tail; - * t = (long double)y[2] + (long double)y[1]; - * w = (long double)y[0]; - * r_head = t+w; - * r_tail = w - (r_head - t); - * - * e0 The exponent of x[0] - * - * nx dimension of x[] - * - * prec an integer indicating the precision: - * 0 24 bits (single) - * 1 53 bits (double) - * 2 64 bits (extended) - * 3 113 bits (quad) - * - * ipio2[] - * integer array, contains the (24*i)-th to (24*i+23)-th - * bit of 2/pi after binary point. The corresponding - * floating value is - * - * ipio2[i] * 2^(-24(i+1)). - * - * External function: - * double scalbn(), floor(); - * - * - * Here is the description of some local variables: - * - * jk jk+1 is the initial number of terms of ipio2[] needed - * in the computation. The recommended value is 2,3,4, - * 6 for single, double, extended,and quad. - * - * jz local integer variable indicating the number of - * terms of ipio2[] used. - * - * jx nx - 1 - * - * jv index for pointing to the suitable ipio2[] for the - * computation. In general, we want - * ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8 - * is an integer. Thus - * e0-3-24*jv >= 0 or (e0-3)/24 >= jv - * Hence jv = max(0,(e0-3)/24). - * - * jp jp+1 is the number of terms in PIo2[] needed, jp = jk. - * - * q[] double array with integral value, representing the - * 24-bits chunk of the product of x and 2/pi. - * - * q0 the corresponding exponent of q[0]. Note that the - * exponent for q[i] would be q0-24*i. - * - * PIo2[] double precision array, obtained by cutting pi/2 - * into 24 bits chunks. - * - * f[] ipio2[] in floating point - * - * iq[] integer array by breaking up q[] in 24-bits chunk. - * - * fq[] final product of x*(2/pi) in fq[0],..,fq[jk] - * - * ih integer. If >0 it indicates q[] is >= 0.5, hence - * it also indicates the *sign* of the result. - * - */ - - -/* - * Constants: - * The hexadecimal values are the intended ones for the following - * constants. The decimal values may be used, provided that the - * compiler will convert from decimal to binary accurately enough - * to produce the hexadecimal values shown. - */ - -#include <math.h> -#include "math_private.h" - -static const int init_jk[] = {2,3,4,6}; /* initial value for jk */ - -static const double PIo2[] = { - 1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */ - 7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */ - 5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */ - 3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */ - 1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */ - 1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */ - 2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */ - 2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */ -}; - -static const double -zero = 0.0, -one = 1.0, -two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */ -twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */ - - int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec, const int32_t *ipio2) -{ - int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih; - double z,fw,f[20],fq[20],q[20]; - - /* initialize jk*/ - jk = init_jk[prec]; - jp = jk; - - /* determine jx,jv,q0, note that 3>q0 */ - jx = nx-1; - jv = (e0-3)/24; if(jv<0) jv=0; - q0 = e0-24*(jv+1); - - /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */ - j = jv-jx; m = jx+jk; - for(i=0;i<=m;i++,j++) f[i] = (j<0)? zero : (double) ipio2[j]; - - /* compute q[0],q[1],...q[jk] */ - for (i=0;i<=jk;i++) { - for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw; - } - - jz = jk; -recompute: - /* distill q[] into iq[] reversingly */ - for(i=0,j=jz,z=q[jz];j>0;i++,j--) { - fw = (double)((int32_t)(twon24* z)); - iq[i] = (int32_t)(z-two24*fw); - z = q[j-1]+fw; - } - - /* compute n */ - z = scalbn(z,q0); /* actual value of z */ - z -= 8.0*floor(z*0.125); /* trim off integer >= 8 */ - n = (int32_t) z; - z -= (double)n; - ih = 0; - if(q0>0) { /* need iq[jz-1] to determine n */ - i = (iq[jz-1]>>(24-q0)); n += i; - iq[jz-1] -= i<<(24-q0); - ih = iq[jz-1]>>(23-q0); - } - else if(q0==0) ih = iq[jz-1]>>23; - else if(z>=0.5) ih=2; - - if(ih>0) { /* q > 0.5 */ - n += 1; carry = 0; - for(i=0;i<jz ;i++) { /* compute 1-q */ - j = iq[i]; - if(carry==0) { - if(j!=0) { - carry = 1; iq[i] = 0x1000000- j; - } - } else iq[i] = 0xffffff - j; - } - if(q0>0) { /* rare case: chance is 1 in 12 */ - switch(q0) { - case 1: - iq[jz-1] &= 0x7fffff; break; - case 2: - iq[jz-1] &= 0x3fffff; break; - } - } - if(ih==2) { - z = one - z; - if(carry!=0) z -= scalbn(one,q0); - } - } - - /* check if recomputation is needed */ - if(z==zero) { - j = 0; - for (i=jz-1;i>=jk;i--) j |= iq[i]; - if(j==0) { /* need recomputation */ - for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */ - - for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */ - f[jx+i] = (double) ipio2[jv+i]; - for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; - q[i] = fw; - } - jz += k; - goto recompute; - } - } - - /* chop off zero terms */ - if(z==0.0) { - jz -= 1; q0 -= 24; - while(iq[jz]==0) { jz--; q0-=24;} - } else { /* break z into 24-bit if necessary */ - z = scalbn(z,-q0); - if(z>=two24) { - fw = (double)((int32_t)(twon24*z)); - iq[jz] = (int32_t)(z-two24*fw); - jz += 1; q0 += 24; - iq[jz] = (int32_t) fw; - } else iq[jz] = (int32_t) z ; - } - - /* convert integer "bit" chunk to floating-point value */ - fw = scalbn(one,q0); - for(i=jz;i>=0;i--) { - q[i] = fw*(double)iq[i]; fw*=twon24; - } - - /* compute PIo2[0,...,jp]*q[jz,...,0] */ - for(i=jz;i>=0;i--) { - for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k]; - fq[jz-i] = fw; - } - - /* compress fq[] into y[] */ - switch(prec) { - case 0: - fw = 0.0; - for (i=jz;i>=0;i--) fw += fq[i]; - y[0] = (ih==0)? fw: -fw; - break; - case 1: - case 2: - fw = 0.0; - for (i=jz;i>=0;i--) fw += fq[i]; - y[0] = (ih==0)? fw: -fw; - fw = fq[0]-fw; - for (i=1;i<=jz;i++) fw += fq[i]; - y[1] = (ih==0)? fw: -fw; - break; - case 3: /* painful */ - for (i=jz;i>0;i--) { - fw = fq[i-1]+fq[i]; - fq[i] += fq[i-1]-fw; - fq[i-1] = fw; - } - for (i=jz;i>1;i--) { - fw = fq[i-1]+fq[i]; - fq[i] += fq[i-1]-fw; - fq[i-1] = fw; - } - for (fw=0.0,i=jz;i>=2;i--) fw += fq[i]; - if(ih==0) { - y[0] = fq[0]; y[1] = fq[1]; y[2] = fw; - } else { - y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw; - } - } - return n&7; -} diff --git a/src/math/k_rem_pio2f.c b/src/math/k_rem_pio2f.c deleted file mode 100644 index b543f084..00000000 --- a/src/math/k_rem_pio2f.c +++ /dev/null @@ -1,192 +0,0 @@ -/* k_rem_pio2f.c -- float version of k_rem_pio2.c - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -/* In the float version, the input parameter x contains 8 bit - integers, not 24 bit integers. 113 bit precision is not supported. */ - -static const int init_jk[] = {4,7,9}; /* initial value for jk */ - -static const float PIo2[] = { - 1.5703125000e+00, /* 0x3fc90000 */ - 4.5776367188e-04, /* 0x39f00000 */ - 2.5987625122e-05, /* 0x37da0000 */ - 7.5437128544e-08, /* 0x33a20000 */ - 6.0026650317e-11, /* 0x2e840000 */ - 7.3896444519e-13, /* 0x2b500000 */ - 5.3845816694e-15, /* 0x27c20000 */ - 5.6378512969e-18, /* 0x22d00000 */ - 8.3009228831e-20, /* 0x1fc40000 */ - 3.2756352257e-22, /* 0x1bc60000 */ - 6.3331015649e-25, /* 0x17440000 */ -}; - -static const float -zero = 0.0, -one = 1.0, -two8 = 2.5600000000e+02, /* 0x43800000 */ -twon8 = 3.9062500000e-03; /* 0x3b800000 */ - - int __kernel_rem_pio2f(float *x, float *y, int e0, int nx, int prec, const int32_t *ipio2) -{ - int32_t jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih; - float z,fw,f[20],fq[20],q[20]; - - /* initialize jk*/ - jk = init_jk[prec]; - jp = jk; - - /* determine jx,jv,q0, note that 3>q0 */ - jx = nx-1; - jv = (e0-3)/8; if(jv<0) jv=0; - q0 = e0-8*(jv+1); - - /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */ - j = jv-jx; m = jx+jk; - for(i=0;i<=m;i++,j++) f[i] = (j<0)? zero : (float) ipio2[j]; - - /* compute q[0],q[1],...q[jk] */ - for (i=0;i<=jk;i++) { - for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw; - } - - jz = jk; -recompute: - /* distill q[] into iq[] reversingly */ - for(i=0,j=jz,z=q[jz];j>0;i++,j--) { - fw = (float)((int32_t)(twon8* z)); - iq[i] = (int32_t)(z-two8*fw); - z = q[j-1]+fw; - } - - /* compute n */ - z = scalbnf(z,q0); /* actual value of z */ - z -= (float)8.0*floorf(z*(float)0.125); /* trim off integer >= 8 */ - n = (int32_t) z; - z -= (float)n; - ih = 0; - if(q0>0) { /* need iq[jz-1] to determine n */ - i = (iq[jz-1]>>(8-q0)); n += i; - iq[jz-1] -= i<<(8-q0); - ih = iq[jz-1]>>(7-q0); - } - else if(q0==0) ih = iq[jz-1]>>7; - else if(z>=(float)0.5) ih=2; - - if(ih>0) { /* q > 0.5 */ - n += 1; carry = 0; - for(i=0;i<jz ;i++) { /* compute 1-q */ - j = iq[i]; - if(carry==0) { - if(j!=0) { - carry = 1; iq[i] = 0x100- j; - } - } else iq[i] = 0xff - j; - } - if(q0>0) { /* rare case: chance is 1 in 12 */ - switch(q0) { - case 1: - iq[jz-1] &= 0x7f; break; - case 2: - iq[jz-1] &= 0x3f; break; - } - } - if(ih==2) { - z = one - z; - if(carry!=0) z -= scalbnf(one,q0); - } - } - - /* check if recomputation is needed */ - if(z==zero) { - j = 0; - for (i=jz-1;i>=jk;i--) j |= iq[i]; - if(j==0) { /* need recomputation */ - for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */ - - for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */ - f[jx+i] = (float) ipio2[jv+i]; - for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; - q[i] = fw; - } - jz += k; - goto recompute; - } - } - - /* chop off zero terms */ - if(z==(float)0.0) { - jz -= 1; q0 -= 8; - while(iq[jz]==0) { jz--; q0-=8;} - } else { /* break z into 8-bit if necessary */ - z = scalbnf(z,-q0); - if(z>=two8) { - fw = (float)((int32_t)(twon8*z)); - iq[jz] = (int32_t)(z-two8*fw); - jz += 1; q0 += 8; - iq[jz] = (int32_t) fw; - } else iq[jz] = (int32_t) z ; - } - - /* convert integer "bit" chunk to floating-point value */ - fw = scalbnf(one,q0); - for(i=jz;i>=0;i--) { - q[i] = fw*(float)iq[i]; fw*=twon8; - } - - /* compute PIo2[0,...,jp]*q[jz,...,0] */ - for(i=jz;i>=0;i--) { - for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k]; - fq[jz-i] = fw; - } - - /* compress fq[] into y[] */ - switch(prec) { - case 0: - fw = 0.0; - for (i=jz;i>=0;i--) fw += fq[i]; - y[0] = (ih==0)? fw: -fw; - break; - case 1: - case 2: - fw = 0.0; - for (i=jz;i>=0;i--) fw += fq[i]; - y[0] = (ih==0)? fw: -fw; - fw = fq[0]-fw; - for (i=1;i<=jz;i++) fw += fq[i]; - y[1] = (ih==0)? fw: -fw; - break; - case 3: /* painful */ - for (i=jz;i>0;i--) { - fw = fq[i-1]+fq[i]; - fq[i] += fq[i-1]-fw; - fq[i-1] = fw; - } - for (i=jz;i>1;i--) { - fw = fq[i-1]+fq[i]; - fq[i] += fq[i-1]-fw; - fq[i-1] = fw; - } - for (fw=0.0,i=jz;i>=2;i--) fw += fq[i]; - if(ih==0) { - y[0] = fq[0]; y[1] = fq[1]; y[2] = fw; - } else { - y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw; - } - } - return n&7; -} diff --git a/src/math/k_sinf.c b/src/math/k_sinf.c deleted file mode 100644 index 617f6148..00000000 --- a/src/math/k_sinf.c +++ /dev/null @@ -1,42 +0,0 @@ -/* k_sinf.c -- float version of k_sin.c - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -half = 5.0000000000e-01,/* 0x3f000000 */ -S1 = -1.6666667163e-01, /* 0xbe2aaaab */ -S2 = 8.3333337680e-03, /* 0x3c088889 */ -S3 = -1.9841270114e-04, /* 0xb9500d01 */ -S4 = 2.7557314297e-06, /* 0x3638ef1b */ -S5 = -2.5050759689e-08, /* 0xb2d72f34 */ -S6 = 1.5896910177e-10; /* 0x2f2ec9d3 */ - -float -__kernel_sinf(float x, float y, int iy) -{ - float z,r,v; - int32_t ix; - GET_FLOAT_WORD(ix,x); - ix &= 0x7fffffff; /* high word of x */ - if(ix<0x32000000) /* |x| < 2**-27 */ - {if((int)x==0) return x;} /* generate inexact */ - z = x*x; - v = z*x; - r = S2+z*(S3+z*(S4+z*(S5+z*S6))); - if(iy==0) return x+v*(S1+z*r); - else return x-((z*(half*y-v*r)-y)-v*S1); -} diff --git a/src/math/k_tan.c b/src/math/k_tan.c deleted file mode 100644 index f721ae6d..00000000 --- a/src/math/k_tan.c +++ /dev/null @@ -1,149 +0,0 @@ -/* @(#)k_tan.c 1.5 04/04/22 SMI */ - -/* - * ==================================================== - * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. - * - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* __kernel_tan( x, y, k ) - * kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854 - * Input x is assumed to be bounded by ~pi/4 in magnitude. - * Input y is the tail of x. - * Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned. - * - * Algorithm - * 1. Since tan(-x) = -tan(x), we need only to consider positive x. - * 2. if x < 2^-28 (hx<0x3e300000 0), return x with inexact if x!=0. - * 3. tan(x) is approximated by a odd polynomial of degree 27 on - * [0,0.67434] - * 3 27 - * tan(x) ~ x + T1*x + ... + T13*x - * where - * - * |tan(x) 2 4 26 | -59.2 - * |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2 - * | x | - * - * Note: tan(x+y) = tan(x) + tan'(x)*y - * ~ tan(x) + (1+x*x)*y - * Therefore, for better accuracy in computing tan(x+y), let - * 3 2 2 2 2 - * r = x *(T2+x *(T3+x *(...+x *(T12+x *T13)))) - * then - * 3 2 - * tan(x+y) = x + (T1*x + (x *(r+y)+y)) - * - * 4. For x in [0.67434,pi/4], let y = pi/4 - x, then - * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y)) - * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y))) - */ - -#include <math.h> -#include "math_private.h" -static const double xxx[] = { - 3.33333333333334091986e-01, /* 3FD55555, 55555563 */ - 1.33333333333201242699e-01, /* 3FC11111, 1110FE7A */ - 5.39682539762260521377e-02, /* 3FABA1BA, 1BB341FE */ - 2.18694882948595424599e-02, /* 3F9664F4, 8406D637 */ - 8.86323982359930005737e-03, /* 3F8226E3, E96E8493 */ - 3.59207910759131235356e-03, /* 3F6D6D22, C9560328 */ - 1.45620945432529025516e-03, /* 3F57DBC8, FEE08315 */ - 5.88041240820264096874e-04, /* 3F4344D8, F2F26501 */ - 2.46463134818469906812e-04, /* 3F3026F7, 1A8D1068 */ - 7.81794442939557092300e-05, /* 3F147E88, A03792A6 */ - 7.14072491382608190305e-05, /* 3F12B80F, 32F0A7E9 */ - -1.85586374855275456654e-05, /* BEF375CB, DB605373 */ - 2.59073051863633712884e-05, /* 3EFB2A70, 74BF7AD4 */ -/* one */ 1.00000000000000000000e+00, /* 3FF00000, 00000000 */ -/* pio4 */ 7.85398163397448278999e-01, /* 3FE921FB, 54442D18 */ -/* pio4lo */ 3.06161699786838301793e-17 /* 3C81A626, 33145C07 */ -}; -#define one xxx[13] -#define pio4 xxx[14] -#define pio4lo xxx[15] -#define T xxx -/* INDENT ON */ - -double -__kernel_tan(double x, double y, int iy) { - double z, r, v, w, s; - int32_t ix, hx; - - GET_HIGH_WORD(hx,x); - ix = hx & 0x7fffffff; /* high word of |x| */ - if (ix < 0x3e300000) { /* x < 2**-28 */ - if ((int) x == 0) { /* generate inexact */ - uint32_t low; - GET_LOW_WORD(low,x); - if (((ix | low) | (iy + 1)) == 0) - return one / fabs(x); - else { - if (iy == 1) - return x; - else { /* compute -1 / (x+y) carefully */ - double a, t; - - z = w = x + y; - SET_LOW_WORD(z, 0); - v = y - (z - x); - t = a = -one / w; - SET_LOW_WORD(t, 0); - s = one + t * z; - return t + a * (s + t * v); - } - } - } - } - if (ix >= 0x3FE59428) { /* |x| >= 0.6744 */ - if (hx < 0) { - x = -x; - y = -y; - } - z = pio4 - x; - w = pio4lo - y; - x = z + w; - y = 0.0; - } - z = x * x; - w = z * z; - /* - * Break x^5*(T[1]+x^2*T[2]+...) into - * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) + - * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12])) - */ - r = T[1] + w * (T[3] + w * (T[5] + w * (T[7] + w * (T[9] + - w * T[11])))); - v = z * (T[2] + w * (T[4] + w * (T[6] + w * (T[8] + w * (T[10] + - w * T[12]))))); - s = z * x; - r = y + z * (s * (r + v) + y); - r += T[0] * s; - w = x + r; - if (ix >= 0x3FE59428) { - v = (double) iy; - return (double) (1 - ((hx >> 30) & 2)) * - (v - 2.0 * (x - (w * w / (w + v) - r))); - } - if (iy == 1) - return w; - else { - /* - * if allow error up to 2 ulp, simply return - * -1.0 / (x+r) here - */ - /* compute -1.0 / (x+r) accurately */ - double a, t; - z = w; - SET_LOW_WORD(z,0); - v = r - (z - x); /* z+v = r+x */ - t = a = -1.0 / w; /* a = -1.0/w */ - SET_LOW_WORD(t,0); - s = 1.0 + t * z; - return t + a * (s + t * v); - } -} diff --git a/src/math/k_tanf.c b/src/math/k_tanf.c deleted file mode 100644 index 99ede58c..00000000 --- a/src/math/k_tanf.c +++ /dev/null @@ -1,105 +0,0 @@ -/* k_tanf.c -- float version of k_tan.c - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright 2004 Sun Microsystems, Inc. All Rights Reserved. - * - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" -static const float -one = 1.0000000000e+00, /* 0x3f800000 */ -pio4 = 7.8539812565e-01, /* 0x3f490fda */ -pio4lo= 3.7748947079e-08, /* 0x33222168 */ -T[] = { - 3.3333334327e-01, /* 0x3eaaaaab */ - 1.3333334029e-01, /* 0x3e088889 */ - 5.3968254477e-02, /* 0x3d5d0dd1 */ - 2.1869488060e-02, /* 0x3cb327a4 */ - 8.8632395491e-03, /* 0x3c11371f */ - 3.5920790397e-03, /* 0x3b6b6916 */ - 1.4562094584e-03, /* 0x3abede48 */ - 5.8804126456e-04, /* 0x3a1a26c8 */ - 2.4646313977e-04, /* 0x398137b9 */ - 7.8179444245e-05, /* 0x38a3f445 */ - 7.1407252108e-05, /* 0x3895c07a */ - -1.8558637748e-05, /* 0xb79bae5f */ - 2.5907305826e-05, /* 0x37d95384 */ -}; - -float -__kernel_tanf(float x, float y, int iy) -{ - float z,r,v,w,s; - int32_t ix,hx; - GET_FLOAT_WORD(hx,x); - ix = hx&0x7fffffff; /* high word of |x| */ - if(ix<0x31800000) { /* x < 2**-28 */ - if ((int) x == 0) { /* generate inexact */ - if ((ix | (iy + 1)) == 0) - return one / fabsf(x); - else { - if (iy == 1) - return x; - else { /* compute -1 / (x+y) carefully */ - double a, t; - - z = w = x + y; - GET_FLOAT_WORD(ix, z); - SET_FLOAT_WORD(z, ix & 0xfffff000); - v = y - (z - x); - t = a = -one / w; - GET_FLOAT_WORD(ix, t); - SET_FLOAT_WORD(t, ix & 0xfffff000); - s = one + t * z; - return t + a * (s + t * v); - } - } - } - } - if(ix>=0x3f2ca140) { /* |x|>=0.6744 */ - if(hx<0) {x = -x; y = -y;} - z = pio4-x; - w = pio4lo-y; - x = z+w; y = 0.0; - } - z = x*x; - w = z*z; - /* Break x^5*(T[1]+x^2*T[2]+...) into - * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) + - * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12])) - */ - r = T[1]+w*(T[3]+w*(T[5]+w*(T[7]+w*(T[9]+w*T[11])))); - v = z*(T[2]+w*(T[4]+w*(T[6]+w*(T[8]+w*(T[10]+w*T[12]))))); - s = z*x; - r = y + z*(s*(r+v)+y); - r += T[0]*s; - w = x+r; - if(ix>=0x3f2ca140) { - v = (float)iy; - return (float)(1-((hx>>30)&2))*(v-(float)2.0*(x-(w*w/(w+v)-r))); - } - if(iy==1) return w; - else { /* if allow error up to 2 ulp, - simply return -1.0/(x+r) here */ - /* compute -1.0/(x+r) accurately */ - float a,t; - int32_t i; - z = w; - GET_FLOAT_WORD(i,z); - SET_FLOAT_WORD(z,i&0xfffff000); - v = r-(z - x); /* z+v = r+x */ - t = a = -(float)1.0/w; /* a = -1.0/w */ - GET_FLOAT_WORD(i,t); - SET_FLOAT_WORD(t,i&0xfffff000); - s = (float)1.0+t*z; - return t+a*(s+t*v); - } -} diff --git a/src/math/s_ldexp.c b/src/math/ldexp.c index f4d1cd6a..36835dba 100644 --- a/src/math/s_ldexp.c +++ b/src/math/ldexp.c @@ -1,4 +1,4 @@ -#include <math.h> +#include "libm.h" double ldexp(double x, int n) { diff --git a/src/math/s_ldexpf.c b/src/math/ldexpf.c index 3bad5f39..f0981ae4 100644 --- a/src/math/s_ldexpf.c +++ b/src/math/ldexpf.c @@ -1,4 +1,4 @@ -#include <math.h> +#include "libm.h" float ldexpf(float x, int n) { diff --git a/src/math/ldexpl.c b/src/math/ldexpl.c new file mode 100644 index 00000000..885ff6e9 --- /dev/null +++ b/src/math/ldexpl.c @@ -0,0 +1,6 @@ +#include "libm.h" + +long double ldexpl(long double x, int n) +{ + return scalbnl(x, n); +} diff --git a/src/math/lgamma.c b/src/math/lgamma.c new file mode 100644 index 00000000..d12462b9 --- /dev/null +++ b/src/math/lgamma.c @@ -0,0 +1,9 @@ +#include "libm.h" + +double lgamma(double x) +{ + return lgamma_r(x, &signgam); +} + +// FIXME +//weak_alias(lgamma, gamma); diff --git a/src/math/lgamma_r.c b/src/math/lgamma_r.c new file mode 100644 index 00000000..6baa0e52 --- /dev/null +++ b/src/math/lgamma_r.c @@ -0,0 +1,315 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_lgamma_r.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + * + */ +/* lgamma_r(x, signgamp) + * Reentrant version of the logarithm of the Gamma function + * with user provide pointer for the sign of Gamma(x). + * + * Method: + * 1. Argument Reduction for 0 < x <= 8 + * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may + * reduce x to a number in [1.5,2.5] by + * lgamma(1+s) = log(s) + lgamma(s) + * for example, + * lgamma(7.3) = log(6.3) + lgamma(6.3) + * = log(6.3*5.3) + lgamma(5.3) + * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3) + * 2. Polynomial approximation of lgamma around its + * minimun ymin=1.461632144968362245 to maintain monotonicity. + * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use + * Let z = x-ymin; + * lgamma(x) = -1.214862905358496078218 + z^2*poly(z) + * where + * poly(z) is a 14 degree polynomial. + * 2. Rational approximation in the primary interval [2,3] + * We use the following approximation: + * s = x-2.0; + * lgamma(x) = 0.5*s + s*P(s)/Q(s) + * with accuracy + * |P/Q - (lgamma(x)-0.5s)| < 2**-61.71 + * Our algorithms are based on the following observation + * + * zeta(2)-1 2 zeta(3)-1 3 + * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ... + * 2 3 + * + * where Euler = 0.5771... is the Euler constant, which is very + * close to 0.5. + * + * 3. For x>=8, we have + * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+.... + * (better formula: + * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...) + * Let z = 1/x, then we approximation + * f(z) = lgamma(x) - (x-0.5)(log(x)-1) + * by + * 3 5 11 + * w = w0 + w1*z + w2*z + w3*z + ... + w6*z + * where + * |w - f(z)| < 2**-58.74 + * + * 4. For negative x, since (G is gamma function) + * -x*G(-x)*G(x) = pi/sin(pi*x), + * we have + * G(x) = pi/(sin(pi*x)*(-x)*G(-x)) + * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0 + * Hence, for x<0, signgam = sign(sin(pi*x)) and + * lgamma(x) = log(|Gamma(x)|) + * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x); + * Note: one should avoid compute pi*(-x) directly in the + * computation of sin(pi*(-x)). + * + * 5. Special Cases + * lgamma(2+s) ~ s*(1-Euler) for tiny s + * lgamma(1) = lgamma(2) = 0 + * lgamma(x) ~ -log(|x|) for tiny x + * lgamma(0) = lgamma(neg.integer) = inf and raise divide-by-zero + * lgamma(inf) = inf + * lgamma(-inf) = inf (bug for bug compatible with C99!?) + * + */ + +#include "libm.h" + +static const double +two52= 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ +half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */ +one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ +pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */ +a0 = 7.72156649015328655494e-02, /* 0x3FB3C467, 0xE37DB0C8 */ +a1 = 3.22467033424113591611e-01, /* 0x3FD4A34C, 0xC4A60FAD */ +a2 = 6.73523010531292681824e-02, /* 0x3FB13E00, 0x1A5562A7 */ +a3 = 2.05808084325167332806e-02, /* 0x3F951322, 0xAC92547B */ +a4 = 7.38555086081402883957e-03, /* 0x3F7E404F, 0xB68FEFE8 */ +a5 = 2.89051383673415629091e-03, /* 0x3F67ADD8, 0xCCB7926B */ +a6 = 1.19270763183362067845e-03, /* 0x3F538A94, 0x116F3F5D */ +a7 = 5.10069792153511336608e-04, /* 0x3F40B6C6, 0x89B99C00 */ +a8 = 2.20862790713908385557e-04, /* 0x3F2CF2EC, 0xED10E54D */ +a9 = 1.08011567247583939954e-04, /* 0x3F1C5088, 0x987DFB07 */ +a10 = 2.52144565451257326939e-05, /* 0x3EFA7074, 0x428CFA52 */ +a11 = 4.48640949618915160150e-05, /* 0x3F07858E, 0x90A45837 */ +tc = 1.46163214496836224576e+00, /* 0x3FF762D8, 0x6356BE3F */ +tf = -1.21486290535849611461e-01, /* 0xBFBF19B9, 0xBCC38A42 */ +/* tt = -(tail of tf) */ +tt = -3.63867699703950536541e-18, /* 0xBC50C7CA, 0xA48A971F */ +t0 = 4.83836122723810047042e-01, /* 0x3FDEF72B, 0xC8EE38A2 */ +t1 = -1.47587722994593911752e-01, /* 0xBFC2E427, 0x8DC6C509 */ +t2 = 6.46249402391333854778e-02, /* 0x3FB08B42, 0x94D5419B */ +t3 = -3.27885410759859649565e-02, /* 0xBFA0C9A8, 0xDF35B713 */ +t4 = 1.79706750811820387126e-02, /* 0x3F9266E7, 0x970AF9EC */ +t5 = -1.03142241298341437450e-02, /* 0xBF851F9F, 0xBA91EC6A */ +t6 = 6.10053870246291332635e-03, /* 0x3F78FCE0, 0xE370E344 */ +t7 = -3.68452016781138256760e-03, /* 0xBF6E2EFF, 0xB3E914D7 */ +t8 = 2.25964780900612472250e-03, /* 0x3F6282D3, 0x2E15C915 */ +t9 = -1.40346469989232843813e-03, /* 0xBF56FE8E, 0xBF2D1AF1 */ +t10 = 8.81081882437654011382e-04, /* 0x3F4CDF0C, 0xEF61A8E9 */ +t11 = -5.38595305356740546715e-04, /* 0xBF41A610, 0x9C73E0EC */ +t12 = 3.15632070903625950361e-04, /* 0x3F34AF6D, 0x6C0EBBF7 */ +t13 = -3.12754168375120860518e-04, /* 0xBF347F24, 0xECC38C38 */ +t14 = 3.35529192635519073543e-04, /* 0x3F35FD3E, 0xE8C2D3F4 */ +u0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */ +u1 = 6.32827064025093366517e-01, /* 0x3FE4401E, 0x8B005DFF */ +u2 = 1.45492250137234768737e+00, /* 0x3FF7475C, 0xD119BD6F */ +u3 = 9.77717527963372745603e-01, /* 0x3FEF4976, 0x44EA8450 */ +u4 = 2.28963728064692451092e-01, /* 0x3FCD4EAE, 0xF6010924 */ +u5 = 1.33810918536787660377e-02, /* 0x3F8B678B, 0xBF2BAB09 */ +v1 = 2.45597793713041134822e+00, /* 0x4003A5D7, 0xC2BD619C */ +v2 = 2.12848976379893395361e+00, /* 0x40010725, 0xA42B18F5 */ +v3 = 7.69285150456672783825e-01, /* 0x3FE89DFB, 0xE45050AF */ +v4 = 1.04222645593369134254e-01, /* 0x3FBAAE55, 0xD6537C88 */ +v5 = 3.21709242282423911810e-03, /* 0x3F6A5ABB, 0x57D0CF61 */ +s0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */ +s1 = 2.14982415960608852501e-01, /* 0x3FCB848B, 0x36E20878 */ +s2 = 3.25778796408930981787e-01, /* 0x3FD4D98F, 0x4F139F59 */ +s3 = 1.46350472652464452805e-01, /* 0x3FC2BB9C, 0xBEE5F2F7 */ +s4 = 2.66422703033638609560e-02, /* 0x3F9B481C, 0x7E939961 */ +s5 = 1.84028451407337715652e-03, /* 0x3F5E26B6, 0x7368F239 */ +s6 = 3.19475326584100867617e-05, /* 0x3F00BFEC, 0xDD17E945 */ +r1 = 1.39200533467621045958e+00, /* 0x3FF645A7, 0x62C4AB74 */ +r2 = 7.21935547567138069525e-01, /* 0x3FE71A18, 0x93D3DCDC */ +r3 = 1.71933865632803078993e-01, /* 0x3FC601ED, 0xCCFBDF27 */ +r4 = 1.86459191715652901344e-02, /* 0x3F9317EA, 0x742ED475 */ +r5 = 7.77942496381893596434e-04, /* 0x3F497DDA, 0xCA41A95B */ +r6 = 7.32668430744625636189e-06, /* 0x3EDEBAF7, 0xA5B38140 */ +w0 = 4.18938533204672725052e-01, /* 0x3FDACFE3, 0x90C97D69 */ +w1 = 8.33333333333329678849e-02, /* 0x3FB55555, 0x5555553B */ +w2 = -2.77777777728775536470e-03, /* 0xBF66C16C, 0x16B02E5C */ +w3 = 7.93650558643019558500e-04, /* 0x3F4A019F, 0x98CF38B6 */ +w4 = -5.95187557450339963135e-04, /* 0xBF4380CB, 0x8C0FE741 */ +w5 = 8.36339918996282139126e-04, /* 0x3F4B67BA, 0x4CDAD5D1 */ +w6 = -1.63092934096575273989e-03; /* 0xBF5AB89D, 0x0B9E43E4 */ + +static const double zero = 0.00000000000000000000e+00; + +static double sin_pi(double x) +{ + double y,z; + int n,ix; + + GET_HIGH_WORD(ix, x); + ix &= 0x7fffffff; + + if (ix < 0x3fd00000) + return __sin(pi*x, zero, 0); + + y = -x; /* negative x is assumed */ + + /* + * argument reduction, make sure inexact flag not raised if input + * is an integer + */ + z = floor(y); + if (z != y) { /* inexact anyway */ + y *= 0.5; + y = 2.0*(y - floor(y)); /* y = |x| mod 2.0 */ + n = (int)(y*4.0); + } else { + if (ix >= 0x43400000) { + y = zero; /* y must be even */ + n = 0; + } else { + if (ix < 0x43300000) + z = y + two52; /* exact */ + GET_LOW_WORD(n, z); + n &= 1; + y = n; + n <<= 2; + } + } + switch (n) { + case 0: y = __sin(pi*y, zero, 0); break; + case 1: + case 2: y = __cos(pi*(0.5-y), zero); break; + case 3: + case 4: y = __sin(pi*(one-y), zero, 0); break; + case 5: + case 6: y = -__cos(pi*(y-1.5), zero); break; + default: y = __sin(pi*(y-2.0), zero, 0); break; + } + return -y; +} + + +double lgamma_r(double x, int *signgamp) +{ + double t,y,z,nadj,p,p1,p2,p3,q,r,w; + int32_t hx; + int i,lx,ix; + + EXTRACT_WORDS(hx, lx, x); + + /* purge off +-inf, NaN, +-0, tiny and negative arguments */ + *signgamp = 1; + ix = hx & 0x7fffffff; + if (ix >= 0x7ff00000) + return x*x; + if ((ix|lx) == 0) + return one/zero; + if (ix < 0x3b900000) { /* |x|<2**-70, return -log(|x|) */ + if(hx < 0) { + *signgamp = -1; + return -log(-x); + } + return -log(x); + } + if (hx < 0) { + if (ix >= 0x43300000) /* |x|>=2**52, must be -integer */ + return one/zero; + t = sin_pi(x); + if (t == zero) /* -integer */ + return one/zero; + nadj = log(pi/fabs(t*x)); + if (t < zero) + *signgamp = -1; + x = -x; + } + + /* purge off 1 and 2 */ + if (((ix - 0x3ff00000)|lx) == 0 || ((ix - 0x40000000)|lx) == 0) + r = 0; + /* for x < 2.0 */ + else if (ix < 0x40000000) { + if (ix <= 0x3feccccc) { /* lgamma(x) = lgamma(x+1)-log(x) */ + r = -log(x); + if (ix >= 0x3FE76944) { + y = one - x; + i = 0; + } else if (ix >= 0x3FCDA661) { + y = x - (tc-one); + i = 1; + } else { + y = x; + i = 2; + } + } else { + r = zero; + if (ix >= 0x3FFBB4C3) { /* [1.7316,2] */ + y = 2.0 - x; + i = 0; + } else if(ix >= 0x3FF3B4C4) { /* [1.23,1.73] */ + y = x - tc; + i = 1; + } else { + y = x - one; + i = 2; + } + } + switch (i) { + case 0: + z = y*y; + p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10)))); + p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11))))); + p = y*p1+p2; + r += (p-0.5*y); + break; + case 1: + z = y*y; + w = z*y; + p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */ + p2 = t1+w*(t4+w*(t7+w*(t10+w*t13))); + p3 = t2+w*(t5+w*(t8+w*(t11+w*t14))); + p = z*p1-(tt-w*(p2+y*p3)); + r += tf + p; + break; + case 2: + p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5))))); + p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5)))); + r += -0.5*y + p1/p2; + } + } else if (ix < 0x40200000) { /* x < 8.0 */ + i = (int)x; + y = x - (double)i; + p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); + q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6))))); + r = half*y+p/q; + z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ + switch (i) { + case 7: z *= y + 6.0; /* FALLTHRU */ + case 6: z *= y + 5.0; /* FALLTHRU */ + case 5: z *= y + 4.0; /* FALLTHRU */ + case 4: z *= y + 3.0; /* FALLTHRU */ + case 3: z *= y + 2.0; /* FALLTHRU */ + r += log(z); + break; + } + } else if (ix < 0x43900000) { /* 8.0 <= x < 2**58 */ + t = log(x); + z = one/x; + y = z*z; + w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); + r = (x-half)*(t-one)+w; + } else /* 2**58 <= x <= inf */ + r = x*(log(x)-one); + if (hx < 0) + r = nadj - r; + return r; +} diff --git a/src/math/lgammaf.c b/src/math/lgammaf.c new file mode 100644 index 00000000..f50f2379 --- /dev/null +++ b/src/math/lgammaf.c @@ -0,0 +1,9 @@ +#include "libm.h" + +float lgammaf(float x) +{ + return lgamma_r(x, &signgam); +} + +// FIXME +//weak_alias(lgammaf, gammaf); diff --git a/src/math/lgammaf_r.c b/src/math/lgammaf_r.c new file mode 100644 index 00000000..9955b2f9 --- /dev/null +++ b/src/math/lgammaf_r.c @@ -0,0 +1,250 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_lgammaf_r.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +two23= 8.3886080000e+06, /* 0x4b000000 */ +half= 5.0000000000e-01, /* 0x3f000000 */ +one = 1.0000000000e+00, /* 0x3f800000 */ +pi = 3.1415927410e+00, /* 0x40490fdb */ +a0 = 7.7215664089e-02, /* 0x3d9e233f */ +a1 = 3.2246702909e-01, /* 0x3ea51a66 */ +a2 = 6.7352302372e-02, /* 0x3d89f001 */ +a3 = 2.0580807701e-02, /* 0x3ca89915 */ +a4 = 7.3855509982e-03, /* 0x3bf2027e */ +a5 = 2.8905137442e-03, /* 0x3b3d6ec6 */ +a6 = 1.1927076848e-03, /* 0x3a9c54a1 */ +a7 = 5.1006977446e-04, /* 0x3a05b634 */ +a8 = 2.2086278477e-04, /* 0x39679767 */ +a9 = 1.0801156895e-04, /* 0x38e28445 */ +a10 = 2.5214456400e-05, /* 0x37d383a2 */ +a11 = 4.4864096708e-05, /* 0x383c2c75 */ +tc = 1.4616321325e+00, /* 0x3fbb16c3 */ +tf = -1.2148628384e-01, /* 0xbdf8cdcd */ +/* tt = -(tail of tf) */ +tt = 6.6971006518e-09, /* 0x31e61c52 */ +t0 = 4.8383611441e-01, /* 0x3ef7b95e */ +t1 = -1.4758771658e-01, /* 0xbe17213c */ +t2 = 6.4624942839e-02, /* 0x3d845a15 */ +t3 = -3.2788541168e-02, /* 0xbd064d47 */ +t4 = 1.7970675603e-02, /* 0x3c93373d */ +t5 = -1.0314224288e-02, /* 0xbc28fcfe */ +t6 = 6.1005386524e-03, /* 0x3bc7e707 */ +t7 = -3.6845202558e-03, /* 0xbb7177fe */ +t8 = 2.2596477065e-03, /* 0x3b141699 */ +t9 = -1.4034647029e-03, /* 0xbab7f476 */ +t10 = 8.8108185446e-04, /* 0x3a66f867 */ +t11 = -5.3859531181e-04, /* 0xba0d3085 */ +t12 = 3.1563205994e-04, /* 0x39a57b6b */ +t13 = -3.1275415677e-04, /* 0xb9a3f927 */ +t14 = 3.3552918467e-04, /* 0x39afe9f7 */ +u0 = -7.7215664089e-02, /* 0xbd9e233f */ +u1 = 6.3282704353e-01, /* 0x3f2200f4 */ +u2 = 1.4549225569e+00, /* 0x3fba3ae7 */ +u3 = 9.7771751881e-01, /* 0x3f7a4bb2 */ +u4 = 2.2896373272e-01, /* 0x3e6a7578 */ +u5 = 1.3381091878e-02, /* 0x3c5b3c5e */ +v1 = 2.4559779167e+00, /* 0x401d2ebe */ +v2 = 2.1284897327e+00, /* 0x4008392d */ +v3 = 7.6928514242e-01, /* 0x3f44efdf */ +v4 = 1.0422264785e-01, /* 0x3dd572af */ +v5 = 3.2170924824e-03, /* 0x3b52d5db */ +s0 = -7.7215664089e-02, /* 0xbd9e233f */ +s1 = 2.1498242021e-01, /* 0x3e5c245a */ +s2 = 3.2577878237e-01, /* 0x3ea6cc7a */ +s3 = 1.4635047317e-01, /* 0x3e15dce6 */ +s4 = 2.6642270386e-02, /* 0x3cda40e4 */ +s5 = 1.8402845599e-03, /* 0x3af135b4 */ +s6 = 3.1947532989e-05, /* 0x3805ff67 */ +r1 = 1.3920053244e+00, /* 0x3fb22d3b */ +r2 = 7.2193557024e-01, /* 0x3f38d0c5 */ +r3 = 1.7193385959e-01, /* 0x3e300f6e */ +r4 = 1.8645919859e-02, /* 0x3c98bf54 */ +r5 = 7.7794247773e-04, /* 0x3a4beed6 */ +r6 = 7.3266842264e-06, /* 0x36f5d7bd */ +w0 = 4.1893854737e-01, /* 0x3ed67f1d */ +w1 = 8.3333335817e-02, /* 0x3daaaaab */ +w2 = -2.7777778450e-03, /* 0xbb360b61 */ +w3 = 7.9365057172e-04, /* 0x3a500cfd */ +w4 = -5.9518753551e-04, /* 0xba1c065c */ +w5 = 8.3633989561e-04, /* 0x3a5b3dd2 */ +w6 = -1.6309292987e-03; /* 0xbad5c4e8 */ + +static const float zero = 0.0000000000e+00; + +static float sin_pif(float x) +{ + float y,z; + int n,ix; + + GET_FLOAT_WORD(ix, x); + ix &= 0x7fffffff; + + if(ix < 0x3e800000) + return __sindf(pi*x); + + y = -x; /* negative x is assumed */ + + /* + * argument reduction, make sure inexact flag not raised if input + * is an integer + */ + z = floorf(y); + if (z != y) { /* inexact anyway */ + y *= (float)0.5; + y = (float)2.0*(y - floorf(y)); /* y = |x| mod 2.0 */ + n = (int) (y*(float)4.0); + } else { + if (ix >= 0x4b800000) { + y = zero; /* y must be even */ + n = 0; + } else { + if (ix < 0x4b000000) + z = y + two23; /* exact */ + GET_FLOAT_WORD(n, z); + n &= 1; + y = n; + n <<= 2; + } + } + switch (n) { + case 0: y = __sindf(pi*y); break; + case 1: + case 2: y = __cosdf(pi*((float)0.5-y)); break; + case 3: + case 4: y = __sindf(pi*(one-y)); break; + case 5: + case 6: y = -__cosdf(pi*(y-(float)1.5)); break; + default: y = __sindf(pi*(y-(float)2.0)); break; + } + return -y; +} + + +float lgammaf_r(float x, int *signgamp) +{ + float t,y,z,nadj,p,p1,p2,p3,q,r,w; + int32_t hx; + int i,ix; + + GET_FLOAT_WORD(hx, x); + + /* purge off +-inf, NaN, +-0, tiny and negative arguments */ + *signgamp = 1; + ix = hx & 0x7fffffff; + if (ix >= 0x7f800000) + return x*x; + if (ix == 0) + return one/zero; + if (ix < 0x35000000) { /* |x| < 2**-21, return -log(|x|) */ + if (hx < 0) { + *signgamp = -1; + return -logf(-x); + } + return -logf(x); + } + if (hx < 0) { + if (ix >= 0x4b000000) /* |x| >= 2**23, must be -integer */ + return one/zero; + t = sin_pif(x); + if (t == zero) /* -integer */ + return one/zero; + nadj = logf(pi/fabsf(t*x)); + if (t < zero) + *signgamp = -1; + x = -x; + } + + /* purge off 1 and 2 */ + if (ix == 0x3f800000 || ix == 0x40000000) + r = 0; + /* for x < 2.0 */ + else if (ix < 0x40000000) { + if (ix <= 0x3f666666) { /* lgamma(x) = lgamma(x+1)-log(x) */ + r = -logf(x); + if (ix >= 0x3f3b4a20) { + y = one - x; + i = 0; + } else if (ix >= 0x3e6d3308) { + y = x - (tc-one); + i = 1; + } else { + y = x; + i = 2; + } + } else { + r = zero; + if (ix >= 0x3fdda618) { /* [1.7316,2] */ + y = (float)2.0 - x; + i = 0; + } else if (ix >= 0x3F9da620) { /* [1.23,1.73] */ + y = x - tc; + i = 1; + } else { + y = x - one; + i = 2; + } + } + switch(i) { + case 0: + z = y*y; + p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10)))); + p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11))))); + p = y*p1+p2; + r += (p-(float)0.5*y); + break; + case 1: + z = y*y; + w = z*y; + p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */ + p2 = t1+w*(t4+w*(t7+w*(t10+w*t13))); + p3 = t2+w*(t5+w*(t8+w*(t11+w*t14))); + p = z*p1-(tt-w*(p2+y*p3)); + r += (tf + p); + break; + case 2: + p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5))))); + p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5)))); + r += (-(float)0.5*y + p1/p2); + } + } else if (ix < 0x41000000) { /* x < 8.0 */ + i = (int)x; + y = x-(float)i; + p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6)))))); + q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6))))); + r = half*y+p/q; + z = one; /* lgamma(1+s) = log(s) + lgamma(s) */ + switch (i) { + case 7: z *= y + (float)6.0; /* FALLTHRU */ + case 6: z *= y + (float)5.0; /* FALLTHRU */ + case 5: z *= y + (float)4.0; /* FALLTHRU */ + case 4: z *= y + (float)3.0; /* FALLTHRU */ + case 3: z *= y + (float)2.0; /* FALLTHRU */ + r += logf(z); + break; + } + } else if (ix < 0x5c800000) { /* 8.0 <= x < 2**58 */ + t = logf(x); + z = one/x; + y = z*z; + w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6))))); + r = (x-half)*(t-one)+w; + } else /* 2**58 <= x <= inf */ + r = x*(logf(x)-one); + if (hx < 0) + r = nadj - r; + return r; +} diff --git a/src/math/lgammal.c b/src/math/lgammal.c new file mode 100644 index 00000000..603477c9 --- /dev/null +++ b/src/math/lgammal.c @@ -0,0 +1,393 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_lgammal.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* lgammal(x) + * Reentrant version of the logarithm of the Gamma function + * with user provide pointer for the sign of Gamma(x). + * + * Method: + * 1. Argument Reduction for 0 < x <= 8 + * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may + * reduce x to a number in [1.5,2.5] by + * lgamma(1+s) = log(s) + lgamma(s) + * for example, + * lgamma(7.3) = log(6.3) + lgamma(6.3) + * = log(6.3*5.3) + lgamma(5.3) + * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3) + * 2. Polynomial approximation of lgamma around its + * minimun ymin=1.461632144968362245 to maintain monotonicity. + * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use + * Let z = x-ymin; + * lgamma(x) = -1.214862905358496078218 + z^2*poly(z) + * 2. Rational approximation in the primary interval [2,3] + * We use the following approximation: + * s = x-2.0; + * lgamma(x) = 0.5*s + s*P(s)/Q(s) + * Our algorithms are based on the following observation + * + * zeta(2)-1 2 zeta(3)-1 3 + * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ... + * 2 3 + * + * where Euler = 0.5771... is the Euler constant, which is very + * close to 0.5. + * + * 3. For x>=8, we have + * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+.... + * (better formula: + * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...) + * Let z = 1/x, then we approximation + * f(z) = lgamma(x) - (x-0.5)(log(x)-1) + * by + * 3 5 11 + * w = w0 + w1*z + w2*z + w3*z + ... + w6*z + * + * 4. For negative x, since (G is gamma function) + * -x*G(-x)*G(x) = pi/sin(pi*x), + * we have + * G(x) = pi/(sin(pi*x)*(-x)*G(-x)) + * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0 + * Hence, for x<0, signgam = sign(sin(pi*x)) and + * lgamma(x) = log(|Gamma(x)|) + * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x); + * Note: one should avoid compute pi*(-x) directly in the + * computation of sin(pi*(-x)). + * + * 5. Special Cases + * lgamma(2+s) ~ s*(1-Euler) for tiny s + * lgamma(1)=lgamma(2)=0 + * lgamma(x) ~ -log(x) for tiny x + * lgamma(0) = lgamma(inf) = inf + * lgamma(-integer) = +-inf + * + */ + +#include "libm.h" + +long double lgammal(long double x) +{ + return lgammal_r(x, &signgam); +} + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double lgammal_r(long double x, int *sg) +{ + return lgamma_r(x, sg); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +static const long double +half = 0.5L, +one = 1.0L, +pi = 3.14159265358979323846264L, +two63 = 9.223372036854775808e18L, + +/* lgam(1+x) = 0.5 x + x a(x)/b(x) + -0.268402099609375 <= x <= 0 + peak relative error 6.6e-22 */ +a0 = -6.343246574721079391729402781192128239938E2L, +a1 = 1.856560238672465796768677717168371401378E3L, +a2 = 2.404733102163746263689288466865843408429E3L, +a3 = 8.804188795790383497379532868917517596322E2L, +a4 = 1.135361354097447729740103745999661157426E2L, +a5 = 3.766956539107615557608581581190400021285E0L, + +b0 = 8.214973713960928795704317259806842490498E3L, +b1 = 1.026343508841367384879065363925870888012E4L, +b2 = 4.553337477045763320522762343132210919277E3L, +b3 = 8.506975785032585797446253359230031874803E2L, +b4 = 6.042447899703295436820744186992189445813E1L, +/* b5 = 1.000000000000000000000000000000000000000E0 */ + + +tc = 1.4616321449683623412626595423257213284682E0L, +tf = -1.2148629053584961146050602565082954242826E-1, /* double precision */ +/* tt = (tail of tf), i.e. tf + tt has extended precision. */ +tt = 3.3649914684731379602768989080467587736363E-18L, +/* lgam ( 1.4616321449683623412626595423257213284682E0 ) = +-1.2148629053584960809551455717769158215135617312999903886372437313313530E-1 */ + +/* lgam (x + tc) = tf + tt + x g(x)/h(x) + -0.230003726999612341262659542325721328468 <= x + <= 0.2699962730003876587373404576742786715318 + peak relative error 2.1e-21 */ +g0 = 3.645529916721223331888305293534095553827E-18L, +g1 = 5.126654642791082497002594216163574795690E3L, +g2 = 8.828603575854624811911631336122070070327E3L, +g3 = 5.464186426932117031234820886525701595203E3L, +g4 = 1.455427403530884193180776558102868592293E3L, +g5 = 1.541735456969245924860307497029155838446E2L, +g6 = 4.335498275274822298341872707453445815118E0L, + +h0 = 1.059584930106085509696730443974495979641E4L, +h1 = 2.147921653490043010629481226937850618860E4L, +h2 = 1.643014770044524804175197151958100656728E4L, +h3 = 5.869021995186925517228323497501767586078E3L, +h4 = 9.764244777714344488787381271643502742293E2L, +h5 = 6.442485441570592541741092969581997002349E1L, +/* h6 = 1.000000000000000000000000000000000000000E0 */ + + +/* lgam (x+1) = -0.5 x + x u(x)/v(x) + -0.100006103515625 <= x <= 0.231639862060546875 + peak relative error 1.3e-21 */ +u0 = -8.886217500092090678492242071879342025627E1L, +u1 = 6.840109978129177639438792958320783599310E2L, +u2 = 2.042626104514127267855588786511809932433E3L, +u3 = 1.911723903442667422201651063009856064275E3L, +u4 = 7.447065275665887457628865263491667767695E2L, +u5 = 1.132256494121790736268471016493103952637E2L, +u6 = 4.484398885516614191003094714505960972894E0L, + +v0 = 1.150830924194461522996462401210374632929E3L, +v1 = 3.399692260848747447377972081399737098610E3L, +v2 = 3.786631705644460255229513563657226008015E3L, +v3 = 1.966450123004478374557778781564114347876E3L, +v4 = 4.741359068914069299837355438370682773122E2L, +v5 = 4.508989649747184050907206782117647852364E1L, +/* v6 = 1.000000000000000000000000000000000000000E0 */ + + +/* lgam (x+2) = .5 x + x s(x)/r(x) + 0 <= x <= 1 + peak relative error 7.2e-22 */ +s0 = 1.454726263410661942989109455292824853344E6L, +s1 = -3.901428390086348447890408306153378922752E6L, +s2 = -6.573568698209374121847873064292963089438E6L, +s3 = -3.319055881485044417245964508099095984643E6L, +s4 = -7.094891568758439227560184618114707107977E5L, +s5 = -6.263426646464505837422314539808112478303E4L, +s6 = -1.684926520999477529949915657519454051529E3L, + +r0 = -1.883978160734303518163008696712983134698E7L, +r1 = -2.815206082812062064902202753264922306830E7L, +r2 = -1.600245495251915899081846093343626358398E7L, +r3 = -4.310526301881305003489257052083370058799E6L, +r4 = -5.563807682263923279438235987186184968542E5L, +r5 = -3.027734654434169996032905158145259713083E4L, +r6 = -4.501995652861105629217250715790764371267E2L, +/* r6 = 1.000000000000000000000000000000000000000E0 */ + + +/* lgam(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x w(1/x^2) + x >= 8 + Peak relative error 1.51e-21 +w0 = LS2PI - 0.5 */ +w0 = 4.189385332046727417803e-1L, +w1 = 8.333333333333331447505E-2L, +w2 = -2.777777777750349603440E-3L, +w3 = 7.936507795855070755671E-4L, +w4 = -5.952345851765688514613E-4L, +w5 = 8.412723297322498080632E-4L, +w6 = -1.880801938119376907179E-3L, +w7 = 4.885026142432270781165E-3L; + +static const long double zero = 0.0L; + +static long double sin_pi(long double x) +{ + long double y, z; + int n, ix; + uint32_t se, i0, i1; + + GET_LDOUBLE_WORDS(se, i0, i1, x); + ix = se & 0x7fff; + ix = (ix << 16) | (i0 >> 16); + if (ix < 0x3ffd8000) /* 0.25 */ + return sinl(pi * x); + y = -x; /* x is assume negative */ + + /* + * argument reduction, make sure inexact flag not raised if input + * is an integer + */ + z = floorl(y); + if (z != y) { /* inexact anyway */ + y *= 0.5; + y = 2.0*(y - floorl(y));/* y = |x| mod 2.0 */ + n = (int) (y*4.0); + } else { + if (ix >= 0x403f8000) { /* 2^64 */ + y = zero; /* y must be even */ + n = 0; + } else { + if (ix < 0x403e8000) /* 2^63 */ + z = y + two63; /* exact */ + GET_LDOUBLE_WORDS(se, i0, i1, z); + n = i1 & 1; + y = n; + n <<= 2; + } + } + + switch (n) { + case 0: + y = sinl(pi * y); + break; + case 1: + case 2: + y = cosl(pi * (half - y)); + break; + case 3: + case 4: + y = sinl(pi * (one - y)); + break; + case 5: + case 6: + y = -cosl(pi * (y - 1.5)); + break; + default: + y = sinl(pi * (y - 2.0)); + break; + } + return -y; +} + +long double lgammal_r(long double x, int *sg) { + long double t, y, z, nadj, p, p1, p2, q, r, w; + int i, ix; + uint32_t se, i0, i1; + + *sg = 1; + GET_LDOUBLE_WORDS(se, i0, i1, x); + ix = se & 0x7fff; + + if ((ix | i0 | i1) == 0) { + if (se & 0x8000) + *sg = -1; + return one / fabsl(x); + } + + ix = (ix << 16) | (i0 >> 16); + + /* purge off +-inf, NaN, +-0, and negative arguments */ + if (ix >= 0x7fff0000) + return x * x; + + if (ix < 0x3fc08000) { /* |x|<2**-63, return -log(|x|) */ + if (se & 0x8000) { + *sg = -1; + return -logl(-x); + } + return -logl(x); + } + if (se & 0x8000) { + t = sin_pi (x); + if (t == zero) + return one / fabsl(t); /* -integer */ + nadj = logl(pi / fabsl(t * x)); + if (t < zero) + *sg = -1; + x = -x; + } + + /* purge off 1 and 2 */ + if ((((ix - 0x3fff8000) | i0 | i1) == 0) || + (((ix - 0x40008000) | i0 | i1) == 0)) + r = 0; + else if (ix < 0x40008000) { /* x < 2.0 */ + if (ix <= 0x3ffee666) { /* 8.99993896484375e-1 */ + /* lgamma(x) = lgamma(x+1) - log(x) */ + r = -logl (x); + if (ix >= 0x3ffebb4a) { /* 7.31597900390625e-1 */ + y = x - one; + i = 0; + } else if (ix >= 0x3ffced33) { /* 2.31639862060546875e-1 */ + y = x - (tc - one); + i = 1; + } else { /* x < 0.23 */ + y = x; + i = 2; + } + } else { + r = zero; + if (ix >= 0x3fffdda6) { /* 1.73162841796875 */ + /* [1.7316,2] */ + y = x - 2.0; + i = 0; + } else if (ix >= 0x3fff9da6) { /* 1.23162841796875 */ + /* [1.23,1.73] */ + y = x - tc; + i = 1; + } else { + /* [0.9, 1.23] */ + y = x - one; + i = 2; + } + } + switch (i) { + case 0: + p1 = a0 + y * (a1 + y * (a2 + y * (a3 + y * (a4 + y * a5)))); + p2 = b0 + y * (b1 + y * (b2 + y * (b3 + y * (b4 + y)))); + r += half * y + y * p1/p2; + break; + case 1: + p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6))))); + p2 = h0 + y * (h1 + y * (h2 + y * (h3 + y * (h4 + y * (h5 + y))))); + p = tt + y * p1/p2; + r += (tf + p); + break; + case 2: + p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * (u5 + y * u6)))))); + p2 = v0 + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * (v5 + y))))); + r += (-half * y + p1 / p2); + } + } else if (ix < 0x40028000) { /* 8.0 */ + /* x < 8.0 */ + i = (int)x; + t = zero; + y = x - (double)i; + p = y * (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6)))))); + q = r0 + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * (r6 + y)))))); + r = half * y + p / q; + z = one;/* lgamma(1+s) = log(s) + lgamma(s) */ + switch (i) { + case 7: + z *= (y + 6.0); /* FALLTHRU */ + case 6: + z *= (y + 5.0); /* FALLTHRU */ + case 5: + z *= (y + 4.0); /* FALLTHRU */ + case 4: + z *= (y + 3.0); /* FALLTHRU */ + case 3: + z *= (y + 2.0); /* FALLTHRU */ + r += logl (z); + break; + } + } else if (ix < 0x40418000) { /* 2^66 */ + /* 8.0 <= x < 2**66 */ + t = logl (x); + z = one / x; + y = z * z; + w = w0 + z * (w1 + y * (w2 + y * (w3 + y * (w4 + y * (w5 + y * (w6 + y * w7)))))); + r = (x - half) * (t - one) + w; + } else /* 2**66 <= x <= inf */ + r = x * (logl (x) - one); + if (se & 0x8000) + r = nadj - r; + return r; +} +#endif diff --git a/src/math/llrint.c b/src/math/llrint.c new file mode 100644 index 00000000..c0a40721 --- /dev/null +++ b/src/math/llrint.c @@ -0,0 +1,8 @@ +#define type double +#define roundit rint +#define dtype long long +#define fn llrint + +#include "lrint.c" + + diff --git a/src/math/llrintf.c b/src/math/llrintf.c new file mode 100644 index 00000000..f06a3c27 --- /dev/null +++ b/src/math/llrintf.c @@ -0,0 +1,6 @@ +#define type float +#define roundit rintf +#define dtype long long +#define fn llrintf + +#include "lrint.c" diff --git a/src/math/llrintl.c b/src/math/llrintl.c new file mode 100644 index 00000000..6b0838d4 --- /dev/null +++ b/src/math/llrintl.c @@ -0,0 +1,14 @@ +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long long llrintl(long double x) +{ + return llrint(x); +} +#else +#define type long double +#define roundit rintl +#define dtype long long +#define fn llrintl + +#include "lrint.c" +#endif diff --git a/src/math/llround.c b/src/math/llround.c new file mode 100644 index 00000000..c11fc3ba --- /dev/null +++ b/src/math/llround.c @@ -0,0 +1,10 @@ +#define type double +#define roundit round +#define dtype long long +#define DTYPE_MIN LLONG_MIN +#define DTYPE_MAX LLONG_MAX +#define fn llround + +#include "lround.c" + + diff --git a/src/math/llroundf.c b/src/math/llroundf.c new file mode 100644 index 00000000..594ce967 --- /dev/null +++ b/src/math/llroundf.c @@ -0,0 +1,8 @@ +#define type float +#define roundit roundf +#define dtype long long +#define DTYPE_MIN LLONG_MIN +#define DTYPE_MAX LLONG_MAX +#define fn llroundf + +#include "lround.c" diff --git a/src/math/llroundl.c b/src/math/llroundl.c new file mode 100644 index 00000000..9e2cfdc7 --- /dev/null +++ b/src/math/llroundl.c @@ -0,0 +1,16 @@ +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long long llroundl(long double x) +{ + return llround(x); +} +#else +#define type long double +#define roundit roundl +#define dtype long long +#define DTYPE_MIN LLONG_MIN +#define DTYPE_MAX LLONG_MAX +#define fn llroundl + +#include "lround.c" +#endif diff --git a/src/math/log.c b/src/math/log.c new file mode 100644 index 00000000..1bb006a3 --- /dev/null +++ b/src/math/log.c @@ -0,0 +1,140 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_log.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* log(x) + * Return the logrithm of x + * + * Method : + * 1. Argument Reduction: find k and f such that + * x = 2^k * (1+f), + * where sqrt(2)/2 < 1+f < sqrt(2) . + * + * 2. Approximation of log(1+f). + * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s) + * = 2s + 2/3 s**3 + 2/5 s**5 + ....., + * = 2s + s*R + * We use a special Remez algorithm on [0,0.1716] to generate + * a polynomial of degree 14 to approximate R The maximum error + * of this polynomial approximation is bounded by 2**-58.45. In + * other words, + * 2 4 6 8 10 12 14 + * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s + * (the values of Lg1 to Lg7 are listed in the program) + * and + * | 2 14 | -58.45 + * | Lg1*s +...+Lg7*s - R(z) | <= 2 + * | | + * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2. + * In order to guarantee error in log below 1ulp, we compute log + * by + * log(1+f) = f - s*(f - R) (if f is not too large) + * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy) + * + * 3. Finally, log(x) = k*ln2 + log(1+f). + * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo))) + * Here ln2 is split into two floating point number: + * ln2_hi + ln2_lo, + * where n*ln2_hi is always exact for |n| < 2000. + * + * Special cases: + * log(x) is NaN with signal if x < 0 (including -INF) ; + * log(+INF) is +INF; log(0) is -INF with signal; + * log(NaN) is that NaN with no signal. + * + * Accuracy: + * according to an error analysis, the error is always less than + * 1 ulp (unit in the last place). + * + * Constants: + * The hexadecimal values are the intended ones for the following + * constants. The decimal values may be used, provided that the + * compiler will convert from decimal to binary accurately enough + * to produce the hexadecimal values shown. + */ + +#include "libm.h" + +static const double +ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ +ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ +two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ +Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ +Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ +Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ +Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */ +Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */ +Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */ +Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ + +static const double zero = 0.0; + +double log(double x) +{ + double hfsq,f,s,z,R,w,t1,t2,dk; + int32_t k,hx,i,j; + uint32_t lx; + + EXTRACT_WORDS(hx, lx, x); + + k = 0; + if (hx < 0x00100000) { /* x < 2**-1022 */ + if (((hx&0x7fffffff)|lx) == 0) + return -two54/zero; /* log(+-0)=-inf */ + if (hx < 0) + return (x-x)/zero; /* log(-#) = NaN */ + /* subnormal number, scale up x */ + k -= 54; + x *= two54; + GET_HIGH_WORD(hx,x); + } + if (hx >= 0x7ff00000) + return x+x; + k += (hx>>20) - 1023; + hx &= 0x000fffff; + i = (hx+0x95f64)&0x100000; + SET_HIGH_WORD(x, hx|(i^0x3ff00000)); /* normalize x or x/2 */ + k += i>>20; + f = x - 1.0; + if ((0x000fffff&(2+hx)) < 3) { /* -2**-20 <= f < 2**-20 */ + if (f == zero) { + if (k == 0) { + return zero; + } + dk = (double)k; + return dk*ln2_hi + dk*ln2_lo; + } + R = f*f*(0.5-0.33333333333333333*f); + if (k == 0) + return f - R; + dk = (double)k; + return dk*ln2_hi - ((R-dk*ln2_lo)-f); + } + s = f/(2.0+f); + dk = (double)k; + z = s*s; + i = hx - 0x6147a; + w = z*z; + j = 0x6b851 - hx; + t1 = w*(Lg2+w*(Lg4+w*Lg6)); + t2 = z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7))); + i |= j; + R = t2 + t1; + if (i > 0) { + hfsq = 0.5*f*f; + if (k == 0) + return f - (hfsq-s*(hfsq+R)); + return dk*ln2_hi - ((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f); + } else { + if (k == 0) + return f - s*(f-R); + return dk*ln2_hi - ((s*(f-R)-dk*ln2_lo)-f); + } +} diff --git a/src/math/log10.c b/src/math/log10.c new file mode 100644 index 00000000..5422599a --- /dev/null +++ b/src/math/log10.c @@ -0,0 +1,84 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_log10.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * Return the base 10 logarithm of x. See e_log.c and k_log.h for most + * comments. + * + * log10(x) = (f - 0.5*f*f + k_log1p(f)) / ln10 + k * log10(2) + * in not-quite-routine extra precision. + */ + +#include "libm.h" +#include "__log1p.h" + +static const double +two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ +ivln10hi = 4.34294481878168880939e-01, /* 0x3fdbcb7b, 0x15200000 */ +ivln10lo = 2.50829467116452752298e-11, /* 0x3dbb9438, 0xca9aadd5 */ +log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */ +log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */ + +static const double zero = 0.0; + +double log10(double x) +{ + double f,hfsq,hi,lo,r,val_hi,val_lo,w,y,y2; + int32_t i,k,hx; + uint32_t lx; + + EXTRACT_WORDS(hx, lx, x); + + k = 0; + if (hx < 0x00100000) { /* x < 2**-1022 */ + if (((hx&0x7fffffff)|lx) == 0) + return -two54/zero; /* log(+-0)=-inf */ + if (hx<0) + return (x-x)/zero; /* log(-#) = NaN */ + /* subnormal number, scale up x */ + k -= 54; + x *= two54; + GET_HIGH_WORD(hx, x); + } + if (hx >= 0x7ff00000) + return x+x; + if (hx == 0x3ff00000 && lx == 0) + return zero; /* log(1) = +0 */ + k += (hx>>20) - 1023; + hx &= 0x000fffff; + i = (hx+0x95f64)&0x100000; + SET_HIGH_WORD(x, hx|(i^0x3ff00000)); /* normalize x or x/2 */ + k += i>>20; + y = (double)k; + f = x - 1.0; + hfsq = 0.5*f*f; + r = __log1p(f); + + /* See log2.c for details. */ + hi = f - hfsq; + SET_LOW_WORD(hi, 0); + lo = (f - hi) - hfsq + r; + val_hi = hi*ivln10hi; + y2 = y*log10_2hi; + val_lo = y*log10_2lo + (lo+hi)*ivln10lo + lo*ivln10hi; + + /* + * Extra precision in for adding y*log10_2hi is not strictly needed + * since there is no very large cancellation near x = sqrt(2) or + * x = 1/sqrt(2), but we do it anyway since it costs little on CPUs + * with some parallelism and it reduces the error for many args. + */ + w = y2 + val_hi; + val_lo += (y2 - w) + val_hi; + val_hi = w; + + return val_lo + val_hi; +} diff --git a/src/math/log10f.c b/src/math/log10f.c new file mode 100644 index 00000000..4175cce2 --- /dev/null +++ b/src/math/log10f.c @@ -0,0 +1,71 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_log10f.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * See comments in log10.c. + */ + +#include "libm.h" +#include "__log1pf.h" + +static const float +two25 = 3.3554432000e+07, /* 0x4c000000 */ +ivln10hi = 4.3432617188e-01, /* 0x3ede6000 */ +ivln10lo = -3.1689971365e-05, /* 0xb804ead9 */ +log10_2hi = 3.0102920532e-01, /* 0x3e9a2080 */ +log10_2lo = 7.9034151668e-07; /* 0x355427db */ + +static const float zero = 0.0; + +float log10f(float x) +{ + float f,hfsq,hi,lo,r,y; + int32_t i,k,hx; + + GET_FLOAT_WORD(hx, x); + + k = 0; + if (hx < 0x00800000) { /* x < 2**-126 */ + if ((hx&0x7fffffff) == 0) + return -two25/zero; /* log(+-0)=-inf */ + if (hx < 0) + return (x-x)/zero; /* log(-#) = NaN */ + /* subnormal number, scale up x */ + k -= 25; + x *= two25; + GET_FLOAT_WORD(hx, x); + } + if (hx >= 0x7f800000) + return x+x; + if (hx == 0x3f800000) + return zero; /* log(1) = +0 */ + k += (hx>>23) - 127; + hx &= 0x007fffff; + i = (hx+(0x4afb0d))&0x800000; + SET_FLOAT_WORD(x, hx|(i^0x3f800000)); /* normalize x or x/2 */ + k += i>>23; + y = (float)k; + f = x - (float)1.0; + hfsq = (float)0.5*f*f; + r = __log1pf(f); + +// FIXME +// /* See log2f.c and log2.c for details. */ +// if (sizeof(float_t) > sizeof(float)) +// return (r - hfsq + f) * ((float_t)ivln10lo + ivln10hi) + +// y * ((float_t)log10_2lo + log10_2hi); + hi = f - hfsq; + GET_FLOAT_WORD(hx, hi); + SET_FLOAT_WORD(hi, hx&0xfffff000); + lo = (f - hi) - hfsq + r; + return y*log10_2lo + (lo+hi)*ivln10lo + lo*ivln10hi + + hi*ivln10hi + y*log10_2hi; +} diff --git a/src/math/log10l.c b/src/math/log10l.c new file mode 100644 index 00000000..3a858833 --- /dev/null +++ b/src/math/log10l.c @@ -0,0 +1,186 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_log10l.c */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* + * Common logarithm, long double precision + * + * + * SYNOPSIS: + * + * long double x, y, log10l(); + * + * y = log10l( x ); + * + * + * DESCRIPTION: + * + * Returns the base 10 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 9.0e-20 2.6e-20 + * IEEE exp(+-10000) 30000 6.0e-20 2.3e-20 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns MINLOG + * log domain: x < 0; returns MINLOG + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double log10l(long double x) +{ + return log10(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.2e-22 + */ +static long double P[] = { + 4.9962495940332550844739E-1L, + 1.0767376367209449010438E1L, + 7.7671073698359539859595E1L, + 2.5620629828144409632571E2L, + 4.2401812743503691187826E2L, + 3.4258224542413922935104E2L, + 1.0747524399916215149070E2L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 2.3479774160285863271658E1L, + 1.9444210022760132894510E2L, + 7.7952888181207260646090E2L, + 1.6911722418503949084863E3L, + 2.0307734695595183428202E3L, + 1.2695660352705325274404E3L, + 3.2242573199748645407652E2L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +/* log10(2) */ +#define L102A 0.3125L +#define L102B -1.1470004336018804786261e-2L +/* log10(e) */ +#define L10EA 0.5L +#define L10EB -6.5705518096748172348871e-2L + +#define SQRTH 0.70710678118654752440L + +long double log10l(long double x) +{ + long double y; + volatile long double z; + int e; + + if (isnan(x)) + return x; + if(x <= 0.0L) { + if(x == 0.0L) + return -1.0L / (x - x); + return (x - x) / (x - x); + } + if (x == INFINITY) + return INFINITY; + /* separate mantissa from exponent */ + /* Note, frexp is used so that denormal numbers + * will be handled properly. + */ + x = frexpl(x, &e); + + /* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + if (e > 2 || e < -2) { + if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } else { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x*x; + y = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); + goto done; + } + + /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + if (x < SQRTH) { + e -= 1; + x = ldexpl(x, 1) - 1.0L; /* 2x - 1 */ + } else { + x = x - 1.0L; + } + z = x*x; + y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 7)); + y = y - ldexpl(z, -1); /* -0.5x^2 + ... */ + +done: + /* Multiply log of fraction by log10(e) + * and base 2 exponent by log10(2). + * + * ***CAUTION*** + * + * This sequence of operations is critical and it may + * be horribly defeated by some compiler optimizers. + */ + z = y * (L10EB); + z += x * (L10EB); + z += e * (L102B); + z += y * (L10EA); + z += x * (L10EA); + z += e * (L102A); + return z; +} +#endif diff --git a/src/math/s_log1p.c b/src/math/log1p.c index 886d5ab1..f7154d0c 100644 --- a/src/math/s_log1p.c +++ b/src/math/log1p.c @@ -1,4 +1,4 @@ -/* @(#)s_log1p.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_log1p.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,7 +9,6 @@ * is preserved. * ==================================================== */ - /* double log1p(double x) * * Method : @@ -75,13 +74,12 @@ * See HP-15C Advanced Functions Handbook, p.193. */ -#include <math.h> -#include "math_private.h" +#include "libm.h" static const double -ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ -ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ -two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ +ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ +ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ +two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ @@ -92,66 +90,82 @@ Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */ static const double zero = 0.0; -double -log1p(double x) +double log1p(double x) { - double hfsq,f=0,c=0,s,z,R,u; - int32_t k,hx,hu=0,ax; + double hfsq,f,c,s,z,R,u; + int32_t k,hx,hu,ax; - GET_HIGH_WORD(hx,x); - ax = hx&0x7fffffff; + GET_HIGH_WORD(hx, x); + ax = hx & 0x7fffffff; - k = 1; - if (hx < 0x3FDA827A) { /* x < 0.41422 */ - if(ax>=0x3ff00000) { /* x <= -1.0 */ - if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */ - else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ - } - if(ax<0x3e200000) { /* |x| < 2**-29 */ - if(two54+x>zero /* raise inexact */ - &&ax<0x3c900000) /* |x| < 2**-54 */ - return x; - else - return x - x*x*0.5; - } - if(hx>0||hx<=((int32_t)0xbfd2bec3)) { - k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */ - } - if (hx >= 0x7ff00000) return x+x; - if(k!=0) { - if(hx<0x43400000) { - u = 1.0+x; - GET_HIGH_WORD(hu,u); - k = (hu>>20)-1023; - c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */ - c /= u; - } else { - u = x; - GET_HIGH_WORD(hu,u); - k = (hu>>20)-1023; - c = 0; - } - hu &= 0x000fffff; - if(hu<0x6a09e) { - SET_HIGH_WORD(u,hu|0x3ff00000); /* normalize u */ - } else { - k += 1; - SET_HIGH_WORD(u,hu|0x3fe00000); /* normalize u/2 */ - hu = (0x00100000-hu)>>2; - } - f = u-1.0; - } - hfsq=0.5*f*f; - if(hu==0) { /* |f| < 2**-20 */ - if(f==zero) { if(k==0) return zero; - else {c += k*ln2_lo; return k*ln2_hi+c;} } - R = hfsq*(1.0-0.66666666666666666*f); - if(k==0) return f-R; else - return k*ln2_hi-((R-(k*ln2_lo+c))-f); - } - s = f/(2.0+f); - z = s*s; - R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); - if(k==0) return f-(hfsq-s*(hfsq+R)); else - return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); + k = 1; + if (hx < 0x3FDA827A) { /* 1+x < sqrt(2)+ */ + if (ax >= 0x3ff00000) { /* x <= -1.0 */ + if (x == -1.0) + return -two54/zero; /* log1p(-1)=+inf */ + return (x-x)/(x-x); /* log1p(x<-1)=NaN */ + } + if (ax < 0x3e200000) { /* |x| < 2**-29 */ + /* raise inexact */ + if (two54 + x > zero && ax < 0x3c900000) /* |x| < 2**-54 */ + return x; + return x - x*x*0.5; + } + if (hx > 0 || hx <= (int32_t)0xbfd2bec4) { /* sqrt(2)/2- <= 1+x < sqrt(2)+ */ + k = 0; + f = x; + hu = 1; + } + } + if (hx >= 0x7ff00000) + return x+x; + if (k != 0) { + if (hx < 0x43400000) { + STRICT_ASSIGN(double, u, 1.0 + x); + GET_HIGH_WORD(hu, u); + k = (hu>>20) - 1023; + c = k > 0 ? 1.0-(u-x) : x-(u-1.0); /* correction term */ + c /= u; + } else { + u = x; + GET_HIGH_WORD(hu,u); + k = (hu>>20) - 1023; + c = 0; + } + hu &= 0x000fffff; + /* + * The approximation to sqrt(2) used in thresholds is not + * critical. However, the ones used above must give less + * strict bounds than the one here so that the k==0 case is + * never reached from here, since here we have committed to + * using the correction term but don't use it if k==0. + */ + if (hu < 0x6a09e) { /* u ~< sqrt(2) */ + SET_HIGH_WORD(u, hu|0x3ff00000); /* normalize u */ + } else { + k += 1; + SET_HIGH_WORD(u, hu|0x3fe00000); /* normalize u/2 */ + hu = (0x00100000-hu)>>2; + } + f = u - 1.0; + } + hfsq = 0.5*f*f; + if (hu == 0) { /* |f| < 2**-20 */ + if (f == zero) { + if(k == 0) + return zero; + c += k*ln2_lo; + return k*ln2_hi + c; + } + R = hfsq*(1.0 - 0.66666666666666666*f); + if (k == 0) + return f - R; + return k*ln2_hi - ((R-(k*ln2_lo+c))-f); + } + s = f/(2.0+f); + z = s*s; + R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); + if (k == 0) + return f - (hfsq-s*(hfsq+R)); + return k*ln2_hi - ((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); } diff --git a/src/math/log1pf.c b/src/math/log1pf.c new file mode 100644 index 00000000..5c718152 --- /dev/null +++ b/src/math/log1pf.c @@ -0,0 +1,111 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_log1pf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ +ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ +two25 = 3.355443200e+07, /* 0x4c000000 */ +Lp1 = 6.6666668653e-01, /* 3F2AAAAB */ +Lp2 = 4.0000000596e-01, /* 3ECCCCCD */ +Lp3 = 2.8571429849e-01, /* 3E924925 */ +Lp4 = 2.2222198546e-01, /* 3E638E29 */ +Lp5 = 1.8183572590e-01, /* 3E3A3325 */ +Lp6 = 1.5313838422e-01, /* 3E1CD04F */ +Lp7 = 1.4798198640e-01; /* 3E178897 */ + +static const float zero = 0.0; + +float log1pf(float x) +{ + float hfsq,f,c,s,z,R,u; + int32_t k,hx,hu,ax; + + GET_FLOAT_WORD(hx, x); + ax = hx & 0x7fffffff; + + k = 1; + if (hx < 0x3ed413d0) { /* 1+x < sqrt(2)+ */ + if (ax >= 0x3f800000) { /* x <= -1.0 */ + if (x == (float)-1.0) + return -two25/zero; /* log1p(-1)=+inf */ + return (x-x)/(x-x); /* log1p(x<-1)=NaN */ + } + if (ax < 0x38000000) { /* |x| < 2**-15 */ + /* raise inexact */ + if (two25 + x > zero && ax < 0x33800000) /* |x| < 2**-24 */ + return x; + return x - x*x*(float)0.5; + } + if (hx > 0 || hx <= (int32_t)0xbe95f619) { /* sqrt(2)/2- <= 1+x < sqrt(2)+ */ + k = 0; + f = x; + hu = 1; + } + } + if (hx >= 0x7f800000) + return x+x; + if (k != 0) { + if (hx < 0x5a000000) { + STRICT_ASSIGN(float, u, (float)1.0 + x); + GET_FLOAT_WORD(hu, u); + k = (hu>>23) - 127; + /* correction term */ + c = k > 0 ? (float)1.0-(u-x) : x-(u-(float)1.0); + c /= u; + } else { + u = x; + GET_FLOAT_WORD(hu,u); + k = (hu>>23) - 127; + c = 0; + } + hu &= 0x007fffff; + /* + * The approximation to sqrt(2) used in thresholds is not + * critical. However, the ones used above must give less + * strict bounds than the one here so that the k==0 case is + * never reached from here, since here we have committed to + * using the correction term but don't use it if k==0. + */ + if (hu < 0x3504f4) { /* u < sqrt(2) */ + SET_FLOAT_WORD(u, hu|0x3f800000); /* normalize u */ + } else { + k += 1; + SET_FLOAT_WORD(u, hu|0x3f000000); /* normalize u/2 */ + hu = (0x00800000-hu)>>2; + } + f = u - (float)1.0; + } + hfsq = (float)0.5*f*f; + if (hu == 0) { /* |f| < 2**-20 */ + if (f == zero) { + if (k == 0) + return zero; + c += k*ln2_lo; + return k*ln2_hi+c; + } + R = hfsq*((float)1.0-(float)0.66666666666666666*f); + if (k == 0) + return f - R; + return k*ln2_hi - ((R-(k*ln2_lo+c))-f); + } + s = f/((float)2.0+f); + z = s*s; + R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); + if (k == 0) + return f - (hfsq-s*(hfsq+R)); + return k*ln2_hi - ((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); +} diff --git a/src/math/log1pl.c b/src/math/log1pl.c new file mode 100644 index 00000000..7aafc5ce --- /dev/null +++ b/src/math/log1pl.c @@ -0,0 +1,176 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/s_log1pl.c */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* + * Relative error logarithm + * Natural logarithm of 1+x, long double precision + * + * + * SYNOPSIS: + * + * long double x, y, log1pl(); + * + * y = log1pl( x ); + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of 1+x. + * + * The argument 1+x is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x^2 + x^3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z^3 P(z)/Q(z). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1.0, 9.0 100000 8.2e-20 2.5e-20 + * + * ERROR MESSAGES: + * + * log singularity: x-1 = 0; returns -INFINITY + * log domain: x-1 < 0; returns NAN + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double log1pl(long double x) +{ + return log1p(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +/* Coefficients for log(1+x) = x - x^2 / 2 + x^3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 2.32e-20 + */ +static long double P[] = { + 4.5270000862445199635215E-5L, + 4.9854102823193375972212E-1L, + 6.5787325942061044846969E0L, + 2.9911919328553073277375E1L, + 6.0949667980987787057556E1L, + 5.7112963590585538103336E1L, + 2.0039553499201281259648E1L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 1.5062909083469192043167E1L, + 8.3047565967967209469434E1L, + 2.2176239823732856465394E2L, + 3.0909872225312059774938E2L, + 2.1642788614495947685003E2L, + 6.0118660497603843919306E1L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +static const long double C1 = 6.9314575195312500000000E-1L; +static const long double C2 = 1.4286068203094172321215E-6L; + +#define SQRTH 0.70710678118654752440L + +long double log1pl(long double xm1) +{ + long double x, y, z; + int e; + + if (isnan(xm1)) + return xm1; + if (xm1 == INFINITY) + return xm1; + if (xm1 == 0.0) + return xm1; + + x = xm1 + 1.0L; + + /* Test for domain errors. */ + if (x <= 0.0L) { + if (x == 0.0L) + return -INFINITY; + return NAN; + } + + /* Separate mantissa from exponent. + Use frexp so that denormal numbers will be handled properly. */ + x = frexpl(x, &e); + + /* logarithm using log(x) = z + z^3 P(z)/Q(z), + where z = 2(x-1)/x+1) */ + if (e > 2 || e < -2) { + if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } else { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x*x; + z = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); + z = z + e * C2; + z = z + x; + z = z + e * C1; + return z; + } + + /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + if (x < SQRTH) { + e -= 1; + if (e != 0) + x = 2.0 * x - 1.0L; + else + x = xm1; + } else { + if (e != 0) + x = x - 1.0L; + else + x = xm1; + } + z = x*x; + y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 6)); + y = y + e * C2; + z = y - 0.5 * z; + z = z + x; + z = z + e * C1; + return z; +} +#endif diff --git a/src/math/log2.c b/src/math/log2.c new file mode 100644 index 00000000..a5b8abdd --- /dev/null +++ b/src/math/log2.c @@ -0,0 +1,107 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_log2.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * Return the base 2 logarithm of x. See log.c and __log1p.h for most + * comments. + * + * This reduces x to {k, 1+f} exactly as in e_log.c, then calls the kernel, + * then does the combining and scaling steps + * log2(x) = (f - 0.5*f*f + k_log1p(f)) / ln2 + k + * in not-quite-routine extra precision. + */ + +#include "libm.h" +#include "__log1p.h" + +static const double +two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ +ivln2hi = 1.44269504072144627571e+00, /* 0x3ff71547, 0x65200000 */ +ivln2lo = 1.67517131648865118353e-10; /* 0x3de705fc, 0x2eefa200 */ + +static const double zero = 0.0; + +double log2(double x) +{ + double f,hfsq,hi,lo,r,val_hi,val_lo,w,y; + int32_t i,k,hx; + uint32_t lx; + + EXTRACT_WORDS(hx, lx, x); + + k = 0; + if (hx < 0x00100000) { /* x < 2**-1022 */ + if (((hx&0x7fffffff)|lx) == 0) + return -two54/zero; /* log(+-0)=-inf */ + if (hx < 0) + return (x-x)/zero; /* log(-#) = NaN */ + /* subnormal number, scale up x */ + k -= 54; + x *= two54; + GET_HIGH_WORD(hx, x); + } + if (hx >= 0x7ff00000) + return x+x; + if (hx == 0x3ff00000 && lx == 0) + return zero; /* log(1) = +0 */ + k += (hx>>20) - 1023; + hx &= 0x000fffff; + i = (hx+0x95f64) & 0x100000; + SET_HIGH_WORD(x, hx|(i^0x3ff00000)); /* normalize x or x/2 */ + k += i>>20; + y = (double)k; + f = x - 1.0; + hfsq = 0.5*f*f; + r = __log1p(f); + + /* + * f-hfsq must (for args near 1) be evaluated in extra precision + * to avoid a large cancellation when x is near sqrt(2) or 1/sqrt(2). + * This is fairly efficient since f-hfsq only depends on f, so can + * be evaluated in parallel with R. Not combining hfsq with R also + * keeps R small (though not as small as a true `lo' term would be), + * so that extra precision is not needed for terms involving R. + * + * Compiler bugs involving extra precision used to break Dekker's + * theorem for spitting f-hfsq as hi+lo, unless double_t was used + * or the multi-precision calculations were avoided when double_t + * has extra precision. These problems are now automatically + * avoided as a side effect of the optimization of combining the + * Dekker splitting step with the clear-low-bits step. + * + * y must (for args near sqrt(2) and 1/sqrt(2)) be added in extra + * precision to avoid a very large cancellation when x is very near + * these values. Unlike the above cancellations, this problem is + * specific to base 2. It is strange that adding +-1 is so much + * harder than adding +-ln2 or +-log10_2. + * + * This uses Dekker's theorem to normalize y+val_hi, so the + * compiler bugs are back in some configurations, sigh. And I + * don't want to used double_t to avoid them, since that gives a + * pessimization and the support for avoiding the pessimization + * is not yet available. + * + * The multi-precision calculations for the multiplications are + * routine. + */ + hi = f - hfsq; + SET_LOW_WORD(hi, 0); + lo = (f - hi) - hfsq + r; + val_hi = hi*ivln2hi; + val_lo = (lo+hi)*ivln2lo + lo*ivln2hi; + + /* spadd(val_hi, val_lo, y), except for not using double_t: */ + w = y + val_hi; + val_lo += (y - w) + val_hi; + val_hi = w; + + return val_lo + val_hi; +} diff --git a/src/math/log2f.c b/src/math/log2f.c new file mode 100644 index 00000000..a968984d --- /dev/null +++ b/src/math/log2f.c @@ -0,0 +1,81 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_log2f.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * See comments in log2.c. + */ + +#include "libm.h" +#include "__log1pf.h" + +static const float +two25 = 3.3554432000e+07, /* 0x4c000000 */ +ivln2hi = 1.4428710938e+00, /* 0x3fb8b000 */ +ivln2lo = -1.7605285393e-04; /* 0xb9389ad4 */ + +static const float zero = 0.0; + +float log2f(float x) +{ + float f,hfsq,hi,lo,r,y; + int32_t i,k,hx; + + GET_FLOAT_WORD(hx, x); + + k = 0; + if (hx < 0x00800000) { /* x < 2**-126 */ + if ((hx&0x7fffffff) == 0) + return -two25/zero; /* log(+-0)=-inf */ + if (hx < 0) + return (x-x)/zero; /* log(-#) = NaN */ + /* subnormal number, scale up x */ + k -= 25; + x *= two25; + GET_FLOAT_WORD(hx, x); + } + if (hx >= 0x7f800000) + return x+x; + if (hx == 0x3f800000) + return zero; /* log(1) = +0 */ + k += (hx>>23) - 127; + hx &= 0x007fffff; + i = (hx+(0x4afb0d))&0x800000; + SET_FLOAT_WORD(x, hx|(i^0x3f800000)); /* normalize x or x/2 */ + k += i>>23; + y = (float)k; + f = x - (float)1.0; + hfsq = (float)0.5*f*f; + r = __log1pf(f); + + /* + * We no longer need to avoid falling into the multi-precision + * calculations due to compiler bugs breaking Dekker's theorem. + * Keep avoiding this as an optimization. See log2.c for more + * details (some details are here only because the optimization + * is not yet available in double precision). + * + * Another compiler bug turned up. With gcc on i386, + * (ivln2lo + ivln2hi) would be evaluated in float precision + * despite runtime evaluations using double precision. So we + * must cast one of its terms to float_t. This makes the whole + * expression have type float_t, so return is forced to waste + * time clobbering its extra precision. + */ +// FIXME +// if (sizeof(float_t) > sizeof(float)) +// return (r - hfsq + f) * ((float_t)ivln2lo + ivln2hi) + y; + + hi = f - hfsq; + GET_FLOAT_WORD(hx,hi); + SET_FLOAT_WORD(hi,hx&0xfffff000); + lo = (f - hi) - hfsq + r; + return (lo+hi)*ivln2lo + lo*ivln2hi + hi*ivln2hi + y; +} diff --git a/src/math/log2l.c b/src/math/log2l.c new file mode 100644 index 00000000..cf08b0a4 --- /dev/null +++ b/src/math/log2l.c @@ -0,0 +1,182 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_log2l.c */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* + * Base 2 logarithm, long double precision + * + * + * SYNOPSIS: + * + * long double x, y, log2l(); + * + * y = log2l( x ); + * + * + * DESCRIPTION: + * + * Returns the base 2 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the (natural) + * logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 9.8e-20 2.7e-20 + * IEEE exp(+-10000) 70000 5.4e-20 2.3e-20 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns -INFINITY + * log domain: x < 0; returns NAN + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double log2l(long double x) +{ + return log2(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +/* Coefficients for ln(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.2e-22 + */ +static long double P[] = { + 4.9962495940332550844739E-1L, + 1.0767376367209449010438E1L, + 7.7671073698359539859595E1L, + 2.5620629828144409632571E2L, + 4.2401812743503691187826E2L, + 3.4258224542413922935104E2L, + 1.0747524399916215149070E2L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 2.3479774160285863271658E1L, + 1.9444210022760132894510E2L, + 7.7952888181207260646090E2L, + 1.6911722418503949084863E3L, + 2.0307734695595183428202E3L, + 1.2695660352705325274404E3L, + 3.2242573199748645407652E2L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +/* log2(e) - 1 */ +#define LOG2EA 4.4269504088896340735992e-1L + +#define SQRTH 0.70710678118654752440L + +long double log2l(long double x) +{ + volatile long double z; + long double y; + int e; + + if (isnan(x)) + return x; + if (x == INFINITY) + return x; + if (x <= 0.0L) { + if (x == 0.0L) + return -INFINITY; + return NAN; + } + + /* separate mantissa from exponent */ + /* Note, frexp is used so that denormal numbers + * will be handled properly. + */ + x = frexpl(x, &e); + + /* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + if (e > 2 || e < -2) { + if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } else { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x*x; + y = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); + goto done; + } + + /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + if (x < SQRTH) { + e -= 1; + x = ldexpl(x, 1) - 1.0L; /* 2x - 1 */ + } else { + x = x - 1.0L; + } + z = x*x; + y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 7)); + y = y - ldexpl(z, -1); /* -0.5x^2 + ... */ + +done: + /* Multiply log of fraction by log2(e) + * and base 2 exponent by 1 + * + * ***CAUTION*** + * + * This sequence of operations is critical and it may + * be horribly defeated by some compiler optimizers. + */ + z = y * LOG2EA; + z += x * LOG2EA; + z += y; + z += x; + z += e; + return z; +} +#endif diff --git a/src/math/logb.c b/src/math/logb.c new file mode 100644 index 00000000..f7cd7613 --- /dev/null +++ b/src/math/logb.c @@ -0,0 +1,20 @@ +#include <limits.h> +#include "libm.h" + +/* +special cases: + logb(+-0) = -inf + logb(+-inf) = +inf + logb(nan) = nan +these are calculated at runtime to raise fp exceptions +*/ + +double logb(double x) { + int i = ilogb(x); + + if (i == FP_ILOGB0) + return -1.0/fabs(x); + if (i == FP_ILOGBNAN || i == INT_MAX) + return x * x; + return i; +} diff --git a/src/math/logbf.c b/src/math/logbf.c new file mode 100644 index 00000000..934827f8 --- /dev/null +++ b/src/math/logbf.c @@ -0,0 +1,12 @@ +#include <limits.h> +#include "libm.h" + +float logbf(float x) { + int i = ilogbf(x); + + if (i == FP_ILOGB0) + return -1.0f/fabsf(x); + if (i == FP_ILOGBNAN || i == INT_MAX) + return x * x; + return i; +} diff --git a/src/math/logbl.c b/src/math/logbl.c new file mode 100644 index 00000000..5d04abd7 --- /dev/null +++ b/src/math/logbl.c @@ -0,0 +1,19 @@ +#include <limits.h> +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double logbl(long double x) +{ + return logb(x); +} +#else +long double logbl(long double x) +{ + int i = ilogbl(x); + + if (i == FP_ILOGB0) + return -1.0/fabsl(x); + if (i == FP_ILOGBNAN || i == INT_MAX) + return x * x; + return i; +} +#endif diff --git a/src/math/logf.c b/src/math/logf.c new file mode 100644 index 00000000..285ee615 --- /dev/null +++ b/src/math/logf.c @@ -0,0 +1,89 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_logf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ +ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ +two25 = 3.355443200e+07, /* 0x4c000000 */ +/* |(log(1+s)-log(1-s))/s - Lg(s)| < 2**-34.24 (~[-4.95e-11, 4.97e-11]). */ +Lg1 = 0xaaaaaa.0p-24, /* 0.66666662693 */ +Lg2 = 0xccce13.0p-25, /* 0.40000972152 */ +Lg3 = 0x91e9ee.0p-25, /* 0.28498786688 */ +Lg4 = 0xf89e26.0p-26; /* 0.24279078841 */ + +static const float zero = 0.0; + +float logf(float x) +{ + float hfsq,f,s,z,R,w,t1,t2,dk; + int32_t k,ix,i,j; + + GET_FLOAT_WORD(ix, x); + + k = 0; + if (ix < 0x00800000) { /* x < 2**-126 */ + if ((ix & 0x7fffffff) == 0) + return -two25/zero; /* log(+-0)=-inf */ + if (ix < 0) + return (x-x)/zero; /* log(-#) = NaN */ + /* subnormal number, scale up x */ + k -= 25; + x *= two25; + GET_FLOAT_WORD(ix, x); + } + if (ix >= 0x7f800000) + return x+x; + k += (ix>>23) - 127; + ix &= 0x007fffff; + i = (ix + (0x95f64<<3)) & 0x800000; + SET_FLOAT_WORD(x, ix|(i^0x3f800000)); /* normalize x or x/2 */ + k += i>>23; + f = x - (float)1.0; + if ((0x007fffff & (0x8000 + ix)) < 0xc000) { /* -2**-9 <= f < 2**-9 */ + if (f == zero) { + if (k == 0) + return zero; + dk = (float)k; + return dk*ln2_hi + dk*ln2_lo; + } + R = f*f*((float)0.5 - (float)0.33333333333333333*f); + if (k == 0) + return f-R; + dk = (float)k; + return dk*ln2_hi - ((R-dk*ln2_lo)-f); + } + s = f/((float)2.0+f); + dk = (float)k; + z = s*s; + i = ix-(0x6147a<<3); + w = z*z; + j = (0x6b851<<3)-ix; + t1= w*(Lg2+w*Lg4); + t2= z*(Lg1+w*Lg3); + i |= j; + R = t2 + t1; + if (i > 0) { + hfsq = (float)0.5*f*f; + if (k == 0) + return f - (hfsq-s*(hfsq+R)); + return dk*ln2_hi - ((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f); + } else { + if (k == 0) + return f - s*(f-R); + return dk*ln2_hi - ((s*(f-R)-dk*ln2_lo)-f); + } +} diff --git a/src/math/logl.c b/src/math/logl.c new file mode 100644 index 00000000..2139b2ab --- /dev/null +++ b/src/math/logl.c @@ -0,0 +1,174 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_logl.c */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* + * Natural logarithm, long double precision + * + * + * SYNOPSIS: + * + * long double x, y, logl(); + * + * y = logl( x ); + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 150000 8.71e-20 2.75e-20 + * IEEE exp(+-10000) 100000 5.39e-20 2.34e-20 + * + * In the tests over the interval exp(+-10000), the logarithms + * of the random arguments were uniformly distributed over + * [-10000, +10000]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns -INFINITY + * log domain: x < 0; returns NAN + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double logl(long double x) +{ + return log(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 2.32e-20 + */ +static long double P[] = { + 4.5270000862445199635215E-5L, + 4.9854102823193375972212E-1L, + 6.5787325942061044846969E0L, + 2.9911919328553073277375E1L, + 6.0949667980987787057556E1L, + 5.7112963590585538103336E1L, + 2.0039553499201281259648E1L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0,*/ + 1.5062909083469192043167E1L, + 8.3047565967967209469434E1L, + 2.2176239823732856465394E2L, + 3.0909872225312059774938E2L, + 2.1642788614495947685003E2L, + 6.0118660497603843919306E1L, +}; + +/* Coefficients for log(x) = z + z^3 P(z^2)/Q(z^2), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 6.16e-22 + */ +static long double R[4] = { + 1.9757429581415468984296E-3L, +-7.1990767473014147232598E-1L, + 1.0777257190312272158094E1L, +-3.5717684488096787370998E1L, +}; +static long double S[4] = { +/* 1.00000000000000000000E0L,*/ +-2.6201045551331104417768E1L, + 1.9361891836232102174846E2L, +-4.2861221385716144629696E2L, +}; +static const long double C1 = 6.9314575195312500000000E-1L; +static const long double C2 = 1.4286068203094172321215E-6L; + +#define SQRTH 0.70710678118654752440L + +long double logl(long double x) +{ + long double y, z; + int e; + + if (isnan(x)) + return x; + if (x == INFINITY) + return x; + if (x <= 0.0L) { + if (x == 0.0L) + return -INFINITY; + return NAN; + } + + /* separate mantissa from exponent */ + /* Note, frexp is used so that denormal numbers + * will be handled properly. + */ + x = frexpl(x, &e); + + /* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + if (e > 2 || e < -2) { + if (x < SQRTH) { /* 2(2x-1)/(2x+1) */ + e -= 1; + z = x - 0.5L; + y = 0.5L * z + 0.5L; + } else { /* 2 (x-1)/(x+1) */ + z = x - 0.5L; + z -= 0.5L; + y = 0.5L * x + 0.5L; + } + x = z / y; + z = x*x; + z = x * (z * __polevll(z, R, 3) / __p1evll(z, S, 3)); + z = z + e * C2; + z = z + x; + z = z + e * C1; + return z; + } + + /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + if (x < SQRTH) { + e -= 1; + x = ldexpl(x, 1) - 1.0L; /* 2x - 1 */ + } else { + x = x - 1.0L; + } + z = x*x; + y = x * (z * __polevll(x, P, 6) / __p1evll(x, Q, 6)); + y = y + e * C2; + z = y - ldexpl(z, -1); /* y - 0.5 * z */ + /* Note, the sum of above terms does not exceed x/4, + * so it contributes at most about 1/4 lsb to the error. + */ + z = z + x; + z = z + e * C1; /* This sum has an error of 1/2 lsb. */ + return z; +} +#endif diff --git a/src/math/lrint.c b/src/math/lrint.c new file mode 100644 index 00000000..98d58ad0 --- /dev/null +++ b/src/math/lrint.c @@ -0,0 +1,56 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_lrint.c */ +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +#include <fenv.h> +#include "libm.h" + +#ifndef type +#define type double +#define roundit rint +#define dtype long +#define fn lrint +#endif + +/* + * C99 says we should not raise a spurious inexact exception when an + * invalid exception is raised. Unfortunately, the set of inputs + * that overflows depends on the rounding mode when 'dtype' has more + * significant bits than 'type'. Hence, we bend over backwards for the + * sake of correctness; an MD implementation could be more efficient. + */ +dtype fn(type x) +{ + fenv_t env; + dtype d; + + feholdexcept(&env); + d = (dtype)roundit(x); + if (fetestexcept(FE_INVALID)) + feclearexcept(FE_INEXACT); + feupdateenv(&env); + return d; +} diff --git a/src/math/lrintf.c b/src/math/lrintf.c new file mode 100644 index 00000000..caed7ca5 --- /dev/null +++ b/src/math/lrintf.c @@ -0,0 +1,6 @@ +#define type float +#define roundit rintf +#define dtype long +#define fn lrintf + +#include "lrint.c" diff --git a/src/math/lrintl.c b/src/math/lrintl.c new file mode 100644 index 00000000..7c09653e --- /dev/null +++ b/src/math/lrintl.c @@ -0,0 +1,14 @@ +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long lrintl(long double x) +{ + return lrint(x); +} +#else +#define type long double +#define roundit rintl +#define dtype long +#define fn lrintl + +#include "lrint.c" +#endif diff --git a/src/math/lround.c b/src/math/lround.c new file mode 100644 index 00000000..04a5e178 --- /dev/null +++ b/src/math/lround.c @@ -0,0 +1,64 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_lround.c */ +/*- + * Copyright (c) 2005 David Schultz <das@FreeBSD.ORG> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +#include <limits.h> +#include <fenv.h> +#include "libm.h" + +#ifndef type +#define type double +#define roundit round +#define dtype long +#define DTYPE_MIN LONG_MIN +#define DTYPE_MAX LONG_MAX +#define fn lround +#endif + +/* + * If type has more precision than dtype, the endpoints dtype_(min|max) are + * of the form xxx.5; they are "out of range" because lround() rounds away + * from 0. On the other hand, if type has less precision than dtype, then + * all values that are out of range are integral, so we might as well assume + * that everything is in range. At compile time, INRANGE(x) should reduce to + * two floating-point comparisons in the former case, or TRUE otherwise. + */ +static const type dtype_min = DTYPE_MIN - 0.5; +static const type dtype_max = DTYPE_MAX + 0.5; +#define INRANGE(x) \ + (dtype_max - DTYPE_MAX != 0.5 || ((x) > dtype_min && (x) < dtype_max)) + +dtype fn(type x) +{ + + if (INRANGE(x)) { + x = roundit(x); + return (dtype)x; + } else { + feraiseexcept(FE_INVALID); + return DTYPE_MAX; + } +} diff --git a/src/math/lroundf.c b/src/math/lroundf.c new file mode 100644 index 00000000..135ba583 --- /dev/null +++ b/src/math/lroundf.c @@ -0,0 +1,8 @@ +#define type float +#define roundit roundf +#define dtype long +#define DTYPE_MIN LONG_MIN +#define DTYPE_MAX LONG_MAX +#define fn lroundf + +#include "lround.c" diff --git a/src/math/lroundl.c b/src/math/lroundl.c new file mode 100644 index 00000000..1469127b --- /dev/null +++ b/src/math/lroundl.c @@ -0,0 +1,16 @@ +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long lroundl(long double x) +{ + return lround(x); +} +#else +#define type long double +#define roundit roundl +#define dtype long +#define DTYPE_MIN LONG_MIN +#define DTYPE_MAX LONG_MAX +#define fn lroundl + +#include "lround.c" +#endif diff --git a/src/math/math_private.h b/src/math/math_private.h deleted file mode 100644 index 28a6a195..00000000 --- a/src/math/math_private.h +++ /dev/null @@ -1,143 +0,0 @@ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#ifndef _MATH_PRIVATE_H_ -#define _MATH_PRIVATE_H_ - -#include <inttypes.h> - -/* - * The original fdlibm code used statements like: - * n0 = ((*(int*)&one)>>29)^1; * index of high word * - * ix0 = *(n0+(int*)&x); * high word of x * - * ix1 = *((1-n0)+(int*)&x); * low word of x * - * to dig two 32 bit words out of the 64 bit IEEE floating point - * value. That is non-ANSI, and, moreover, the gcc instruction - * scheduler gets it wrong. We instead use the following macros. - * Unlike the original code, we determine the endianness at compile - * time, not at run time; I don't see much benefit to selecting - * endianness at run time. - */ - -/* - * A union which permits us to convert between a double and two 32 bit - * ints. - */ - -typedef union -{ - double value; - uint64_t words; -} ieee_double_shape_type; - -/* Get two 32 bit ints from a double. */ - -#define EXTRACT_WORDS(ix0,ix1,d) \ -do { \ - ieee_double_shape_type ew_u; \ - ew_u.value = (d); \ - (ix0) = ew_u.words >> 32; \ - (ix1) = (uint32_t)ew_u.words; \ -} while (0) - -/* Get the more significant 32 bit int from a double. */ - -#define GET_HIGH_WORD(i,d) \ -do { \ - ieee_double_shape_type gh_u; \ - gh_u.value = (d); \ - (i) = gh_u.words >> 32; \ -} while (0) - -/* Get the less significant 32 bit int from a double. */ - -#define GET_LOW_WORD(i,d) \ -do { \ - ieee_double_shape_type gl_u; \ - gl_u.value = (d); \ - (i) = (uint32_t)gl_u.words; \ -} while (0) - -/* Set a double from two 32 bit ints. */ - -#define INSERT_WORDS(d,ix0,ix1) \ -do { \ - ieee_double_shape_type iw_u; \ - iw_u.words = ((uint64_t)(ix0) << 32) | (ix1); \ - (d) = iw_u.value; \ -} while (0) - -/* Set the more significant 32 bits of a double from an int. */ - -#define SET_HIGH_WORD(d,v) \ -do { \ - ieee_double_shape_type sh_u; \ - sh_u.value = (d); \ - sh_u.words &= 0xffffffff; \ - sh_u.words |= ((uint64_t)(v) << 32); \ - (d) = sh_u.value; \ -} while (0) - -/* Set the less significant 32 bits of a double from an int. */ - -#define SET_LOW_WORD(d,v) \ -do { \ - ieee_double_shape_type sl_u; \ - sl_u.value = (d); \ - sl_u.words &= 0xffffffff00000000ull; \ - sl_u.words |= (uint32_t)(v); \ - (d) = sl_u.value; \ -} while (0) - -/* - * A union which permits us to convert between a float and a 32 bit - * int. - */ - -typedef union -{ - float value; - uint32_t word; -} ieee_float_shape_type; - -/* Get a 32 bit int from a float. */ - -#define GET_FLOAT_WORD(i,d) \ -do { \ - ieee_float_shape_type gf_u; \ - gf_u.value = (d); \ - (i) = gf_u.word; \ -} while (0) - -/* Set a float from a 32 bit int. */ - -#define SET_FLOAT_WORD(d,i) \ -do { \ - ieee_float_shape_type sf_u; \ - sf_u.word = (i); \ - (d) = sf_u.value; \ -} while (0) - -/* fdlibm kernel function */ -int __ieee754_rem_pio2(double,double*); -double __kernel_sin(double,double,int); -double __kernel_cos(double,double); -double __kernel_tan(double,double,int); -int __kernel_rem_pio2(double*,double*,int,int,int,const int*); - -/* float versions of fdlibm kernel functions */ -int __ieee754_rem_pio2f(float,float*); -float __kernel_sinf(float,float,int); -float __kernel_cosf(float,float); -float __kernel_tanf(float,float,int); -int __kernel_rem_pio2f(float*,float*,int,int,int,const int*); - -#endif /* !_MATH_PRIVATE_H_ */ diff --git a/src/math/modf.c b/src/math/modf.c new file mode 100644 index 00000000..ff85b2a3 --- /dev/null +++ b/src/math/modf.c @@ -0,0 +1,70 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_modf.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * modf(double x, double *iptr) + * return fraction part of x, and return x's integral part in *iptr. + * Method: + * Bit twiddling. + * + * Exception: + * No exception. + */ + +#include "libm.h" + +static const double one = 1.0; + +double modf(double x, double *iptr) +{ + int32_t i0,i1,j0; + uint32_t i; + + EXTRACT_WORDS(i0, i1, x); + j0 = ((i0>>20) & 0x7ff) - 0x3ff; /* exponent of x */ + if (j0 < 20) { /* integer part in high x */ + if (j0 < 0) { /* |x| < 1 */ + INSERT_WORDS(*iptr, i0 & 0x80000000, 0); /* *iptr = +-0 */ + return x; + } + i = 0x000fffff >> j0; + if (((i0&i)|i1) == 0) { /* x is integral */ + uint32_t high; + *iptr = x; + GET_HIGH_WORD(high, x); + INSERT_WORDS(x, high & 0x80000000, 0); /* return +-0 */ + return x; + } + INSERT_WORDS(*iptr, i0&~i, 0); + return x - *iptr; + } else if (j0 > 51) { /* no fraction part */ + uint32_t high; + if (j0 == 0x400) { /* inf/NaN */ + *iptr = x; + return 0.0 / x; + } + *iptr = x*one; + GET_HIGH_WORD(high, x); + INSERT_WORDS(x, high & 0x80000000, 0); /* return +-0 */ + return x; + } else { /* fraction part in low x */ + i = (uint32_t)0xffffffff >> (j0 - 20); + if ((i1&i) == 0) { /* x is integral */ + uint32_t high; + *iptr = x; + GET_HIGH_WORD(high, x); + INSERT_WORDS(x, high & 0x80000000, 0); /* return +-0 */ + return x; + } + INSERT_WORDS(*iptr, i0, i1&~i); + return x - *iptr; + } +} diff --git a/src/math/modff.c b/src/math/modff.c new file mode 100644 index 00000000..d535314c --- /dev/null +++ b/src/math/modff.c @@ -0,0 +1,51 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_modff.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float one = 1.0; + +float modff(float x, float *iptr) +{ + int32_t i0,j0; + uint32_t i; + + GET_FLOAT_WORD(i0, x); + j0 = ((i0>>23) & 0xff) - 0x7f; /* exponent of x */ + if (j0 < 23) { /* integer part in x */ + if (j0 < 0) { /* |x| < 1 */ + SET_FLOAT_WORD(*iptr, i0 & 0x80000000); /* *iptr = +-0 */ + return x; + } + i = 0x007fffff >> j0; + if ((i0&i) == 0) { /* x is integral */ + uint32_t ix; + *iptr = x; + GET_FLOAT_WORD(ix, x); + SET_FLOAT_WORD(x, ix & 0x80000000); /* return +-0 */ + return x; + } + SET_FLOAT_WORD(*iptr, i0&~i); + return x - *iptr; + } else { /* no fraction part */ + uint32_t ix; + *iptr = x*one; + if (x != x) /* NaN */ + return x; + GET_FLOAT_WORD(ix, x); + SET_FLOAT_WORD(x, ix & 0x80000000); /* return +-0 */ + return x; + } +} diff --git a/src/math/modfl.c b/src/math/modfl.c new file mode 100644 index 00000000..2ca67b11 --- /dev/null +++ b/src/math/modfl.c @@ -0,0 +1,100 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_modfl.c */ +/*- + * Copyright (c) 2007 David Schultz <das@FreeBSD.ORG> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * Derived from s_modf.c, which has the following Copyright: + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double modfl(long double x, long double *iptr) +{ + return modf(x, iptr); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 + +#if LDBL_MANL_SIZE > 32 +#define MASK ((uint64_t)-1) +#else +#define MASK ((uint32_t)-1) +#endif +/* Return the last n bits of a word, representing the fractional part. */ +#define GETFRAC(bits, n) ((bits) & ~(MASK << (n))) +/* The number of fraction bits in manh, not counting the integer bit */ +#define HIBITS (LDBL_MANT_DIG - LDBL_MANL_SIZE) + +static const long double zero[] = { 0.0L, -0.0L }; + +long double modfl(long double x, long double *iptr) +{ + union IEEEl2bits ux; + int e; + + ux.e = x; + e = ux.bits.exp - LDBL_MAX_EXP + 1; + if (e < HIBITS) { /* Integer part is in manh. */ + if (e < 0) { /* |x|<1 */ + *iptr = zero[ux.bits.sign]; + return x; + } + if ((GETFRAC(ux.bits.manh, HIBITS - 1 - e)|ux.bits.manl) == 0) { + /* x is an integer. */ + *iptr = x; + return zero[ux.bits.sign]; + } + /* Clear all but the top e+1 bits. */ + ux.bits.manh >>= HIBITS - 1 - e; + ux.bits.manh <<= HIBITS - 1 - e; + ux.bits.manl = 0; + *iptr = ux.e; + return x - ux.e; + } else if (e >= LDBL_MANT_DIG - 1) { /* x has no fraction part. */ + *iptr = x; + if (x != x) /* Handle NaNs. */ + return x; + return zero[ux.bits.sign]; + } else { /* Fraction part is in manl. */ + if (GETFRAC(ux.bits.manl, LDBL_MANT_DIG - 1 - e) == 0) { + /* x is integral. */ + *iptr = x; + return zero[ux.bits.sign]; + } + /* Clear all but the top e+1 bits. */ + ux.bits.manl >>= LDBL_MANT_DIG - 1 - e; + ux.bits.manl <<= LDBL_MANT_DIG - 1 - e; + *iptr = ux.e; + return x - ux.e; + } +} +#endif diff --git a/src/math/nearbyint.c b/src/math/nearbyint.c new file mode 100644 index 00000000..781769fb --- /dev/null +++ b/src/math/nearbyint.c @@ -0,0 +1,20 @@ +#include <fenv.h> +#include "libm.h" + +/* +rint may raise inexact (and it should not alter the fenv otherwise) +nearbyint must not raise inexact + +(according to ieee754r section 7.9 both functions should raise invalid +when the input is signaling nan, but c99 does not define snan so saving +and restoring the entire fenv should be fine) +*/ + +double nearbyint(double x) { + fenv_t e; + + fegetenv(&e); + x = rint(x); + fesetenv(&e); + return x; +} diff --git a/src/math/nearbyintf.c b/src/math/nearbyintf.c new file mode 100644 index 00000000..e4bdb26c --- /dev/null +++ b/src/math/nearbyintf.c @@ -0,0 +1,11 @@ +#include <fenv.h> +#include "libm.h" + +float nearbyintf(float x) { + fenv_t e; + + fegetenv(&e); + x = rintf(x); + fesetenv(&e); + return x; +} diff --git a/src/math/nearbyintl.c b/src/math/nearbyintl.c new file mode 100644 index 00000000..b58527c8 --- /dev/null +++ b/src/math/nearbyintl.c @@ -0,0 +1,18 @@ +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double nearbyintl(long double x) +{ + return nearbyint(x); +} +#else +#include <fenv.h> +long double nearbyintl(long double x) +{ + fenv_t e; + + fegetenv(&e); + x = rintl(x); + fesetenv(&e); + return x; +} +#endif diff --git a/src/math/nextafter.c b/src/math/nextafter.c new file mode 100644 index 00000000..5e53654a --- /dev/null +++ b/src/math/nextafter.c @@ -0,0 +1,79 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_nextafter.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* IEEE functions + * nextafter(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include "libm.h" + +double nextafter(double x, double y) +{ + volatile double t; + int32_t hx,hy,ix,iy; + uint32_t lx,ly; + + EXTRACT_WORDS(hx, lx, x); + EXTRACT_WORDS(hy, ly, y); + ix = hx & 0x7fffffff; /* |x| */ + iy = hy & 0x7fffffff; /* |y| */ + + if ((ix >= 0x7ff00000 && (ix-0x7ff00000)|lx) != 0 || /* x is nan */ + (iy >= 0x7ff00000 && (iy-0x7ff00000)|ly) != 0) /* y is nan */ + return x+y; + if (x == y) /* x == y */ + return y; + if ((ix|lx) == 0) { /* x == 0 */ + INSERT_WORDS(x, hy&0x80000000, 1); /* return +-minsubnormal */ + /* raise underflow flag */ + t = x*x; + if (t == x) + return t; + return x; + } + if (hx >= 0) { /* x > 0 */ + if (hx > hy || (hx == hy && lx > ly)) { /* x > y, x -= ulp */ + if (lx == 0) + hx--; + lx--; + } else { /* x < y, x += ulp */ + lx++; + if (lx == 0) + hx++; + } + } else { /* x < 0 */ + if (hy >= 0 || hx > hy || (hx == hy && lx > ly)) { /* x < y, x -= ulp */ + if (lx == 0) + hx--; + lx--; + } else { /* x > y, x += ulp */ + lx++; + if (lx == 0) + hx++; + } + } + hy = hx & 0x7ff00000; + if (hy >= 0x7ff00000) /* overflow */ + return x+x; + if (hy < 0x00100000) { /* underflow */ + /* raise underflow flag */ + t = x*x; + if (t != x) { + INSERT_WORDS(y, hx, lx); + return y; + } + } + INSERT_WORDS(x, hx, lx); + return x; +} diff --git a/src/math/nextafterf.c b/src/math/nextafterf.c new file mode 100644 index 00000000..bdc88cab --- /dev/null +++ b/src/math/nextafterf.c @@ -0,0 +1,67 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_nextafterf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +float nextafterf(float x, float y) +{ + volatile float t; + int32_t hx,hy,ix,iy; + + GET_FLOAT_WORD(hx, x); + GET_FLOAT_WORD(hy, y); + ix = hx & 0x7fffffff; /* |x| */ + iy = hy & 0x7fffffff; /* |y| */ + + if (ix > 0x7f800000 || /* x is nan */ + iy > 0x7f800000) /* y is nan */ + return x+y; + if (x == y) /* x == y */ + return y; + if (ix == 0) { /* x == 0 */ + SET_FLOAT_WORD(x, (hy&0x80000000)|1); /* return +-minsubnormal */ + /* raise underflow flag */ + t = x*x; + if (t == x) + return t; + return x; + } + if (hx >= 0) { /* x > 0 */ + if (hx > hy) { /* x > y, x -= ulp */ + hx--; + } else { /* x < y, x += ulp */ + hx++; + } + } else { /* x < 0 */ + if (hy >= 0 || hx > hy) { /* x < y, x -= ulp */ + hx--; + } else { /* x > y, x += ulp */ + hx++; + } + } + hy = hx & 0x7f800000; + if (hy >= 0x7f800000) /* overflow */ + return x+x; + if (hy < 0x00800000) { /* underflow */ + /* raise underflow flag */ + t = x*x; + if (t != x) { + SET_FLOAT_WORD(y, hx); + return y; + } + } + SET_FLOAT_WORD(x, hx); + return x; +} diff --git a/src/math/nextafterl.c b/src/math/nextafterl.c new file mode 100644 index 00000000..aec8ab40 --- /dev/null +++ b/src/math/nextafterl.c @@ -0,0 +1,77 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_nextafterl.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* IEEE functions + * nextafter(x,y) + * return the next machine floating-point number of x in the + * direction toward y. + * Special cases: + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double nextafterl(long double x, long double y) +{ + return nextafter(x, y); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +long double nextafterl(long double x, long double y) +{ + volatile long double t; + union IEEEl2bits ux, uy; + + ux.e = x; + uy.e = y; + + if ((ux.bits.exp == 0x7fff && ((ux.bits.manh&~LDBL_NBIT)|ux.bits.manl) != 0) || + (uy.bits.exp == 0x7fff && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) + return x+y; /* x or y is nan */ + if (x == y) + return y; /* x=y, return y */ + if (x == 0.0) { + /* return +-minsubnormal */ + ux.bits.manh = 0; + ux.bits.manl = 1; + ux.bits.sign = uy.bits.sign; + /* raise underflow flag */ + t = ux.e*ux.e; + if (t == ux.e) + return t; + return ux.e; + } + if(x > 0.0 ^ x < y) { /* x -= ulp */ + if (ux.bits.manl == 0) { + if ((ux.bits.manh&~LDBL_NBIT) == 0) + ux.bits.exp--; + ux.bits.manh = (ux.bits.manh - 1) | (ux.bits.manh & LDBL_NBIT); + } + ux.bits.manl--; + } else { /* x += ulp */ + ux.bits.manl++; + if (ux.bits.manl == 0) { + ux.bits.manh = (ux.bits.manh + 1) | (ux.bits.manh & LDBL_NBIT); + if ((ux.bits.manh&~LDBL_NBIT)==0) + ux.bits.exp++; + } + } + if (ux.bits.exp == 0x7fff) /* overflow */ + return x+x; + if (ux.bits.exp == 0) { /* underflow */ + mask_nbit_l(ux); + /* raise underflow flag */ + t = ux.e * ux.e; + if (t != ux.e) + return ux.e; + } + return ux.e; +} +#endif diff --git a/src/math/nexttoward.c b/src/math/nexttoward.c new file mode 100644 index 00000000..5e12c48b --- /dev/null +++ b/src/math/nexttoward.c @@ -0,0 +1,67 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_nexttoward.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +double nexttoward(double x, long double y) +{ + return nextafter(x, y); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +double nexttoward(double x, long double y) +{ + union IEEEl2bits uy; + volatile double t; + int32_t hx,ix; + uint32_t lx; + + EXTRACT_WORDS(hx, lx, x); + ix = hx & 0x7fffffff; + uy.e = y; + + if ((ix >= 0x7ff00000 && ((ix-0x7ff00000)|lx) != 0) || + (uy.bits.exp == 0x7fff && ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) + return x + y; /* x or y is nan */ + if (x == y) + return (double)y; + if (x == 0.0) { + INSERT_WORDS(x, uy.bits.sign<<31, 1); /* return +-minsubnormal */ + /* raise underflow */ + t = x * x; + if (t == x) + return t; + return x; + } + if (hx > 0.0 ^ x < y) { /* x -= ulp */ + if (lx == 0) + hx--; + lx--; + } else { /* x += ulp */ + lx++; + if (lx == 0) + hx++; + } + ix = hx & 0x7ff00000; + if (ix >= 0x7ff00000) /* overflow */ + return x + x; + if (ix < 0x00100000) { /* underflow */ + /* raise underflow flag */ + t = x * x; + if (t != x) { + INSERT_WORDS(x, hx, lx); + return x; + } + } + INSERT_WORDS(x, hx, lx); + return x; +} +#endif diff --git a/src/math/nexttowardf.c b/src/math/nexttowardf.c new file mode 100644 index 00000000..c52ef3aa --- /dev/null +++ b/src/math/nexttowardf.c @@ -0,0 +1,62 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_nexttowardf.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +// FIXME +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +#define LDBL_INFNAN_EXP (LDBL_MAX_EXP * 2 - 1) + +float nexttowardf(float x, long double y) +{ + union IEEEl2bits uy; + volatile float t; + int32_t hx,ix; + + GET_FLOAT_WORD(hx, x); + ix = hx & 0x7fffffff; /* |x| */ + uy.e = y; + + if (ix > 0x7f800000 || + (uy.bits.exp == LDBL_INFNAN_EXP && + ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl) != 0)) + return x + y; /* x or y is nan */ + if (x == y) + return (float)y; /* x=y, return y */ + if (ix == 0) { /* x == 0 */ + SET_FLOAT_WORD(x, (uy.bits.sign<<31)|1); /* return +-minsubnormal */ + /* raise underflow flag */ + t = x*x; + if (t == x) + return t; + return x; + } + if (hx >= 0 ^ x < y) /* x -= ulp */ + hx--; + else /* x += ulp */ + hx++; + ix = hx & 0x7f800000; + if (ix >= 0x7f800000) /* overflow */ + return x+x; + if (ix < 0x00800000) { /* underflow */ + /* raise underflow flag */ + t = x*x; + if (t != x) { + SET_FLOAT_WORD(x, hx); + return x; + } + } + SET_FLOAT_WORD(x, hx); + return x; +} +#endif diff --git a/src/math/nexttowardl.c b/src/math/nexttowardl.c new file mode 100644 index 00000000..c393ce97 --- /dev/null +++ b/src/math/nexttowardl.c @@ -0,0 +1,6 @@ +#include "libm.h" + +long double nexttowardl(long double x, long double y) +{ + return nextafterl(x, y); +} diff --git a/src/math/pow.c b/src/math/pow.c new file mode 100644 index 00000000..f843645d --- /dev/null +++ b/src/math/pow.c @@ -0,0 +1,326 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_pow.c */ +/* + * ==================================================== + * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved. + * + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* pow(x,y) return x**y + * + * n + * Method: Let x = 2 * (1+f) + * 1. Compute and return log2(x) in two pieces: + * log2(x) = w1 + w2, + * where w1 has 53-24 = 29 bit trailing zeros. + * 2. Perform y*log2(x) = n+y' by simulating muti-precision + * arithmetic, where |y'|<=0.5. + * 3. Return x**y = 2**n*exp(y'*log2) + * + * Special cases: + * 1. (anything) ** 0 is 1 + * 2. (anything) ** 1 is itself + * 3. (anything except 1) ** NAN is NAN, 1 ** NAN is 1 + * 4. NAN ** (anything except 0) is NAN + * 5. +-(|x| > 1) ** +INF is +INF + * 6. +-(|x| > 1) ** -INF is +0 + * 7. +-(|x| < 1) ** +INF is +0 + * 8. +-(|x| < 1) ** -INF is +INF + * 9. +-1 ** +-INF is 1 + * 10. +0 ** (+anything except 0, NAN) is +0 + * 11. -0 ** (+anything except 0, NAN, odd integer) is +0 + * 12. +0 ** (-anything except 0, NAN) is +INF + * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF + * 14. -0 ** (odd integer) = -( +0 ** (odd integer) ) + * 15. +INF ** (+anything except 0,NAN) is +INF + * 16. +INF ** (-anything except 0,NAN) is +0 + * 17. -INF ** (anything) = -0 ** (-anything) + * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer) + * 19. (-anything except 0 and inf) ** (non-integer) is NAN + * + * Accuracy: + * pow(x,y) returns x**y nearly rounded. In particular + * pow(integer,integer) + * always returns the correct integer provided it is + * representable. + * + * Constants : + * The hexadecimal values are the intended ones for the following + * constants. The decimal values may be used, provided that the + * compiler will convert from decimal to binary accurately enough + * to produce the hexadecimal values shown. + */ + +#include "libm.h" + +static const double +bp[] = {1.0, 1.5,}, +dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */ +dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */ +zero = 0.0, +one = 1.0, +two = 2.0, +two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */ +huge = 1.0e300, +tiny = 1.0e-300, +/* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ +L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */ +L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */ +L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */ +L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */ +L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */ +L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */ +P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */ +P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */ +P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */ +P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */ +P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */ +lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ +lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */ +lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */ +ovt = 8.0085662595372944372e-017, /* -(1024-log2(ovfl+.5ulp)) */ +cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */ +cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */ +cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/ +ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */ +ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/ +ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/ + +double pow(double x, double y) +{ + double z,ax,z_h,z_l,p_h,p_l; + double y1,t1,t2,r,s,t,u,v,w; + int32_t i,j,k,yisint,n; + int32_t hx,hy,ix,iy; + uint32_t lx,ly; + + EXTRACT_WORDS(hx, lx, x); + EXTRACT_WORDS(hy, ly, y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + /* y == zero: x**0 = 1 */ + if ((iy|ly) == 0) + return one; + + /* x == 1: 1**y = 1, even if y is NaN */ + if (hx == 0x3ff00000 && lx == 0) + return one; + + /* y != zero: result is NaN if either arg is NaN */ + if (ix > 0x7ff00000 || (ix == 0x7ff00000 && lx != 0) || + iy > 0x7ff00000 || (iy == 0x7ff00000 && ly != 0)) + return (x+0.0)+(y+0.0); // FIXME: x+y ? + + /* determine if y is an odd int when x < 0 + * yisint = 0 ... y is not an integer + * yisint = 1 ... y is an odd int + * yisint = 2 ... y is an even int + */ + yisint = 0; + if (hx < 0) { + if (iy >= 0x43400000) + yisint = 2; /* even integer y */ + else if (iy >= 0x3ff00000) { + k = (iy>>20) - 0x3ff; /* exponent */ + if (k > 20) { + j = ly>>(52-k); + if ((j<<(52-k)) == ly) + yisint = 2 - (j&1); + } else if (ly == 0) { + j = iy>>(20-k); + if ((j<<(20-k)) == iy) + yisint = 2 - (j&1); + } + } + } + + /* special value of y */ + if (ly == 0) { + if (iy == 0x7ff00000) { /* y is +-inf */ + if (((ix-0x3ff00000)|lx) == 0) /* (-1)**+-inf is 1 */ + return one; + else if (ix >= 0x3ff00000) /* (|x|>1)**+-inf = inf,0 */ + return hy >= 0 ? y : zero; + else /* (|x|<1)**+-inf = 0,inf */ + return hy < 0 ? -y : zero; + } + if (iy == 0x3ff00000) { /* y is +-1 */ + if (hy < 0) + return one/x; + return x; + } + if (hy == 0x40000000) /* y is 2 */ + return x*x; + if (hy == 0x3fe00000) { /* y is 0.5 */ + if (hx >= 0) /* x >= +0 */ + return sqrt(x); + } + } + + ax = fabs(x); + /* special value of x */ + if (lx == 0) { + if (ix == 0x7ff00000 || ix == 0 || ix == 0x3ff00000) { /* x is +-0,+-inf,+-1 */ + z = ax; + if (hy < 0) /* z = (1/|x|) */ + z = one/z; + if (hx < 0) { + if (((ix-0x3ff00000)|yisint) == 0) { + z = (z-z)/(z-z); /* (-1)**non-int is NaN */ + } else if (yisint == 1) + z = -z; /* (x<0)**odd = -(|x|**odd) */ + } + return z; + } + } + + /* CYGNUS LOCAL + fdlibm-5.3 fix: This used to be + n = (hx>>31)+1; + but ANSI C says a right shift of a signed negative quantity is + implementation defined. */ + n = ((uint32_t)hx>>31) - 1; + + /* (x<0)**(non-int) is NaN */ + if ((n|yisint) == 0) + return (x-x)/(x-x); + + s = one; /* s (sign of result -ve**odd) = -1 else = 1 */ + if ((n|(yisint-1)) == 0) + s = -one;/* (-ve)**(odd int) */ + + /* |y| is huge */ + if (iy > 0x41e00000) { /* if |y| > 2**31 */ + if (iy > 0x43f00000) { /* if |y| > 2**64, must o/uflow */ + if (ix <= 0x3fefffff) + return hy < 0 ? huge*huge : tiny*tiny; + if (ix >= 0x3ff00000) + return hy > 0 ? huge*huge : tiny*tiny; + } + /* over/underflow if x is not close to one */ + if (ix < 0x3fefffff) + return hy < 0 ? s*huge*huge : s*tiny*tiny; + if (ix > 0x3ff00000) + return hy > 0 ? s*huge*huge : s*tiny*tiny; + /* now |1-x| is tiny <= 2**-20, suffice to compute + log(x) by x-x^2/2+x^3/3-x^4/4 */ + t = ax - one; /* t has 20 trailing zeros */ + w = (t*t)*(0.5 - t*(0.3333333333333333333333-t*0.25)); + u = ivln2_h*t; /* ivln2_h has 21 sig. bits */ + v = t*ivln2_l - w*ivln2; + t1 = u + v; + SET_LOW_WORD(t1, 0); + t2 = v - (t1-u); + } else { + double ss,s2,s_h,s_l,t_h,t_l; + n = 0; + /* take care subnormal number */ + if (ix < 0x00100000) { + ax *= two53; + n -= 53; + GET_HIGH_WORD(ix,ax); + } + n += ((ix)>>20) - 0x3ff; + j = ix & 0x000fffff; + /* determine interval */ + ix = j | 0x3ff00000; /* normalize ix */ + if (j <= 0x3988E) /* |x|<sqrt(3/2) */ + k = 0; + else if (j < 0xBB67A) /* |x|<sqrt(3) */ + k = 1; + else { + k = 0; + n += 1; + ix -= 0x00100000; + } + SET_HIGH_WORD(ax, ix); + + /* compute ss = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ + u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ + v = one/(ax+bp[k]); + ss = u*v; + s_h = ss; + SET_LOW_WORD(s_h, 0); + /* t_h=ax+bp[k] High */ + t_h = zero; + SET_HIGH_WORD(t_h, ((ix>>1)|0x20000000) + 0x00080000 + (k<<18)); + t_l = ax - (t_h-bp[k]); + s_l = v*((u-s_h*t_h)-s_h*t_l); + /* compute log(ax) */ + s2 = ss*ss; + r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); + r += s_l*(s_h+ss); + s2 = s_h*s_h; + t_h = 3.0 + s2 + r; + SET_LOW_WORD(t_h, 0); + t_l = r - ((t_h-3.0)-s2); + /* u+v = ss*(1+...) */ + u = s_h*t_h; + v = s_l*t_h + t_l*ss; + /* 2/(3log2)*(ss+...) */ + p_h = u + v; + SET_LOW_WORD(p_h, 0); + p_l = v - (p_h-u); + z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ + z_l = cp_l*p_h+p_l*cp + dp_l[k]; + /* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */ + t = (double)n; + t1 = ((z_h + z_l) + dp_h[k]) + t; + SET_LOW_WORD(t1, 0); + t2 = z_l - (((t1 - t) - dp_h[k]) - z_h); + } + + /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ + y1 = y; + SET_LOW_WORD(y1, 0); + p_l = (y-y1)*t1 + y*t2; + p_h = y1*t1; + z = p_l + p_h; + EXTRACT_WORDS(j, i, z); + if (j >= 0x40900000) { /* z >= 1024 */ + if (((j-0x40900000)|i) != 0) /* if z > 1024 */ + return s*huge*huge; /* overflow */ + if (p_l + ovt > z - p_h) + return s*huge*huge; /* overflow */ + } else if ((j&0x7fffffff) >= 0x4090cc00) { /* z <= -1075 */ // FIXME: instead of abs(j) use unsigned j + if (((j-0xc090cc00)|i) != 0) /* z < -1075 */ + return s*tiny*tiny; /* underflow */ + if (p_l <= z - p_h) + return s*tiny*tiny; /* underflow */ + } + /* + * compute 2**(p_h+p_l) + */ + i = j & 0x7fffffff; + k = (i>>20) - 0x3ff; + n = 0; + if (i > 0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */ + n = j + (0x00100000>>(k+1)); + k = ((n&0x7fffffff)>>20) - 0x3ff; /* new k for n */ + t = zero; + SET_HIGH_WORD(t, n & ~(0x000fffff>>k)); + n = ((n&0x000fffff)|0x00100000)>>(20-k); + if (j < 0) + n = -n; + p_h -= t; + } + t = p_l + p_h; + SET_LOW_WORD(t, 0); + u = t*lg2_h; + v = (p_l-(t-p_h))*lg2 + t*lg2_l; + z = u + v; + w = v - (z-u); + t = z*z; + t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); + r = (z*t1)/(t1-two) - (w + z*w); + z = one - (r-z); + GET_HIGH_WORD(j, z); + j += n<<20; + if ((j>>20) <= 0) /* subnormal output */ + z = scalbn(z,n); + else + SET_HIGH_WORD(z, j); + return s*z; +} diff --git a/src/math/powf.c b/src/math/powf.c new file mode 100644 index 00000000..e322ff28 --- /dev/null +++ b/src/math/powf.c @@ -0,0 +1,269 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_powf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +bp[] = {1.0, 1.5,}, +dp_h[] = { 0.0, 5.84960938e-01,}, /* 0x3f15c000 */ +dp_l[] = { 0.0, 1.56322085e-06,}, /* 0x35d1cfdc */ +zero = 0.0, +one = 1.0, +two = 2.0, +two24 = 16777216.0, /* 0x4b800000 */ +huge = 1.0e30, +tiny = 1.0e-30, +/* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ +L1 = 6.0000002384e-01, /* 0x3f19999a */ +L2 = 4.2857143283e-01, /* 0x3edb6db7 */ +L3 = 3.3333334327e-01, /* 0x3eaaaaab */ +L4 = 2.7272811532e-01, /* 0x3e8ba305 */ +L5 = 2.3066075146e-01, /* 0x3e6c3255 */ +L6 = 2.0697501302e-01, /* 0x3e53f142 */ +P1 = 1.6666667163e-01, /* 0x3e2aaaab */ +P2 = -2.7777778450e-03, /* 0xbb360b61 */ +P3 = 6.6137559770e-05, /* 0x388ab355 */ +P4 = -1.6533901999e-06, /* 0xb5ddea0e */ +P5 = 4.1381369442e-08, /* 0x3331bb4c */ +lg2 = 6.9314718246e-01, /* 0x3f317218 */ +lg2_h = 6.93145752e-01, /* 0x3f317200 */ +lg2_l = 1.42860654e-06, /* 0x35bfbe8c */ +ovt = 4.2995665694e-08, /* -(128-log2(ovfl+.5ulp)) */ +cp = 9.6179670095e-01, /* 0x3f76384f =2/(3ln2) */ +cp_h = 9.6191406250e-01, /* 0x3f764000 =12b cp */ +cp_l = -1.1736857402e-04, /* 0xb8f623c6 =tail of cp_h */ +ivln2 = 1.4426950216e+00, /* 0x3fb8aa3b =1/ln2 */ +ivln2_h = 1.4426879883e+00, /* 0x3fb8aa00 =16b 1/ln2*/ +ivln2_l = 7.0526075433e-06; /* 0x36eca570 =1/ln2 tail*/ + +float powf(float x, float y) +{ + float z,ax,z_h,z_l,p_h,p_l; + float y1,t1,t2,r,s,sn,t,u,v,w; + int32_t i,j,k,yisint,n; + int32_t hx,hy,ix,iy,is; + + GET_FLOAT_WORD(hx, x); + GET_FLOAT_WORD(hy, y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + /* y == zero: x**0 = 1 */ + if (iy == 0) + return one; + + /* x == 1: 1**y = 1, even if y is NaN */ + if (hx == 0x3f800000) + return one; + + /* y != zero: result is NaN if either arg is NaN */ + if (ix > 0x7f800000 || iy > 0x7f800000) + return (x+0.0F) + (y+0.0F); + + /* determine if y is an odd int when x < 0 + * yisint = 0 ... y is not an integer + * yisint = 1 ... y is an odd int + * yisint = 2 ... y is an even int + */ + yisint = 0; + if (hx < 0) { + if (iy >= 0x4b800000) + yisint = 2; /* even integer y */ + else if (iy >= 0x3f800000) { + k = (iy>>23) - 0x7f; /* exponent */ + j = iy>>(23-k); + if ((j<<(23-k)) == iy) + yisint = 2 - (j & 1); + } + } + + /* special value of y */ + if (iy == 0x7f800000) { /* y is +-inf */ + if (ix == 0x3f800000) /* (-1)**+-inf is 1 */ + return one; + else if (ix > 0x3f800000) /* (|x|>1)**+-inf = inf,0 */ + return hy >= 0 ? y : zero; + else /* (|x|<1)**+-inf = 0,inf */ + return hy < 0 ? -y : zero; + } + if (iy == 0x3f800000) { /* y is +-1 */ + if (hy < 0) + return one/x; + return x; + } + if (hy == 0x40000000) /* y is 2 */ + return x*x; + if (hy == 0x3f000000) { /* y is 0.5 */ + if (hx >= 0) /* x >= +0 */ + return sqrtf(x); + } + + ax = fabsf(x); + /* special value of x */ + if (ix == 0x7f800000 || ix == 0 || ix == 0x3f800000) { /* x is +-0,+-inf,+-1 */ + z = ax; + if (hy < 0) /* z = (1/|x|) */ + z = one/z; + if (hx < 0) { + if (((ix-0x3f800000)|yisint) == 0) { + z = (z-z)/(z-z); /* (-1)**non-int is NaN */ + } else if (yisint == 1) + z = -z; /* (x<0)**odd = -(|x|**odd) */ + } + return z; + } + + n = ((uint32_t)hx>>31) - 1; + + /* (x<0)**(non-int) is NaN */ + if ((n|yisint) == 0) + return (x-x)/(x-x); + + sn = one; /* s (sign of result -ve**odd) = -1 else = 1 */ + if ((n|(yisint-1)) == 0) /* (-ve)**(odd int) */ + sn = -one; + + /* |y| is huge */ + if (iy > 0x4d000000) { /* if |y| > 2**27 */ + /* over/underflow if x is not close to one */ + if (ix < 0x3f7ffff8) + return hy < 0 ? sn*huge*huge : sn*tiny*tiny; + if (ix > 0x3f800007) + return hy > 0 ? sn*huge*huge : sn*tiny*tiny; + /* now |1-x| is tiny <= 2**-20, suffice to compute + log(x) by x-x^2/2+x^3/3-x^4/4 */ + t = ax - 1; /* t has 20 trailing zeros */ + w = (t*t)*((float)0.5-t*((float)0.333333333333-t*(float)0.25)); + u = ivln2_h*t; /* ivln2_h has 16 sig. bits */ + v = t*ivln2_l - w*ivln2; + t1 = u + v; + GET_FLOAT_WORD(is, t1); + SET_FLOAT_WORD(t1, is & 0xfffff000); + t2 = v - (t1-u); + } else { + float s2,s_h,s_l,t_h,t_l; + n = 0; + /* take care subnormal number */ + if (ix < 0x00800000) { + ax *= two24; + n -= 24; + GET_FLOAT_WORD(ix, ax); + } + n += ((ix)>>23) - 0x7f; + j = ix & 0x007fffff; + /* determine interval */ + ix = j | 0x3f800000; /* normalize ix */ + if (j <= 0x1cc471) /* |x|<sqrt(3/2) */ + k = 0; + else if (j < 0x5db3d7) /* |x|<sqrt(3) */ + k = 1; + else { + k = 0; + n += 1; + ix -= 0x00800000; + } + SET_FLOAT_WORD(ax, ix); + + /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ + u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ + v = one/(ax+bp[k]); + s = u*v; + s_h = s; + GET_FLOAT_WORD(is, s_h); + SET_FLOAT_WORD(s_h, is & 0xfffff000); + /* t_h=ax+bp[k] High */ + is = ((ix>>1) & 0xfffff000) | 0x20000000; + SET_FLOAT_WORD(t_h, is + 0x00400000 + (k<<21)); + t_l = ax - (t_h - bp[k]); + s_l = v*((u - s_h*t_h) - s_h*t_l); + /* compute log(ax) */ + s2 = s*s; + r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); + r += s_l*(s_h+s); + s2 = s_h*s_h; + t_h = (float)3.0 + s2 + r; + GET_FLOAT_WORD(is, t_h); + SET_FLOAT_WORD(t_h, is & 0xfffff000); + t_l = r - ((t_h - (float)3.0) - s2); + /* u+v = s*(1+...) */ + u = s_h*t_h; + v = s_l*t_h + t_l*s; + /* 2/(3log2)*(s+...) */ + p_h = u + v; + GET_FLOAT_WORD(is, p_h); + SET_FLOAT_WORD(p_h, is & 0xfffff000); + p_l = v - (p_h - u); + z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ + z_l = cp_l*p_h + p_l*cp+dp_l[k]; + /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */ + t = (float)n; + t1 = (((z_h + z_l) + dp_h[k]) + t); + GET_FLOAT_WORD(is, t1); + SET_FLOAT_WORD(t1, is & 0xfffff000); + t2 = z_l - (((t1 - t) - dp_h[k]) - z_h); + } + + /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */ + GET_FLOAT_WORD(is, y); + SET_FLOAT_WORD(y1, is & 0xfffff000); + p_l = (y-y1)*t1 + y*t2; + p_h = y1*t1; + z = p_l + p_h; + GET_FLOAT_WORD(j, z); + if (j > 0x43000000) /* if z > 128 */ + return sn*huge*huge; /* overflow */ + else if (j == 0x43000000) { /* if z == 128 */ + if (p_l + ovt > z - p_h) + return sn*huge*huge; /* overflow */ + } else if ((j&0x7fffffff) > 0x43160000) /* z < -150 */ // FIXME: check should be (uint32_t)j > 0xc3160000 + return sn*tiny*tiny; /* underflow */ + else if (j == 0xc3160000) { /* z == -150 */ + if (p_l <= z-p_h) + return sn*tiny*tiny; /* underflow */ + } + /* + * compute 2**(p_h+p_l) + */ + i = j & 0x7fffffff; + k = (i>>23) - 0x7f; + n = 0; + if (i > 0x3f000000) { /* if |z| > 0.5, set n = [z+0.5] */ + n = j + (0x00800000>>(k+1)); + k = ((n&0x7fffffff)>>23) - 0x7f; /* new k for n */ + SET_FLOAT_WORD(t, n & ~(0x007fffff>>k)); + n = ((n&0x007fffff)|0x00800000)>>(23-k); + if (j < 0) + n = -n; + p_h -= t; + } + t = p_l + p_h; + GET_FLOAT_WORD(is, t); + SET_FLOAT_WORD(t, is & 0xffff8000); + u = t*lg2_h; + v = (p_l-(t-p_h))*lg2 + t*lg2_l; + z = u + v; + w = v - (z - u); + t = z*z; + t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5)))); + r = (z*t1)/(t1-two) - (w+z*w); + z = one - (r - z); + GET_FLOAT_WORD(j, z); + j += n<<23; + if ((j>>23) <= 0) /* subnormal output */ + z = scalbnf(z, n); + else + SET_FLOAT_WORD(z, j); + return sn*z; +} diff --git a/src/math/powl.c b/src/math/powl.c new file mode 100644 index 00000000..690f2942 --- /dev/null +++ b/src/math/powl.c @@ -0,0 +1,562 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_powl.c */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* powl.c + * + * Power function, long double precision + * + * + * SYNOPSIS: + * + * long double x, y, z, powl(); + * + * z = powl( x, y ); + * + * + * DESCRIPTION: + * + * Computes x raised to the yth power. Analytically, + * + * x**y = exp( y log(x) ). + * + * Following Cody and Waite, this program uses a lookup table + * of 2**-i/32 and pseudo extended precision arithmetic to + * obtain several extra bits of accuracy in both the logarithm + * and the exponential. + * + * + * ACCURACY: + * + * The relative error of pow(x,y) can be estimated + * by y dl ln(2), where dl is the absolute error of + * the internally computed base 2 logarithm. At the ends + * of the approximation interval the logarithm equal 1/32 + * and its relative error is about 1 lsb = 1.1e-19. Hence + * the predicted relative error in the result is 2.3e-21 y . + * + * Relative error: + * arithmetic domain # trials peak rms + * + * IEEE +-1000 40000 2.8e-18 3.7e-19 + * .001 < x < 1000, with log(x) uniformly distributed. + * -1000 < y < 1000, y uniformly distributed. + * + * IEEE 0,8700 60000 6.5e-18 1.0e-18 + * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * pow overflow x**y > MAXNUM INFINITY + * pow underflow x**y < 1/MAXNUM 0.0 + * pow domain x<0 and y noninteger 0.0 + * + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double powl(long double x, long double y) +{ + return pow(x, y); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 + +/* Table size */ +#define NXT 32 +/* log2(Table size) */ +#define LNXT 5 + +/* log(1+x) = x - .5x^2 + x^3 * P(z)/Q(z) + * on the domain 2^(-1/32) - 1 <= x <= 2^(1/32) - 1 + */ +static long double P[] = { + 8.3319510773868690346226E-4L, + 4.9000050881978028599627E-1L, + 1.7500123722550302671919E0L, + 1.4000100839971580279335E0L, +}; +static long double Q[] = { +/* 1.0000000000000000000000E0L,*/ + 5.2500282295834889175431E0L, + 8.4000598057587009834666E0L, + 4.2000302519914740834728E0L, +}; +/* A[i] = 2^(-i/32), rounded to IEEE long double precision. + * If i is even, A[i] + B[i/2] gives additional accuracy. + */ +static long double A[33] = { + 1.0000000000000000000000E0L, + 9.7857206208770013448287E-1L, + 9.5760328069857364691013E-1L, + 9.3708381705514995065011E-1L, + 9.1700404320467123175367E-1L, + 8.9735453750155359320742E-1L, + 8.7812608018664974155474E-1L, + 8.5930964906123895780165E-1L, + 8.4089641525371454301892E-1L, + 8.2287773907698242225554E-1L, + 8.0524516597462715409607E-1L, + 7.8799042255394324325455E-1L, + 7.7110541270397041179298E-1L, + 7.5458221379671136985669E-1L, + 7.3841307296974965571198E-1L, + 7.2259040348852331001267E-1L, + 7.0710678118654752438189E-1L, + 6.9195494098191597746178E-1L, + 6.7712777346844636413344E-1L, + 6.6261832157987064729696E-1L, + 6.4841977732550483296079E-1L, + 6.3452547859586661129850E-1L, + 6.2092890603674202431705E-1L, + 6.0762367999023443907803E-1L, + 5.9460355750136053334378E-1L, + 5.8186242938878875689693E-1L, + 5.6939431737834582684856E-1L, + 5.5719337129794626814472E-1L, + 5.4525386633262882960438E-1L, + 5.3357020033841180906486E-1L, + 5.2213689121370692017331E-1L, + 5.1094857432705833910408E-1L, + 5.0000000000000000000000E-1L, +}; +static long double B[17] = { + 0.0000000000000000000000E0L, + 2.6176170809902549338711E-20L, +-1.0126791927256478897086E-20L, + 1.3438228172316276937655E-21L, + 1.2207982955417546912101E-20L, +-6.3084814358060867200133E-21L, + 1.3164426894366316434230E-20L, +-1.8527916071632873716786E-20L, + 1.8950325588932570796551E-20L, + 1.5564775779538780478155E-20L, + 6.0859793637556860974380E-21L, +-2.0208749253662532228949E-20L, + 1.4966292219224761844552E-20L, + 3.3540909728056476875639E-21L, +-8.6987564101742849540743E-22L, +-1.2327176863327626135542E-20L, + 0.0000000000000000000000E0L, +}; + +/* 2^x = 1 + x P(x), + * on the interval -1/32 <= x <= 0 + */ +static long double R[] = { + 1.5089970579127659901157E-5L, + 1.5402715328927013076125E-4L, + 1.3333556028915671091390E-3L, + 9.6181291046036762031786E-3L, + 5.5504108664798463044015E-2L, + 2.4022650695910062854352E-1L, + 6.9314718055994530931447E-1L, +}; + +#define douba(k) A[k] +#define doubb(k) B[k] +#define MEXP (NXT*16384.0L) +/* The following if denormal numbers are supported, else -MEXP: */ +#define MNEXP (-NXT*(16384.0L+64.0L)) +/* log2(e) - 1 */ +#define LOG2EA 0.44269504088896340735992L + +#define F W +#define Fa Wa +#define Fb Wb +#define G W +#define Ga Wa +#define Gb u +#define H W +#define Ha Wb +#define Hb Wb + +static const long double MAXLOGL = 1.1356523406294143949492E4L; +static const long double MINLOGL = -1.13994985314888605586758E4L; +static const long double LOGE2L = 6.9314718055994530941723E-1L; +static volatile long double z; +static long double w, W, Wa, Wb, ya, yb, u; +static const long double huge = 0x1p10000L; +/* XXX Prevent gcc from erroneously constant folding this. */ +static volatile long double twom10000 = 0x1p-10000L; + +static long double reducl(long double); +static long double powil(long double, int); + +long double powl(long double x, long double y) +{ + /* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ + int i, nflg, iyflg, yoddint; + long e; + + if (y == 0.0L) + return 1.0L; + if (isnan(x)) + return x; + if (isnan(y)) + return y; + if (y == 1.0L) + return x; + + // FIXME: this is wrong, see pow special cases in c99 F.9.4.4 + if (!isfinite(y) && (x == -1.0L || x == 1.0L) ) + return y - y; /* +-1**inf is NaN */ + if (x == 1.0L) + return 1.0L; + if (y >= LDBL_MAX) { + if (x > 1.0L) + return INFINITY; + if (x > 0.0L && x < 1.0L) + return 0.0L; + if (x < -1.0L) + return INFINITY; + if (x > -1.0L && x < 0.0L) + return 0.0L; + } + if (y <= -LDBL_MAX) { + if (x > 1.0L) + return 0.0L; + if (x > 0.0L && x < 1.0L) + return INFINITY; + if (x < -1.0L) + return 0.0L; + if (x > -1.0L && x < 0.0L) + return INFINITY; + } + if (x >= LDBL_MAX) { + if (y > 0.0L) + return INFINITY; + return 0.0L; + } + + w = floorl(y); + /* Set iyflg to 1 if y is an integer. */ + iyflg = 0; + if (w == y) + iyflg = 1; + + /* Test for odd integer y. */ + yoddint = 0; + if (iyflg) { + ya = fabsl(y); + ya = floorl(0.5L * ya); + yb = 0.5L * fabsl(w); + if( ya != yb ) + yoddint = 1; + } + + if (x <= -LDBL_MAX) { + if (y > 0.0L) { + if (yoddint) + return -INFINITY; + return INFINITY; + } + if (y < 0.0L) { + if (yoddint) + return -0.0L; + return 0.0; + } + } + + + nflg = 0; /* flag = 1 if x<0 raised to integer power */ + if (x <= 0.0L) { + if (x == 0.0L) { + if (y < 0.0) { + if (signbit(x) && yoddint) + return -INFINITY; + return INFINITY; + } + if (y > 0.0) { + if (signbit(x) && yoddint) + return -0.0L; + return 0.0; + } + if (y == 0.0L) + return 1.0L; /* 0**0 */ + return 0.0L; /* 0**y */ + } + if (iyflg == 0) + return (x - x) / (x - x); /* (x<0)**(non-int) is NaN */ + nflg = 1; + } + + /* Integer power of an integer. */ + if (iyflg) { + i = w; + w = floorl(x); + if (w == x && fabsl(y) < 32768.0) { + w = powil(x, (int)y); + return w; + } + } + + if (nflg) + x = fabsl(x); + + /* separate significand from exponent */ + x = frexpl(x, &i); + e = i; + + /* find significand in antilog table A[] */ + i = 1; + if (x <= douba(17)) + i = 17; + if (x <= douba(i+8)) + i += 8; + if (x <= douba(i+4)) + i += 4; + if (x <= douba(i+2)) + i += 2; + if (x >= douba(1)) + i = -1; + i += 1; + + /* Find (x - A[i])/A[i] + * in order to compute log(x/A[i]): + * + * log(x) = log( a x/a ) = log(a) + log(x/a) + * + * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a + */ + x -= douba(i); + x -= doubb(i/2); + x /= douba(i); + + /* rational approximation for log(1+v): + * + * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v) + */ + z = x*x; + w = x * (z * __polevll(x, P, 3) / __p1evll(x, Q, 3)); + w = w - ldexpl(z, -1); /* w - 0.5 * z */ + + /* Convert to base 2 logarithm: + * multiply by log2(e) = 1 + LOG2EA + */ + z = LOG2EA * w; + z += w; + z += LOG2EA * x; + z += x; + + /* Compute exponent term of the base 2 logarithm. */ + w = -i; + w = ldexpl(w, -LNXT); /* divide by NXT */ + w += e; + /* Now base 2 log of x is w + z. */ + + /* Multiply base 2 log by y, in extended precision. */ + + /* separate y into large part ya + * and small part yb less than 1/NXT + */ + ya = reducl(y); + yb = y - ya; + + /* (w+z)(ya+yb) + * = w*ya + w*yb + z*y + */ + F = z * y + w * yb; + Fa = reducl(F); + Fb = F - Fa; + + G = Fa + w * ya; + Ga = reducl(G); + Gb = G - Ga; + + H = Fb + Gb; + Ha = reducl(H); + w = ldexpl( Ga+Ha, LNXT ); + + /* Test the power of 2 for overflow */ + if (w > MEXP) + return huge * huge; /* overflow */ + if (w < MNEXP) + return twom10000 * twom10000; /* underflow */ + + e = w; + Hb = H - Ha; + + if (Hb > 0.0L) { + e += 1; + Hb -= 1.0L/NXT; /*0.0625L;*/ + } + + /* Now the product y * log2(x) = Hb + e/NXT. + * + * Compute base 2 exponential of Hb, + * where -0.0625 <= Hb <= 0. + */ + z = Hb * __polevll(Hb, R, 6); /* z = 2**Hb - 1 */ + + /* Express e/NXT as an integer plus a negative number of (1/NXT)ths. + * Find lookup table entry for the fractional power of 2. + */ + if (e < 0) + i = 0; + else + i = 1; + i = e/NXT + i; + e = NXT*i - e; + w = douba(e); + z = w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ + z = z + w; + z = ldexpl(z, i); /* multiply by integer power of 2 */ + + if (nflg) { + /* For negative x, + * find out if the integer exponent + * is odd or even. + */ + w = ldexpl(y, -1); + w = floorl(w); + w = ldexpl(w, 1); + if (w != y) + z = -z; /* odd exponent */ + } + + return z; +} + + +/* Find a multiple of 1/NXT that is within 1/NXT of x. */ +static long double reducl(long double x) +{ + long double t; + + t = ldexpl(x, LNXT); + t = floorl(t); + t = ldexpl(t, -LNXT); + return t; +} + +/* powil.c + * + * Real raised to integer power, long double precision + * + * + * SYNOPSIS: + * + * long double x, y, powil(); + * int n; + * + * y = powil( x, n ); + * + * + * DESCRIPTION: + * + * Returns argument x raised to the nth power. + * The routine efficiently decomposes n as a sum of powers of + * two. The desired power is a product of two-to-the-kth + * powers of x. Thus to compute the 32767 power of x requires + * 28 multiplications instead of 32767 multiplications. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic x domain n domain # trials peak rms + * IEEE .001,1000 -1022,1023 50000 4.3e-17 7.8e-18 + * IEEE 1,2 -1022,1023 20000 3.9e-17 7.6e-18 + * IEEE .99,1.01 0,8700 10000 3.6e-16 7.2e-17 + * + * Returns MAXNUM on overflow, zero on underflow. + */ + +static long double powil(long double x, int nn) +{ + long double ww, y; + long double s; + int n, e, sign, asign, lx; + + if (x == 0.0L) { + if (nn == 0) + return 1.0L; + else if (nn < 0) + return LDBL_MAX; + return 0.0L; + } + + if (nn == 0) + return 1.0L; + + if (x < 0.0L) { + asign = -1; + x = -x; + } else + asign = 0; + + if (nn < 0) { + sign = -1; + n = -nn; + } else { + sign = 1; + n = nn; + } + + /* Overflow detection */ + + /* Calculate approximate logarithm of answer */ + s = x; + s = frexpl( s, &lx); + e = (lx - 1)*n; + if ((e == 0) || (e > 64) || (e < -64)) { + s = (s - 7.0710678118654752e-1L) / (s + 7.0710678118654752e-1L); + s = (2.9142135623730950L * s - 0.5L + lx) * nn * LOGE2L; + } else { + s = LOGE2L * e; + } + + if (s > MAXLOGL) + return huge * huge; /* overflow */ + + if (s < MINLOGL) + return twom10000 * twom10000; /* underflow */ + /* Handle tiny denormal answer, but with less accuracy + * since roundoff error in 1.0/x will be amplified. + * The precise demarcation should be the gradual underflow threshold. + */ + if (s < -MAXLOGL+2.0L) { + x = 1.0L/x; + sign = -sign; + } + + /* First bit of the power */ + if (n & 1) + y = x; + else { + y = 1.0L; + asign = 0; + } + + ww = x; + n >>= 1; + while (n) { + ww = ww * ww; /* arg to the 2-to-the-kth power */ + if (n & 1) /* if that bit is set, then include in product */ + y *= ww; + n >>= 1; + } + + if (asign) + y = -y; /* odd power of negative number */ + if (sign < 0) + y = 1.0L/y; + return y; +} + +#endif diff --git a/src/math/remainder.c b/src/math/remainder.c new file mode 100644 index 00000000..db176c88 --- /dev/null +++ b/src/math/remainder.c @@ -0,0 +1,70 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_remainder.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* remainder(x,p) + * Return : + * returns x REM p = x - [x/p]*p as if in infinite + * precise arithmetic, where [x/p] is the (infinite bit) + * integer nearest x/p (in half way case choose the even one). + * Method : + * Based on fmod() return x-[x/p]chopped*p exactlp. + */ + +#include "libm.h" + +static const double zero = 0.0; + +double remainder(double x, double p) +{ + int32_t hx,hp; + uint32_t sx,lx,lp; + double p_half; + + EXTRACT_WORDS(hx, lx, x); + EXTRACT_WORDS(hp, lp, p); + sx = hx & 0x80000000; + hp &= 0x7fffffff; + hx &= 0x7fffffff; + + /* purge off exception values */ + if ((hp|lp) == 0) /* p = 0 */ + return (x*p)/(x*p); + if (hx >= 0x7ff00000 || /* x not finite */ + (hp >= 0x7ff00000 && (hp-0x7ff00000 | lp) != 0)) /* p is NaN */ + // FIXME: why long double? + return ((long double)x*p)/((long double)x*p); + + if (hp <= 0x7fdfffff) + x = fmod(x, p+p); /* now x < 2p */ + if (((hx-hp)|(lx-lp)) == 0) + return zero*x; + x = fabs(x); + p = fabs(p); + if (hp < 0x00200000) { + if (x + x > p) { + x -= p; + if (x + x >= p) + x -= p; + } + } else { + p_half = 0.5*p; + if (x > p_half) { + x -= p; + if (x >= p_half) + x -= p; + } + } + GET_HIGH_WORD(hx, x); + if ((hx&0x7fffffff) == 0) + hx = 0; + SET_HIGH_WORD(x, hx^sx); + return x; +} diff --git a/src/math/remainderf.c b/src/math/remainderf.c new file mode 100644 index 00000000..c17bb4f4 --- /dev/null +++ b/src/math/remainderf.c @@ -0,0 +1,64 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_remainderf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float zero = 0.0; + +float remainderf(float x, float p) +{ + int32_t hx,hp; + uint32_t sx; + float p_half; + + GET_FLOAT_WORD(hx, x); + GET_FLOAT_WORD(hp, p); + sx = hx & 0x80000000; + hp &= 0x7fffffff; + hx &= 0x7fffffff; + + /* purge off exception values */ + if (hp == 0) /* p = 0 */ + return (x*p)/(x*p); + if (hx >= 0x7f800000 || hp > 0x7f800000) /* x not finite, p is NaN */ + // FIXME: why long double? + return ((long double)x*p)/((long double)x*p); + + if (hp <= 0x7effffff) + x = fmodf(x, p + p); /* now x < 2p */ + if (hx - hp == 0) + return zero*x; + x = fabsf(x); + p = fabsf(p); + if (hp < 0x01000000) { + if (x + x > p) { + x -= p; + if (x + x >= p) + x -= p; + } + } else { + p_half = (float)0.5*p; + if (x > p_half) { + x -= p; + if (x >= p_half) + x -= p; + } + } + GET_FLOAT_WORD(hx, x); + if ((hx & 0x7fffffff) == 0) + hx = 0; + SET_FLOAT_WORD(x, hx ^ sx); + return x; +} diff --git a/src/math/remainderl.c b/src/math/remainderl.c new file mode 100644 index 00000000..b99f9381 --- /dev/null +++ b/src/math/remainderl.c @@ -0,0 +1,14 @@ +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double remainderl(long double x, long double y) +{ + return remainder(x, y); +} +#else +long double remainderl(long double x, long double y) +{ + int q; + return remquol(x, y, &q); +} +#endif diff --git a/src/math/remquo.c b/src/math/remquo.c new file mode 100644 index 00000000..79c9a55e --- /dev/null +++ b/src/math/remquo.c @@ -0,0 +1,171 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_remquo.c */ +/*- + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * Return the IEEE remainder and set *quo to the last n bits of the + * quotient, rounded to the nearest integer. We choose n=31 because + * we wind up computing all the integer bits of the quotient anyway as + * a side-effect of computing the remainder by the shift and subtract + * method. In practice, this is far more bits than are needed to use + * remquo in reduction algorithms. + */ + +#include "libm.h" + +static const double Zero[] = {0.0, -0.0,}; + +double remquo(double x, double y, int *quo) +{ + int32_t n,hx,hy,hz,ix,iy,sx,i; + uint32_t lx,ly,lz,q,sxy; + + EXTRACT_WORDS(hx, lx, x); + EXTRACT_WORDS(hy, ly, y); + sxy = (hx ^ hy) & 0x80000000; + sx = hx & 0x80000000; /* sign of x */ + hx ^= sx; /* |x| */ + hy &= 0x7fffffff; /* |y| */ + + /* purge off exception values */ + // FIXME: signed shift + if ((hy|ly) == 0 || hx >= 0x7ff00000 || /* y = 0, or x not finite */ + (hy|((ly|-ly)>>31)) > 0x7ff00000) /* or y is NaN */ + return (x*y)/(x*y); + if (hx <= hy) { + if (hx < hy || lx < ly) { /* |x| < |y| return x or x-y */ + q = 0; + goto fixup; + } + if (lx == ly) { /* |x| = |y| return x*0 */ + *quo = 1; + return Zero[(uint32_t)sx>>31]; + } + } + + // FIXME: use ilogb? + + /* determine ix = ilogb(x) */ + if (hx < 0x00100000) { /* subnormal x */ + if (hx == 0) { + for (ix = -1043, i=lx; i>0; i<<=1) ix--; + } else { + for (ix = -1022, i=hx<<11; i>0; i<<=1) ix--; + } + } else + ix = (hx>>20) - 1023; + + /* determine iy = ilogb(y) */ + if (hy < 0x00100000) { /* subnormal y */ + if (hy == 0) { + for (iy = -1043, i=ly; i>0; i<<=1) iy--; + } else { + for (iy = -1022, i=hy<<11; i>0; i<<=1) iy--; + } + } else + iy = (hy>>20) - 1023; + + /* set up {hx,lx}, {hy,ly} and align y to x */ + if (ix >= -1022) + hx = 0x00100000|(0x000fffff&hx); + else { /* subnormal x, shift x to normal */ + n = -1022 - ix; + if (n <= 31) { + hx = (hx<<n)|(lx>>(32-n)); + lx <<= n; + } else { + hx = lx<<(n-32); + lx = 0; + } + } + if (iy >= -1022) + hy = 0x00100000|(0x000fffff&hy); + else { /* subnormal y, shift y to normal */ + n = -1022 - iy; + if (n <= 31) { + hy = (hy<<n)|(ly>>(32-n)); + ly <<= n; + } else { + hy = ly<<(n-32); + ly = 0; + } + } + + /* fix point fmod */ + n = ix - iy; + q = 0; + while (n--) { + hz = hx - hy; + lz = lx - ly; + if (lx < ly) + hz--; + if (hz < 0) { + hx = hx + hx + (lx>>31); + lx = lx + lx; + } else { + hx = hz + hz + (lz>>31); + lx = lz + lz; + q++; + } + q <<= 1; + } + hz = hx - hy; + lz = lx - ly; + if (lx < ly) + hz--; + if (hz >= 0) { + hx = hz; + lx = lz; + q++; + } + + /* convert back to floating value and restore the sign */ + if ((hx|lx) == 0) { /* return sign(x)*0 */ + *quo = sxy ? -q : q; + return Zero[(uint32_t)sx>>31]; + } + while (hx < 0x00100000) { /* normalize x */ + hx = hx + hx + (lx>>31); + lx = lx + lx; + iy--; + } + if (iy >= -1022) { /* normalize output */ + hx = (hx-0x00100000)|((iy+1023)<<20); + } else { /* subnormal output */ + n = -1022 - iy; + if (n <= 20) { + lx = (lx>>n)|((uint32_t)hx<<(32-n)); + hx >>= n; + } else if (n <= 31) { + lx = (hx<<(32-n))|(lx>>n); + hx = sx; + } else { + lx = hx>>(n-32); + hx = sx; + } + } +fixup: + INSERT_WORDS(x, hx, lx); + y = fabs(y); + if (y < 0x1p-1021) { + if (x + x > y || (x + x == y && (q & 1))) { + q++; + x -= y; + } + } else if (x > 0.5*y || (x == 0.5*y && (q & 1))) { + q++; + x -= y; + } + GET_HIGH_WORD(hx, x); + SET_HIGH_WORD(x, hx ^ sx); + q &= 0x7fffffff; + *quo = sxy ? -q : q; + return x; +} diff --git a/src/math/remquof.c b/src/math/remquof.c new file mode 100644 index 00000000..11569ce8 --- /dev/null +++ b/src/math/remquof.c @@ -0,0 +1,125 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_remquof.c */ +/*- + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * Return the IEEE remainder and set *quo to the last n bits of the + * quotient, rounded to the nearest integer. We choose n=31 because + * we wind up computing all the integer bits of the quotient anyway as + * a side-effect of computing the remainder by the shift and subtract + * method. In practice, this is far more bits than are needed to use + * remquo in reduction algorithms. + */ + +#include "libm.h" + +static const float Zero[] = {0.0, -0.0,}; + +float remquof(float x, float y, int *quo) +{ + int32_t n,hx,hy,hz,ix,iy,sx,i; + uint32_t q,sxy; + + GET_FLOAT_WORD(hx, x); + GET_FLOAT_WORD(hy, y); + sxy = (hx ^ hy) & 0x80000000; + sx = hx & 0x80000000; /* sign of x */ + hx ^= sx; /* |x| */ + hy &= 0x7fffffff; /* |y| */ + + /* purge off exception values */ + if (hy == 0 || hx >= 0x7f800000 || hy > 0x7f800000) /* y=0,NaN;or x not finite */ + return (x*y)/(x*y); + if (hx < hy) { /* |x| < |y| return x or x-y */ + q = 0; + goto fixup; + } else if(hx==hy) { /* |x| = |y| return x*0*/ + *quo = 1; + return Zero[(uint32_t)sx>>31]; + } + + /* determine ix = ilogb(x) */ + if (hx < 0x00800000) { /* subnormal x */ + for (ix = -126, i=hx<<8; i>0; i<<=1) ix--; + } else + ix = (hx>>23) - 127; + + /* determine iy = ilogb(y) */ + if (hy < 0x00800000) { /* subnormal y */ + for (iy = -126, i=hy<<8; i>0; i<<=1) iy--; + } else + iy = (hy>>23) - 127; + + /* set up {hx,lx}, {hy,ly} and align y to x */ + if (ix >= -126) + hx = 0x00800000|(0x007fffff&hx); + else { /* subnormal x, shift x to normal */ + n = -126 - ix; + hx <<= n; + } + if (iy >= -126) + hy = 0x00800000|(0x007fffff&hy); + else { /* subnormal y, shift y to normal */ + n = -126 - iy; + hy <<= n; + } + + /* fix point fmod */ + n = ix - iy; + q = 0; + while (n--) { + hz = hx - hy; + if (hz < 0) + hx = hx << 1; + else { + hx = hz << 1; + q++; + } + q <<= 1; + } + hz = hx - hy; + if (hz >= 0) { + hx = hz; + q++; + } + + /* convert back to floating value and restore the sign */ + if (hx == 0) { /* return sign(x)*0 */ + *quo = sxy ? -q : q; + return Zero[(uint32_t)sx>>31]; + } + while (hx < 0x00800000) { /* normalize x */ + hx <<= 1; + iy--; + } + if (iy >= -126) { /* normalize output */ + hx = (hx-0x00800000)|((iy+127)<<23); + } else { /* subnormal output */ + n = -126 - iy; + hx >>= n; + } +fixup: + SET_FLOAT_WORD(x,hx); + y = fabsf(y); + if (y < 0x1p-125f) { + if (x + x > y || (x + x == y && (q & 1))) { + q++; + x -= y; + } + } else if (x > 0.5f*y || (x == 0.5f*y && (q & 1))) { + q++; + x -= y; + } + GET_FLOAT_WORD(hx, x); + SET_FLOAT_WORD(x, hx ^ sx); + q &= 0x7fffffff; + *quo = sxy ? -q : q; + return x; +} diff --git a/src/math/remquol.c b/src/math/remquol.c new file mode 100644 index 00000000..dd18f35c --- /dev/null +++ b/src/math/remquol.c @@ -0,0 +1,193 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_remquol.c */ +/*- + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double remquol(long double x, long double y, int *quo) +{ + return remquo(x, y, quo); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 + +#define BIAS (LDBL_MAX_EXP - 1) + +#if LDBL_MANL_SIZE > 32 +typedef uint64_t manl_t; +#else +typedef uint32_t manl_t; +#endif + +#if LDBL_MANH_SIZE > 32 +typedef uint64_t manh_t; +#else +typedef uint32_t manh_t; +#endif + +/* + * These macros add and remove an explicit integer bit in front of the + * fractional mantissa, if the architecture doesn't have such a bit by + * default already. + */ +#ifdef LDBL_IMPLICIT_NBIT +#define SET_NBIT(hx) ((hx) | (1ULL << LDBL_MANH_SIZE)) +#define HFRAC_BITS LDBL_MANH_SIZE +#else +#define SET_NBIT(hx) (hx) +#define HFRAC_BITS (LDBL_MANH_SIZE - 1) +#endif + +#define MANL_SHIFT (LDBL_MANL_SIZE - 1) + +static const long double Zero[] = {0.0L, -0.0L}; + +/* + * Return the IEEE remainder and set *quo to the last n bits of the + * quotient, rounded to the nearest integer. We choose n=31 because + * we wind up computing all the integer bits of the quotient anyway as + * a side-effect of computing the remainder by the shift and subtract + * method. In practice, this is far more bits than are needed to use + * remquo in reduction algorithms. + * + * Assumptions: + * - The low part of the mantissa fits in a manl_t exactly. + * - The high part of the mantissa fits in an int64_t with enough room + * for an explicit integer bit in front of the fractional bits. + */ +long double remquol(long double x, long double y, int *quo) +{ + union IEEEl2bits ux, uy; + int64_t hx,hz; /* We need a carry bit even if LDBL_MANH_SIZE is 32. */ + manh_t hy; + manl_t lx,ly,lz; + int ix,iy,n,q,sx,sxy; + + ux.e = x; + uy.e = y; + sx = ux.bits.sign; + sxy = sx ^ uy.bits.sign; + ux.bits.sign = 0; /* |x| */ + uy.bits.sign = 0; /* |y| */ + x = ux.e; + + /* purge off exception values */ + if ((uy.bits.exp|uy.bits.manh|uy.bits.manl)==0 || /* y=0 */ + (ux.bits.exp == BIAS + LDBL_MAX_EXP) || /* or x not finite */ + (uy.bits.exp == BIAS + LDBL_MAX_EXP && + ((uy.bits.manh&~LDBL_NBIT)|uy.bits.manl)!=0)) /* or y is NaN */ + return (x*y)/(x*y); + if (ux.bits.exp <= uy.bits.exp) { + if ((ux.bits.exp < uy.bits.exp) || + (ux.bits.manh <= uy.bits.manh && + (ux.bits.manh < uy.bits.manh || + ux.bits.manl < uy.bits.manl))) { + q = 0; + goto fixup; /* |x|<|y| return x or x-y */ + } + if (ux.bits.manh == uy.bits.manh && ux.bits.manl == uy.bits.manl) { + *quo = 1; + return Zero[sx]; /* |x|=|y| return x*0*/ + } + } + + /* determine ix = ilogb(x) */ + if (ux.bits.exp == 0) { /* subnormal x */ + ux.e *= 0x1.0p512; + ix = ux.bits.exp - (BIAS + 512); + } else { + ix = ux.bits.exp - BIAS; + } + + /* determine iy = ilogb(y) */ + if (uy.bits.exp == 0) { /* subnormal y */ + uy.e *= 0x1.0p512; + iy = uy.bits.exp - (BIAS + 512); + } else { + iy = uy.bits.exp - BIAS; + } + + /* set up {hx,lx}, {hy,ly} and align y to x */ + hx = SET_NBIT(ux.bits.manh); + hy = SET_NBIT(uy.bits.manh); + lx = ux.bits.manl; + ly = uy.bits.manl; + + /* fix point fmod */ + n = ix - iy; + q = 0; + + while (n--) { + hz = hx - hy; + lz = lx - ly; + if (lx < ly) + hz -= 1; + if (hz < 0) { + hx = hx + hx + (lx>>MANL_SHIFT); + lx = lx + lx; + } else { + hx = hz + hz + (lz>>MANL_SHIFT); + lx = lz + lz; + q++; + } + q <<= 1; + } + hz = hx - hy; + lz = lx - ly; + if (lx < ly) + hz -= 1; + if (hz >= 0) { + hx = hz; + lx = lz; + q++; + } + + /* convert back to floating value and restore the sign */ + if ((hx|lx) == 0) { /* return sign(x)*0 */ + *quo = sxy ? -q : q; + return Zero[sx]; + } + while (hx < (1ULL<<HFRAC_BITS)) { /* normalize x */ + hx = hx + hx + (lx>>MANL_SHIFT); + lx = lx + lx; + iy -= 1; + } + ux.bits.manh = hx; /* The integer bit is truncated here if needed. */ + ux.bits.manl = lx; + if (iy < LDBL_MIN_EXP) { + ux.bits.exp = iy + (BIAS + 512); + ux.e *= 0x1p-512; + } else { + ux.bits.exp = iy + BIAS; + } + ux.bits.sign = 0; + x = ux.e; +fixup: + y = fabsl(y); + if (y < LDBL_MIN * 2) { + if (x + x > y || (x + x == y && (q & 1))) { + q++; + x-=y; + } + } else if (x > 0.5*y || (x == 0.5*y && (q & 1))) { + q++; + x-=y; + } + + ux.e = x; + ux.bits.sign ^= sx; + x = ux.e; + + q &= 0x7fffffff; + *quo = sxy ? -q : q; + return x; +} +#endif diff --git a/src/math/rint.c b/src/math/rint.c new file mode 100644 index 00000000..775c7b8d --- /dev/null +++ b/src/math/rint.c @@ -0,0 +1,90 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_rint.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * rint(x) + * Return x rounded to integral value according to the prevailing + * rounding mode. + * Method: + * Using floating addition. + * Exception: + * Inexact flag raised if x not equal to rint(x). + */ + +#include "libm.h" + +static const double +TWO52[2] = { + 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ + -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */ +}; + +double rint(double x) +{ + int32_t i0,j0,sx; + uint32_t i,i1; + double w,t; + + EXTRACT_WORDS(i0, i1, x); + // FIXME: signed shift + sx = (i0>>31) & 1; + j0 = ((i0>>20)&0x7ff) - 0x3ff; + if (j0 < 20) { + if (j0 < 0) { + if (((i0&0x7fffffff)|i1) == 0) + return x; + i1 |= i0 & 0x0fffff; + i0 &= 0xfffe0000; + i0 |= ((i1|-i1)>>12) & 0x80000; + SET_HIGH_WORD(x, i0); + STRICT_ASSIGN(double, w, TWO52[sx] + x); + t = w - TWO52[sx]; + GET_HIGH_WORD(i0, t); + SET_HIGH_WORD(t, (i0&0x7fffffff)|(sx<<31)); + return t; + } else { + i = 0x000fffff>>j0; + if (((i0&i)|i1) == 0) + return x; /* x is integral */ + i >>= 1; + if (((i0&i)|i1) != 0) { + /* + * Some bit is set after the 0.5 bit. To avoid the + * possibility of errors from double rounding in + * w = TWO52[sx]+x, adjust the 0.25 bit to a lower + * guard bit. We do this for all j0<=51. The + * adjustment is trickiest for j0==18 and j0==19 + * since then it spans the word boundary. + */ + if (j0 == 19) + i1 = 0x40000000; + else if (j0 == 18) + i1 = 0x80000000; + else + i0 = (i0 & ~i)|(0x20000>>j0); + } + } + } else if (j0 > 51) { + if (j0 == 0x400) + return x+x; /* inf or NaN */ + return x; /* x is integral */ + } else { + i = (uint32_t)0xffffffff>>(j0-20); + if ((i1&i) == 0) + return x; /* x is integral */ + i >>= 1; + if ((i1&i) != 0) + i1 = (i1 & ~i)|(0x40000000>>(j0-20)); + } + INSERT_WORDS(x, i0, i1); + STRICT_ASSIGN(double, w, TWO52[sx] + x); + return w - TWO52[sx]; +} diff --git a/src/math/rintf.c b/src/math/rintf.c new file mode 100644 index 00000000..e8d44969 --- /dev/null +++ b/src/math/rintf.c @@ -0,0 +1,48 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_rintf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +TWO23[2] = { + 8.3886080000e+06, /* 0x4b000000 */ + -8.3886080000e+06, /* 0xcb000000 */ +}; + +float rintf(float x) +{ + int32_t i0,j0,sx; + float w,t; + + GET_FLOAT_WORD(i0, x); + sx = (i0>>31) & 1; + j0 = ((i0>>23)&0xff) - 0x7f; + if (j0 < 23) { + if (j0 < 0) { + if ((i0&0x7fffffff) == 0) + return x; + STRICT_ASSIGN(float, w, TWO23[sx] + x); + t = w - TWO23[sx]; + GET_FLOAT_WORD(i0, t); + SET_FLOAT_WORD(t, (i0&0x7fffffff)|(sx<<31)); + return t; + } + STRICT_ASSIGN(float, w, TWO23[sx] + x); + return w - TWO23[sx]; + } + if (j0 == 0x80) + return x+x; /* inf or NaN */ + return x; /* x is integral */ +} diff --git a/src/math/rintl.c b/src/math/rintl.c new file mode 100644 index 00000000..1cc35df5 --- /dev/null +++ b/src/math/rintl.c @@ -0,0 +1,87 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_rintl.c */ +/*- + * Copyright (c) 2008 David Schultz <das@FreeBSD.ORG> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double rintl(long double x) +{ + return rint(x); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 + +#define BIAS (LDBL_MAX_EXP - 1) + +static const float +shift[2] = { +#if LDBL_MANT_DIG == 64 + 0x1.0p63, -0x1.0p63 +#elif LDBL_MANT_DIG == 113 + 0x1.0p112, -0x1.0p112 +#else +#error "Unsupported long double format" +#endif +}; +static const float zero[2] = { 0.0, -0.0 }; + +long double rintl(long double x) +{ + union IEEEl2bits u; + uint32_t expsign; + int ex, sign; + + u.e = x; + expsign = u.xbits.expsign; + ex = expsign & 0x7fff; + + if (ex >= BIAS + LDBL_MANT_DIG - 1) { + if (ex == BIAS + LDBL_MAX_EXP) + return x + x; /* Inf, NaN, or unsupported format */ + return x; /* finite and already an integer */ + } + sign = expsign >> 15; + + /* + * The following code assumes that intermediate results are + * evaluated in long double precision. If they are evaluated in + * greater precision, double rounding may occur, and if they are + * evaluated in less precision (as on i386), results will be + * wildly incorrect. + */ + x += shift[sign]; + x -= shift[sign]; + + /* + * If the result is +-0, then it must have the same sign as x, but + * the above calculation doesn't always give this. Fix up the sign. + */ + if (ex < BIAS && x == 0.0L) + return zero[sign]; + + return x; +} +#endif diff --git a/src/math/s_round.c b/src/math/round.c index d5bea7a9..21373847 100644 --- a/src/math/s_round.c +++ b/src/math/round.c @@ -1,3 +1,4 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_round.c */ /*- * Copyright (c) 2003, Steven G. Kargl * All rights reserved. @@ -24,25 +25,24 @@ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -#include <math.h> +#include "libm.h" -double -round(double x) +double round(double x) { double t; if (!isfinite(x)) - return (x); + return x; if (x >= 0.0) { - t = ceil(x); - if (t - x > 0.5) - t -= 1.0; - return (t); + t = floor(x); + if (t - x <= -0.5) + t += 1.0; + return t; } else { - t = ceil(-x); - if (t + x > 0.5) - t -= 1.0; - return (-t); + t = floor(-x); + if (t + x <= -0.5) + t += 1.0; + return -t; } } diff --git a/src/math/s_roundf.c b/src/math/roundf.c index c4fc3e19..3cfd8ae5 100644 --- a/src/math/s_roundf.c +++ b/src/math/roundf.c @@ -1,3 +1,4 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_roundf.c */ /*- * Copyright (c) 2003, Steven G. Kargl * All rights reserved. @@ -24,25 +25,24 @@ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ -#include <math.h> +#include "libm.h" -float -roundf(float x) +float roundf(float x) { float t; if (!isfinite(x)) - return (x); + return x; if (x >= 0.0) { - t = ceilf(x); - if (t - x > 0.5) - t -= 1.0; - return (t); + t = floorf(x); + if (t - x <= -0.5) + t += 1.0; + return t; } else { - t = ceilf(-x); - if (t + x > 0.5) - t -= 1.0; - return (-t); + t = floorf(-x); + if (t + x <= -0.5) + t += 1.0; + return -t; } } diff --git a/src/math/roundl.c b/src/math/roundl.c new file mode 100644 index 00000000..ce56e8a9 --- /dev/null +++ b/src/math/roundl.c @@ -0,0 +1,54 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_roundl.c */ +/*- + * Copyright (c) 2003, Steven G. Kargl + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice unmodified, this list of conditions, and the following + * disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include "libm.h" +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double roundl(long double x) +{ + return round(x); +} +#else +long double roundl(long double x) +{ + long double t; + + if (!isfinite(x)) + return x; + + if (x >= 0.0) { + t = floorl(x); + if (t - x <= -0.5) + t += 1.0; + return t; + } else { + t = floorl(-x); + if (t + x <= -0.5) + t += 1.0; + return -t; + } +} +#endif diff --git a/src/math/s_asinh.c b/src/math/s_asinh.c deleted file mode 100644 index 26016091..00000000 --- a/src/math/s_asinh.c +++ /dev/null @@ -1,53 +0,0 @@ -/* @(#)s_asinh.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* asinh(x) - * Method : - * Based on - * asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ] - * we have - * asinh(x) := x if 1+x*x=1, - * := sign(x)*(log(x)+ln2)) for large |x|, else - * := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else - * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2))) - */ - -#include <math.h> -#include "math_private.h" - -static const double -one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ -ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ -huge= 1.00000000000000000000e+300; - -double -asinh(double x) -{ - double t,w; - int32_t hx,ix; - GET_HIGH_WORD(hx,x); - ix = hx&0x7fffffff; - if(ix>=0x7ff00000) return x+x; /* x is inf or NaN */ - if(ix< 0x3e300000) { /* |x|<2**-28 */ - if(huge+x>one) return x; /* return x inexact except 0 */ - } - if(ix>0x41b00000) { /* |x| > 2**28 */ - w = log(fabs(x))+ln2; - } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */ - t = fabs(x); - w = log(2.0*t+one/(sqrt(x*x+one)+t)); - } else { /* 2.0 > |x| > 2**-28 */ - t = x*x; - w =log1p(fabs(x)+t/(one+sqrt(one+t))); - } - if(hx>0) return w; else return -w; -} diff --git a/src/math/s_asinhf.c b/src/math/s_asinhf.c deleted file mode 100644 index 04f8d072..00000000 --- a/src/math/s_asinhf.c +++ /dev/null @@ -1,45 +0,0 @@ -/* s_asinhf.c -- float version of s_asinh.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -one = 1.0000000000e+00, /* 0x3F800000 */ -ln2 = 6.9314718246e-01, /* 0x3f317218 */ -huge= 1.0000000000e+30; - -float -asinhf(float x) -{ - float t,w; - int32_t hx,ix; - GET_FLOAT_WORD(hx,x); - ix = hx&0x7fffffff; - if(ix>=0x7f800000) return x+x; /* x is inf or NaN */ - if(ix< 0x31800000) { /* |x|<2**-28 */ - if(huge+x>one) return x; /* return x inexact except 0 */ - } - if(ix>0x4d800000) { /* |x| > 2**28 */ - w = logf(fabsf(x))+ln2; - } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */ - t = fabsf(x); - w = logf((float)2.0*t+one/(sqrtf(x*x+one)+t)); - } else { /* 2.0 > |x| > 2**-28 */ - t = x*x; - w =log1pf(fabsf(x)+t/(one+sqrtf(one+t))); - } - if(hx>0) return w; else return -w; -} diff --git a/src/math/s_atanf.c b/src/math/s_atanf.c deleted file mode 100644 index 03067e18..00000000 --- a/src/math/s_atanf.c +++ /dev/null @@ -1,95 +0,0 @@ -/* s_atanf.c -- float version of s_atan.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float atanhi[] = { - 4.6364760399e-01, /* atan(0.5)hi 0x3eed6338 */ - 7.8539812565e-01, /* atan(1.0)hi 0x3f490fda */ - 9.8279368877e-01, /* atan(1.5)hi 0x3f7b985e */ - 1.5707962513e+00, /* atan(inf)hi 0x3fc90fda */ -}; - -static const float atanlo[] = { - 5.0121582440e-09, /* atan(0.5)lo 0x31ac3769 */ - 3.7748947079e-08, /* atan(1.0)lo 0x33222168 */ - 3.4473217170e-08, /* atan(1.5)lo 0x33140fb4 */ - 7.5497894159e-08, /* atan(inf)lo 0x33a22168 */ -}; - -static const float aT[] = { - 3.3333334327e-01, /* 0x3eaaaaaa */ - -2.0000000298e-01, /* 0xbe4ccccd */ - 1.4285714924e-01, /* 0x3e124925 */ - -1.1111110449e-01, /* 0xbde38e38 */ - 9.0908870101e-02, /* 0x3dba2e6e */ - -7.6918758452e-02, /* 0xbd9d8795 */ - 6.6610731184e-02, /* 0x3d886b35 */ - -5.8335702866e-02, /* 0xbd6ef16b */ - 4.9768779427e-02, /* 0x3d4bda59 */ - -3.6531571299e-02, /* 0xbd15a221 */ - 1.6285819933e-02, /* 0x3c8569d7 */ -}; - - static const float -one = 1.0, -huge = 1.0e30; - -float -atanf(float x) -{ - float w,s1,s2,z; - int32_t ix,hx,id; - - GET_FLOAT_WORD(hx,x); - ix = hx&0x7fffffff; - if(ix>=0x50800000) { /* if |x| >= 2^34 */ - if(ix>0x7f800000) - return x+x; /* NaN */ - if(hx>0) return atanhi[3]+atanlo[3]; - else return -atanhi[3]-atanlo[3]; - } if (ix < 0x3ee00000) { /* |x| < 0.4375 */ - if (ix < 0x31000000) { /* |x| < 2^-29 */ - if(huge+x>one) return x; /* raise inexact */ - } - id = -1; - } else { - x = fabsf(x); - if (ix < 0x3f980000) { /* |x| < 1.1875 */ - if (ix < 0x3f300000) { /* 7/16 <=|x|<11/16 */ - id = 0; x = ((float)2.0*x-one)/((float)2.0+x); - } else { /* 11/16<=|x|< 19/16 */ - id = 1; x = (x-one)/(x+one); - } - } else { - if (ix < 0x401c0000) { /* |x| < 2.4375 */ - id = 2; x = (x-(float)1.5)/(one+(float)1.5*x); - } else { /* 2.4375 <= |x| < 2^66 */ - id = 3; x = -(float)1.0/x; - } - }} - /* end of argument reduction */ - z = x*x; - w = z*z; - /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */ - s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10]))))); - s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9])))); - if (id<0) return x - x*(s1+s2); - else { - z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x); - return (hx<0)? -z:z; - } -} diff --git a/src/math/s_cbrt.c b/src/math/s_cbrt.c deleted file mode 100644 index 8adcb191..00000000 --- a/src/math/s_cbrt.c +++ /dev/null @@ -1,77 +0,0 @@ -/* @(#)s_cbrt.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -/* cbrt(x) - * Return cube root of x - */ -static const uint32_t - B1 = 715094163, /* B1 = (682-0.03306235651)*2**20 */ - B2 = 696219795; /* B2 = (664-0.03306235651)*2**20 */ - -static const double -C = 5.42857142857142815906e-01, /* 19/35 = 0x3FE15F15, 0xF15F15F1 */ -D = -7.05306122448979611050e-01, /* -864/1225 = 0xBFE691DE, 0x2532C834 */ -E = 1.41428571428571436819e+00, /* 99/70 = 0x3FF6A0EA, 0x0EA0EA0F */ -F = 1.60714285714285720630e+00, /* 45/28 = 0x3FF9B6DB, 0x6DB6DB6E */ -G = 3.57142857142857150787e-01; /* 5/14 = 0x3FD6DB6D, 0xB6DB6DB7 */ - -double -cbrt(double x) -{ - int32_t hx; - double r,s,t=0.0,w; - uint32_t sign; - uint32_t high,low; - - GET_HIGH_WORD(hx,x); - sign=hx&0x80000000; /* sign= sign(x) */ - hx ^=sign; - if(hx>=0x7ff00000) return(x+x); /* cbrt(NaN,INF) is itself */ - GET_LOW_WORD(low,x); - if((hx|low)==0) - return(x); /* cbrt(0) is itself */ - - SET_HIGH_WORD(x,hx); /* x <- |x| */ - /* rough cbrt to 5 bits */ - if(hx<0x00100000) /* subnormal number */ - {SET_HIGH_WORD(t,0x43500000); /* set t= 2**54 */ - t*=x; GET_HIGH_WORD(high,t); SET_HIGH_WORD(t,high/3+B2); - } - else - SET_HIGH_WORD(t,hx/3+B1); - - - /* new cbrt to 23 bits, may be implemented in single precision */ - r=t*t/x; - s=C+r*t; - t*=G+F/(s+E+D/s); - - /* chopped to 20 bits and make it larger than cbrt(x) */ - GET_HIGH_WORD(high,t); - INSERT_WORDS(t,high+0x00000001,0); - - - /* one step newton iteration to 53 bits with error less than 0.667 ulps */ - s=t*t; /* t*t is exact */ - r=x/s; - w=t+t; - r=(r-t)/(w+r); /* r-s is exact */ - t=t+t*r; - - /* retore the sign bit */ - GET_HIGH_WORD(high,t); - SET_HIGH_WORD(t,high|sign); - return(t); -} diff --git a/src/math/s_cbrtf.c b/src/math/s_cbrtf.c deleted file mode 100644 index e7b46de7..00000000 --- a/src/math/s_cbrtf.c +++ /dev/null @@ -1,67 +0,0 @@ -/* s_cbrtf.c -- float version of s_cbrt.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -/* cbrtf(x) - * Return cube root of x - */ -static const unsigned - B1 = 709958130, /* B1 = (84+2/3-0.03306235651)*2**23 */ - B2 = 642849266; /* B2 = (76+2/3-0.03306235651)*2**23 */ - -static const float -C = 5.4285717010e-01, /* 19/35 = 0x3f0af8b0 */ -D = -7.0530611277e-01, /* -864/1225 = 0xbf348ef1 */ -E = 1.4142856598e+00, /* 99/70 = 0x3fb50750 */ -F = 1.6071428061e+00, /* 45/28 = 0x3fcdb6db */ -G = 3.5714286566e-01; /* 5/14 = 0x3eb6db6e */ - -float -cbrtf(float x) -{ - float r,s,t; - int32_t hx; - uint32_t sign; - uint32_t high; - - GET_FLOAT_WORD(hx,x); - sign=hx&0x80000000; /* sign= sign(x) */ - hx ^=sign; - if(hx>=0x7f800000) return(x+x); /* cbrt(NaN,INF) is itself */ - if(hx==0) - return(x); /* cbrt(0) is itself */ - - SET_FLOAT_WORD(x,hx); /* x <- |x| */ - /* rough cbrt to 5 bits */ - if(hx<0x00800000) /* subnormal number */ - {SET_FLOAT_WORD(t,0x4b800000); /* set t= 2**24 */ - t*=x; GET_FLOAT_WORD(high,t); SET_FLOAT_WORD(t,high/3+B2); - } - else - SET_FLOAT_WORD(t,hx/3+B1); - - - /* new cbrt to 23 bits */ - r=t*t/x; - s=C+r*t; - t*=G+F/(s+E+D/s); - - /* retore the sign bit */ - GET_FLOAT_WORD(high,t); - SET_FLOAT_WORD(t,high|sign); - return(t); -} diff --git a/src/math/s_ceil.c b/src/math/s_ceil.c deleted file mode 100644 index 1670cade..00000000 --- a/src/math/s_ceil.c +++ /dev/null @@ -1,68 +0,0 @@ -/* @(#)s_ceil.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * ceil(x) - * Return x rounded toward -inf to integral value - * Method: - * Bit twiddling. - * Exception: - * Inexact flag raised if x not equal to ceil(x). - */ - -#include <math.h> -#include "math_private.h" - -static const double huge = 1.0e300; - -double -ceil(double x) -{ - int32_t i0,i1,j0; - uint32_t i,j; - EXTRACT_WORDS(i0,i1,x); - j0 = ((i0>>20)&0x7ff)-0x3ff; - if(j0<20) { - if(j0<0) { /* raise inexact if x != 0 */ - if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ - if(i0<0) {i0=0x80000000;i1=0;} - else if((i0|i1)!=0) { i0=0x3ff00000;i1=0;} - } - } else { - i = (0x000fffff)>>j0; - if(((i0&i)|i1)==0) return x; /* x is integral */ - if(huge+x>0.0) { /* raise inexact flag */ - if(i0>0) i0 += (0x00100000)>>j0; - i0 &= (~i); i1=0; - } - } - } else if (j0>51) { - if(j0==0x400) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } else { - i = ((uint32_t)(0xffffffff))>>(j0-20); - if((i1&i)==0) return x; /* x is integral */ - if(huge+x>0.0) { /* raise inexact flag */ - if(i0>0) { - if(j0==20) i0+=1; - else { - j = i1 + (1<<(52-j0)); - if(j<i1) i0+=1; /* got a carry */ - i1 = j; - } - } - i1 &= (~i); - } - } - INSERT_WORDS(x,i0,i1); - return x; -} diff --git a/src/math/s_ceilf.c b/src/math/s_ceilf.c deleted file mode 100644 index 3615041f..00000000 --- a/src/math/s_ceilf.c +++ /dev/null @@ -1,49 +0,0 @@ -/* s_ceilf.c -- float version of s_ceil.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float huge = 1.0e30; - -float -ceilf(float x) -{ - int32_t i0,j0; - uint32_t i; - - GET_FLOAT_WORD(i0,x); - j0 = ((i0>>23)&0xff)-0x7f; - if(j0<23) { - if(j0<0) { /* raise inexact if x != 0 */ - if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */ - if(i0<0) {i0=0x80000000;} - else if(i0!=0) { i0=0x3f800000;} - } - } else { - i = (0x007fffff)>>j0; - if((i0&i)==0) return x; /* x is integral */ - if(huge+x>(float)0.0) { /* raise inexact flag */ - if(i0>0) i0 += (0x00800000)>>j0; - i0 &= (~i); - } - } - } else { - if(j0==0x80) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } - SET_FLOAT_WORD(x,i0); - return x; -} diff --git a/src/math/s_copysign.c b/src/math/s_copysign.c deleted file mode 100644 index 59d3877c..00000000 --- a/src/math/s_copysign.c +++ /dev/null @@ -1,30 +0,0 @@ -/* @(#)s_copysign.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * copysign(double x, double y) - * copysign(x,y) returns a value with the magnitude of x and - * with the sign bit of y. - */ - -#include <math.h> -#include "math_private.h" - -double -copysign(double x, double y) -{ - uint32_t hx,hy; - GET_HIGH_WORD(hx,x); - GET_HIGH_WORD(hy,y); - SET_HIGH_WORD(x,(hx&0x7fffffff)|(hy&0x80000000)); - return x; -} diff --git a/src/math/s_cosf.c b/src/math/s_cosf.c deleted file mode 100644 index 14b8e98b..00000000 --- a/src/math/s_cosf.c +++ /dev/null @@ -1,47 +0,0 @@ -/* s_cosf.c -- float version of s_cos.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float one=1.0; - -float -cosf(float x) -{ - float y[2],z=0.0; - int32_t n,ix; - - GET_FLOAT_WORD(ix,x); - - /* |x| ~< pi/4 */ - ix &= 0x7fffffff; - if(ix <= 0x3f490fd8) return __kernel_cosf(x,z); - - /* cos(Inf or NaN) is NaN */ - else if (ix>=0x7f800000) return x-x; - - /* argument reduction needed */ - else { - n = __ieee754_rem_pio2f(x,y); - switch(n&3) { - case 0: return __kernel_cosf(y[0],y[1]); - case 1: return -__kernel_sinf(y[0],y[1],1); - case 2: return -__kernel_cosf(y[0],y[1]); - default: - return __kernel_sinf(y[0],y[1],1); - } - } -} diff --git a/src/math/s_erff.c b/src/math/s_erff.c deleted file mode 100644 index 28e2f7b3..00000000 --- a/src/math/s_erff.c +++ /dev/null @@ -1,207 +0,0 @@ -/* s_erff.c -- float version of s_erf.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -tiny = 1e-30, -half= 5.0000000000e-01, /* 0x3F000000 */ -one = 1.0000000000e+00, /* 0x3F800000 */ -two = 2.0000000000e+00, /* 0x40000000 */ - /* c = (subfloat)0.84506291151 */ -erx = 8.4506291151e-01, /* 0x3f58560b */ -/* - * Coefficients for approximation to erf on [0,0.84375] - */ -efx = 1.2837916613e-01, /* 0x3e0375d4 */ -efx8= 1.0270333290e+00, /* 0x3f8375d4 */ -pp0 = 1.2837916613e-01, /* 0x3e0375d4 */ -pp1 = -3.2504209876e-01, /* 0xbea66beb */ -pp2 = -2.8481749818e-02, /* 0xbce9528f */ -pp3 = -5.7702702470e-03, /* 0xbbbd1489 */ -pp4 = -2.3763017452e-05, /* 0xb7c756b1 */ -qq1 = 3.9791721106e-01, /* 0x3ecbbbce */ -qq2 = 6.5022252500e-02, /* 0x3d852a63 */ -qq3 = 5.0813062117e-03, /* 0x3ba68116 */ -qq4 = 1.3249473704e-04, /* 0x390aee49 */ -qq5 = -3.9602282413e-06, /* 0xb684e21a */ -/* - * Coefficients for approximation to erf in [0.84375,1.25] - */ -pa0 = -2.3621185683e-03, /* 0xbb1acdc6 */ -pa1 = 4.1485610604e-01, /* 0x3ed46805 */ -pa2 = -3.7220788002e-01, /* 0xbebe9208 */ -pa3 = 3.1834661961e-01, /* 0x3ea2fe54 */ -pa4 = -1.1089469492e-01, /* 0xbde31cc2 */ -pa5 = 3.5478305072e-02, /* 0x3d1151b3 */ -pa6 = -2.1663755178e-03, /* 0xbb0df9c0 */ -qa1 = 1.0642088205e-01, /* 0x3dd9f331 */ -qa2 = 5.4039794207e-01, /* 0x3f0a5785 */ -qa3 = 7.1828655899e-02, /* 0x3d931ae7 */ -qa4 = 1.2617121637e-01, /* 0x3e013307 */ -qa5 = 1.3637083583e-02, /* 0x3c5f6e13 */ -qa6 = 1.1984500103e-02, /* 0x3c445aa3 */ -/* - * Coefficients for approximation to erfc in [1.25,1/0.35] - */ -ra0 = -9.8649440333e-03, /* 0xbc21a093 */ -ra1 = -6.9385856390e-01, /* 0xbf31a0b7 */ -ra2 = -1.0558626175e+01, /* 0xc128f022 */ -ra3 = -6.2375331879e+01, /* 0xc2798057 */ -ra4 = -1.6239666748e+02, /* 0xc322658c */ -ra5 = -1.8460508728e+02, /* 0xc3389ae7 */ -ra6 = -8.1287437439e+01, /* 0xc2a2932b */ -ra7 = -9.8143291473e+00, /* 0xc11d077e */ -sa1 = 1.9651271820e+01, /* 0x419d35ce */ -sa2 = 1.3765776062e+02, /* 0x4309a863 */ -sa3 = 4.3456588745e+02, /* 0x43d9486f */ -sa4 = 6.4538726807e+02, /* 0x442158c9 */ -sa5 = 4.2900814819e+02, /* 0x43d6810b */ -sa6 = 1.0863500214e+02, /* 0x42d9451f */ -sa7 = 6.5702495575e+00, /* 0x40d23f7c */ -sa8 = -6.0424413532e-02, /* 0xbd777f97 */ -/* - * Coefficients for approximation to erfc in [1/.35,28] - */ -rb0 = -9.8649431020e-03, /* 0xbc21a092 */ -rb1 = -7.9928326607e-01, /* 0xbf4c9dd4 */ -rb2 = -1.7757955551e+01, /* 0xc18e104b */ -rb3 = -1.6063638306e+02, /* 0xc320a2ea */ -rb4 = -6.3756646729e+02, /* 0xc41f6441 */ -rb5 = -1.0250950928e+03, /* 0xc480230b */ -rb6 = -4.8351919556e+02, /* 0xc3f1c275 */ -sb1 = 3.0338060379e+01, /* 0x41f2b459 */ -sb2 = 3.2579251099e+02, /* 0x43a2e571 */ -sb3 = 1.5367296143e+03, /* 0x44c01759 */ -sb4 = 3.1998581543e+03, /* 0x4547fdbb */ -sb5 = 2.5530502930e+03, /* 0x451f90ce */ -sb6 = 4.7452853394e+02, /* 0x43ed43a7 */ -sb7 = -2.2440952301e+01; /* 0xc1b38712 */ - -float -erff(float x) -{ - int32_t hx,ix,i; - float R,S,P,Q,s,y,z,r; - GET_FLOAT_WORD(hx,x); - ix = hx&0x7fffffff; - if(ix>=0x7f800000) { /* erf(nan)=nan */ - i = ((uint32_t)hx>>31)<<1; - return (float)(1-i)+one/x; /* erf(+-inf)=+-1 */ - } - - if(ix < 0x3f580000) { /* |x|<0.84375 */ - if(ix < 0x31800000) { /* |x|<2**-28 */ - if (ix < 0x04000000) - /*avoid underflow */ - return (float)0.125*((float)8.0*x+efx8*x); - return x + efx*x; - } - z = x*x; - r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); - s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); - y = r/s; - return x + x*y; - } - if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */ - s = fabsf(x)-one; - P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); - Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); - if(hx>=0) return erx + P/Q; else return -erx - P/Q; - } - if (ix >= 0x40c00000) { /* inf>|x|>=6 */ - if(hx>=0) return one-tiny; else return tiny-one; - } - x = fabsf(x); - s = one/(x*x); - if(ix< 0x4036DB6E) { /* |x| < 1/0.35 */ - R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( - ra5+s*(ra6+s*ra7)))))); - S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( - sa5+s*(sa6+s*(sa7+s*sa8))))))); - } else { /* |x| >= 1/0.35 */ - R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( - rb5+s*rb6))))); - S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( - sb5+s*(sb6+s*sb7)))))); - } - GET_FLOAT_WORD(ix,x); - SET_FLOAT_WORD(z,ix&0xfffff000); - r = expf(-z*z-(float)0.5625)*expf((z-x)*(z+x)+R/S); - if(hx>=0) return one-r/x; else return r/x-one; -} - -float -erfcf(float x) -{ - int32_t hx,ix; - float R,S,P,Q,s,y,z,r; - GET_FLOAT_WORD(hx,x); - ix = hx&0x7fffffff; - if(ix>=0x7f800000) { /* erfc(nan)=nan */ - /* erfc(+-inf)=0,2 */ - return (float)(((uint32_t)hx>>31)<<1)+one/x; - } - - if(ix < 0x3f580000) { /* |x|<0.84375 */ - if(ix < 0x23800000) /* |x|<2**-56 */ - return one-x; - z = x*x; - r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4))); - s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5)))); - y = r/s; - if(hx < 0x3e800000) { /* x<1/4 */ - return one-(x+x*y); - } else { - r = x*y; - r += (x-half); - return half - r ; - } - } - if(ix < 0x3fa00000) { /* 0.84375 <= |x| < 1.25 */ - s = fabsf(x)-one; - P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6))))); - Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6))))); - if(hx>=0) { - z = one-erx; return z - P/Q; - } else { - z = erx+P/Q; return one+z; - } - } - if (ix < 0x41e00000) { /* |x|<28 */ - x = fabsf(x); - s = one/(x*x); - if(ix< 0x4036DB6D) { /* |x| < 1/.35 ~ 2.857143*/ - R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*( - ra5+s*(ra6+s*ra7)))))); - S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*( - sa5+s*(sa6+s*(sa7+s*sa8))))))); - } else { /* |x| >= 1/.35 ~ 2.857143 */ - if(hx<0&&ix>=0x40c00000) return two-tiny;/* x < -6 */ - R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*( - rb5+s*rb6))))); - S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*( - sb5+s*(sb6+s*sb7)))))); - } - GET_FLOAT_WORD(ix,x); - SET_FLOAT_WORD(z,ix&0xfffff000); - r = expf(-z*z-(float)0.5625)* - expf((z-x)*(z+x)+R/S); - if(hx>0) return r/x; else return two-r/x; - } else { - if(hx>0) return tiny*tiny; else return two-tiny; - } -} diff --git a/src/math/s_expm1f.c b/src/math/s_expm1f.c deleted file mode 100644 index b22cf0f9..00000000 --- a/src/math/s_expm1f.c +++ /dev/null @@ -1,122 +0,0 @@ -/* s_expm1f.c -- float version of s_expm1.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -one = 1.0, -huge = 1.0e+30, -tiny = 1.0e-30, -o_threshold = 8.8721679688e+01,/* 0x42b17180 */ -ln2_hi = 6.9313812256e-01,/* 0x3f317180 */ -ln2_lo = 9.0580006145e-06,/* 0x3717f7d1 */ -invln2 = 1.4426950216e+00,/* 0x3fb8aa3b */ - /* scaled coefficients related to expm1 */ -Q1 = -3.3333335072e-02, /* 0xbd088889 */ -Q2 = 1.5873016091e-03, /* 0x3ad00d01 */ -Q3 = -7.9365076090e-05, /* 0xb8a670cd */ -Q4 = 4.0082177293e-06, /* 0x36867e54 */ -Q5 = -2.0109921195e-07; /* 0xb457edbb */ - -float -expm1f(float x) -{ - float y,hi,lo,c=0.0,t,e,hxs,hfx,r1; - int32_t k,xsb; - uint32_t hx; - - GET_FLOAT_WORD(hx,x); - xsb = hx&0x80000000; /* sign bit of x */ - if(xsb==0) y=x; else y= -x; /* y = |x| */ - hx &= 0x7fffffff; /* high word of |x| */ - - /* filter out huge and non-finite argument */ - if(hx >= 0x4195b844) { /* if |x|>=27*ln2 */ - if(hx >= 0x42b17218) { /* if |x|>=88.721... */ - if(hx>0x7f800000) - return x+x; /* NaN */ - if(hx==0x7f800000) - return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */ - if(x > o_threshold) return huge*huge; /* overflow */ - } - if(xsb!=0) { /* x < -27*ln2, return -1.0 with inexact */ - if(x+tiny<(float)0.0) /* raise inexact */ - return tiny-one; /* return -1 */ - } - } - - /* argument reduction */ - if(hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */ - if(hx < 0x3F851592) { /* and |x| < 1.5 ln2 */ - if(xsb==0) - {hi = x - ln2_hi; lo = ln2_lo; k = 1;} - else - {hi = x + ln2_hi; lo = -ln2_lo; k = -1;} - } else { - k = invln2*x+((xsb==0)?(float)0.5:(float)-0.5); - t = k; - hi = x - t*ln2_hi; /* t*ln2_hi is exact here */ - lo = t*ln2_lo; - } - x = hi - lo; - c = (hi-x)-lo; - } - else if(hx < 0x33000000) { /* when |x|<2**-25, return x */ - t = huge+x; /* return x with inexact flags when x!=0 */ - return x - (t-(huge+x)); - } - else k = 0; - - /* x is now in primary range */ - hfx = (float)0.5*x; - hxs = x*hfx; - r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5)))); - t = (float)3.0-r1*hfx; - e = hxs*((r1-t)/((float)6.0 - x*t)); - if(k==0) return x - (x*e-hxs); /* c is 0 */ - else { - e = (x*(e-c)-c); - e -= hxs; - if(k== -1) return (float)0.5*(x-e)-(float)0.5; - if(k==1) { - if(x < (float)-0.25) return -(float)2.0*(e-(x+(float)0.5)); - else return one+(float)2.0*(x-e); - } - if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */ - int32_t i; - y = one-(e-x); - GET_FLOAT_WORD(i,y); - SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */ - return y-one; - } - t = one; - if(k<23) { - int32_t i; - SET_FLOAT_WORD(t,0x3f800000 - (0x1000000>>k)); /* t=1-2^-k */ - y = t-(e-x); - GET_FLOAT_WORD(i,y); - SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */ - } else { - int32_t i; - SET_FLOAT_WORD(t,((0x7f-k)<<23)); /* 2^-k */ - y = x-(e+t); - y += one; - GET_FLOAT_WORD(i,y); - SET_FLOAT_WORD(y,i+(k<<23)); /* add k to y's exponent */ - } - } - return y; -} diff --git a/src/math/s_fabs.c b/src/math/s_fabs.c deleted file mode 100644 index 74433250..00000000 --- a/src/math/s_fabs.c +++ /dev/null @@ -1,27 +0,0 @@ -/* @(#)s_fabs.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * fabs(x) returns the absolute value of x. - */ - -#include <math.h> -#include "math_private.h" - -double -fabs(double x) -{ - uint32_t high; - GET_HIGH_WORD(high,x); - SET_HIGH_WORD(x,high&0x7fffffff); - return x; -} diff --git a/src/math/s_fabsf.c b/src/math/s_fabsf.c deleted file mode 100644 index 655d57d8..00000000 --- a/src/math/s_fabsf.c +++ /dev/null @@ -1,30 +0,0 @@ -/* s_fabsf.c -- float version of s_fabs.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * fabsf(x) returns the absolute value of x. - */ - -#include <math.h> -#include "math_private.h" - -float -fabsf(float x) -{ - uint32_t ix; - GET_FLOAT_WORD(ix,x); - SET_FLOAT_WORD(x,ix&0x7fffffff); - return x; -} diff --git a/src/math/s_floor.c b/src/math/s_floor.c deleted file mode 100644 index 273cf6f4..00000000 --- a/src/math/s_floor.c +++ /dev/null @@ -1,69 +0,0 @@ -/* @(#)s_floor.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * floor(x) - * Return x rounded toward -inf to integral value - * Method: - * Bit twiddling. - * Exception: - * Inexact flag raised if x not equal to floor(x). - */ - -#include <math.h> -#include "math_private.h" - -static const double huge = 1.0e300; - -double -floor(double x) -{ - int32_t i0,i1,j0; - uint32_t i,j; - EXTRACT_WORDS(i0,i1,x); - j0 = ((i0>>20)&0x7ff)-0x3ff; - if(j0<20) { - if(j0<0) { /* raise inexact if x != 0 */ - if(huge+x>0.0) {/* return 0*sign(x) if |x|<1 */ - if(i0>=0) {i0=i1=0;} - else if(((i0&0x7fffffff)|i1)!=0) - { i0=0xbff00000;i1=0;} - } - } else { - i = (0x000fffff)>>j0; - if(((i0&i)|i1)==0) return x; /* x is integral */ - if(huge+x>0.0) { /* raise inexact flag */ - if(i0<0) i0 += (0x00100000)>>j0; - i0 &= (~i); i1=0; - } - } - } else if (j0>51) { - if(j0==0x400) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } else { - i = ((uint32_t)(0xffffffff))>>(j0-20); - if((i1&i)==0) return x; /* x is integral */ - if(huge+x>0.0) { /* raise inexact flag */ - if(i0<0) { - if(j0==20) i0+=1; - else { - j = i1+(1<<(52-j0)); - if(j<i1) i0 +=1 ; /* got a carry */ - i1=j; - } - } - i1 &= (~i); - } - } - INSERT_WORDS(x,i0,i1); - return x; -} diff --git a/src/math/s_floorf.c b/src/math/s_floorf.c deleted file mode 100644 index 1164decc..00000000 --- a/src/math/s_floorf.c +++ /dev/null @@ -1,58 +0,0 @@ -/* s_floorf.c -- float version of s_floor.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * floorf(x) - * Return x rounded toward -inf to integral value - * Method: - * Bit twiddling. - * Exception: - * Inexact flag raised if x not equal to floorf(x). - */ - -#include <math.h> -#include "math_private.h" - -static const float huge = 1.0e30; - -float -floorf(float x) -{ - int32_t i0,j0; - uint32_t i; - GET_FLOAT_WORD(i0,x); - j0 = ((i0>>23)&0xff)-0x7f; - if(j0<23) { - if(j0<0) { /* raise inexact if x != 0 */ - if(huge+x>(float)0.0) {/* return 0*sign(x) if |x|<1 */ - if(i0>=0) {i0=0;} - else if((i0&0x7fffffff)!=0) - { i0=0xbf800000;} - } - } else { - i = (0x007fffff)>>j0; - if((i0&i)==0) return x; /* x is integral */ - if(huge+x>(float)0.0) { /* raise inexact flag */ - if(i0<0) i0 += (0x00800000)>>j0; - i0 &= (~i); - } - } - } else { - if(j0==0x80) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } - SET_FLOAT_WORD(x,i0); - return x; -} diff --git a/src/math/s_ilogb.c b/src/math/s_ilogb.c deleted file mode 100644 index f1ac498a..00000000 --- a/src/math/s_ilogb.c +++ /dev/null @@ -1,45 +0,0 @@ -/* @(#)s_ilogb.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* ilogb(double x) - * return the binary exponent of non-zero x - * ilogb(0) = FP_ILOGB0 - * ilogb(NaN) = FP_ILOGBNAN (no signal is raised) - * ilogb(inf) = INT_MAX (no signal is raised) - */ - -#include <limits.h> - -#include <math.h> -#include "math_private.h" - -int ilogb(double x) -{ - int32_t hx,lx,ix; - - EXTRACT_WORDS(hx,lx,x); - hx &= 0x7fffffff; - if(hx<0x00100000) { - if((hx|lx)==0) - return FP_ILOGB0; - else /* subnormal x */ - if(hx==0) { - for (ix = -1043; lx>0; lx<<=1) ix -=1; - } else { - for (ix = -1022,hx<<=11; hx>0; hx<<=1) ix -=1; - } - return ix; - } - else if (hx<0x7ff00000) return (hx>>20)-1023; - else if (hx>0x7ff00000 || lx!=0) return FP_ILOGBNAN; - else return INT_MAX; -} diff --git a/src/math/s_ilogbf.c b/src/math/s_ilogbf.c deleted file mode 100644 index 30359fef..00000000 --- a/src/math/s_ilogbf.c +++ /dev/null @@ -1,37 +0,0 @@ -/* s_ilogbf.c -- float version of s_ilogb.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <limits.h> - -#include <math.h> -#include "math_private.h" - -int ilogbf(float x) -{ - int32_t hx,ix; - - GET_FLOAT_WORD(hx,x); - hx &= 0x7fffffff; - if(hx<0x00800000) { - if(hx==0) - return FP_ILOGB0; - else /* subnormal x */ - for (ix = -126,hx<<=8; hx>0; hx<<=1) ix -=1; - return ix; - } - else if (hx<0x7f800000) return (hx>>23)-127; - else if (hx>0x7f800000) return FP_ILOGBNAN; - else return INT_MAX; -} diff --git a/src/math/s_llrint.c b/src/math/s_llrint.c deleted file mode 100644 index 2b1e00d0..00000000 --- a/src/math/s_llrint.c +++ /dev/null @@ -1,8 +0,0 @@ -#include <math.h> - -// FIXME: incorrect exception behavior - -long long llrint(double x) -{ - return rint(x); -} diff --git a/src/math/s_log1pf.c b/src/math/s_log1pf.c deleted file mode 100644 index dcdd6bb3..00000000 --- a/src/math/s_log1pf.c +++ /dev/null @@ -1,96 +0,0 @@ -/* s_log1pf.c -- float version of s_log1p.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -ln2_hi = 6.9313812256e-01, /* 0x3f317180 */ -ln2_lo = 9.0580006145e-06, /* 0x3717f7d1 */ -two25 = 3.355443200e+07, /* 0x4c000000 */ -Lp1 = 6.6666668653e-01, /* 3F2AAAAB */ -Lp2 = 4.0000000596e-01, /* 3ECCCCCD */ -Lp3 = 2.8571429849e-01, /* 3E924925 */ -Lp4 = 2.2222198546e-01, /* 3E638E29 */ -Lp5 = 1.8183572590e-01, /* 3E3A3325 */ -Lp6 = 1.5313838422e-01, /* 3E1CD04F */ -Lp7 = 1.4798198640e-01; /* 3E178897 */ - -static const float zero = 0.0; - -float -log1pf(float x) -{ - float hfsq,f=0,c=0,s,z,R,u; - int32_t k,hx,hu=0,ax; - - GET_FLOAT_WORD(hx,x); - ax = hx&0x7fffffff; - - k = 1; - if (hx < 0x3ed413d7) { /* x < 0.41422 */ - if(ax>=0x3f800000) { /* x <= -1.0 */ - if(x==(float)-1.0) return -two25/zero; /* log1p(-1)=+inf */ - else return (x-x)/(x-x); /* log1p(x<-1)=NaN */ - } - if(ax<0x31000000) { /* |x| < 2**-29 */ - if(two25+x>zero /* raise inexact */ - &&ax<0x24800000) /* |x| < 2**-54 */ - return x; - else - return x - x*x*(float)0.5; - } - if(hx>0||hx<=((int32_t)0xbe95f61f)) { - k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */ - } - if (hx >= 0x7f800000) return x+x; - if(k!=0) { - if(hx<0x5a000000) { - u = (float)1.0+x; - GET_FLOAT_WORD(hu,u); - k = (hu>>23)-127; - /* correction term */ - c = (k>0)? (float)1.0-(u-x):x-(u-(float)1.0); - c /= u; - } else { - u = x; - GET_FLOAT_WORD(hu,u); - k = (hu>>23)-127; - c = 0; - } - hu &= 0x007fffff; - if(hu<0x3504f7) { - SET_FLOAT_WORD(u,hu|0x3f800000);/* normalize u */ - } else { - k += 1; - SET_FLOAT_WORD(u,hu|0x3f000000); /* normalize u/2 */ - hu = (0x00800000-hu)>>2; - } - f = u-(float)1.0; - } - hfsq=(float)0.5*f*f; - if(hu==0) { /* |f| < 2**-20 */ - if(f==zero) { if(k==0) return zero; - else {c += k*ln2_lo; return k*ln2_hi+c;} } - R = hfsq*((float)1.0-(float)0.66666666666666666*f); - if(k==0) return f-R; else - return k*ln2_hi-((R-(k*ln2_lo+c))-f); - } - s = f/((float)2.0+f); - z = s*s; - R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7)))))); - if(k==0) return f-(hfsq-s*(hfsq+R)); else - return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f); -} diff --git a/src/math/s_logb.c b/src/math/s_logb.c deleted file mode 100644 index be399c77..00000000 --- a/src/math/s_logb.c +++ /dev/null @@ -1,34 +0,0 @@ -/* @(#)s_logb.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * double logb(x) - * IEEE 754 logb. Included to pass IEEE test suite. Not recommend. - * Use ilogb instead. - */ - -#include <math.h> -#include "math_private.h" - -double -logb(double x) -{ - int32_t lx,ix; - EXTRACT_WORDS(ix,lx,x); - ix &= 0x7fffffff; /* high |x| */ - if((ix|lx)==0) return -1.0/fabs(x); - if(ix>=0x7ff00000) return x*x; - if((ix>>=20)==0) /* IEEE 754 logb */ - return -1022.0; - else - return (double) (ix-1023); -} diff --git a/src/math/s_logbf.c b/src/math/s_logbf.c deleted file mode 100644 index 747664d3..00000000 --- a/src/math/s_logbf.c +++ /dev/null @@ -1,31 +0,0 @@ -/* s_logbf.c -- float version of s_logb.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -float -logbf(float x) -{ - int32_t ix; - GET_FLOAT_WORD(ix,x); - ix &= 0x7fffffff; /* high |x| */ - if(ix==0) return (float)-1.0/fabsf(x); - if(ix>=0x7f800000) return x*x; - if((ix>>=23)==0) /* IEEE 754 logb */ - return -126.0; - else - return (float) (ix-127); -} diff --git a/src/math/s_lrint.c b/src/math/s_lrint.c deleted file mode 100644 index da8e1989..00000000 --- a/src/math/s_lrint.c +++ /dev/null @@ -1,8 +0,0 @@ -#include <math.h> - -// FIXME: incorrect exception behavior - -long lrint(double x) -{ - return rint(x); -} diff --git a/src/math/s_lrintf.c b/src/math/s_lrintf.c deleted file mode 100644 index d0b469b9..00000000 --- a/src/math/s_lrintf.c +++ /dev/null @@ -1,8 +0,0 @@ -#include <math.h> - -// FIXME: incorrect exception behavior - -long lrintf(float x) -{ - return rintf(x); -} diff --git a/src/math/s_modf.c b/src/math/s_modf.c deleted file mode 100644 index a5528d6b..00000000 --- a/src/math/s_modf.c +++ /dev/null @@ -1,71 +0,0 @@ -/* @(#)s_modf.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * modf(double x, double *iptr) - * return fraction part of x, and return x's integral part in *iptr. - * Method: - * Bit twiddling. - * - * Exception: - * No exception. - */ - -#include <math.h> -#include "math_private.h" - -static const double one = 1.0; - -double -modf(double x, double *iptr) -{ - int32_t i0,i1,j0; - uint32_t i; - EXTRACT_WORDS(i0,i1,x); - j0 = ((i0>>20)&0x7ff)-0x3ff; /* exponent of x */ - if(j0<20) { /* integer part in high x */ - if(j0<0) { /* |x|<1 */ - INSERT_WORDS(*iptr,i0&0x80000000,0); /* *iptr = +-0 */ - return x; - } else { - i = (0x000fffff)>>j0; - if(((i0&i)|i1)==0) { /* x is integral */ - uint32_t high; - *iptr = x; - GET_HIGH_WORD(high,x); - INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ - return x; - } else { - INSERT_WORDS(*iptr,i0&(~i),0); - return x - *iptr; - } - } - } else if (j0>51) { /* no fraction part */ - uint32_t high; - *iptr = x*one; - GET_HIGH_WORD(high,x); - INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ - return x; - } else { /* fraction part in low x */ - i = ((uint32_t)(0xffffffff))>>(j0-20); - if((i1&i)==0) { /* x is integral */ - uint32_t high; - *iptr = x; - GET_HIGH_WORD(high,x); - INSERT_WORDS(x,high&0x80000000,0); /* return +-0 */ - return x; - } else { - INSERT_WORDS(*iptr,i0,i1&(~i)); - return x - *iptr; - } - } -} diff --git a/src/math/s_modff.c b/src/math/s_modff.c deleted file mode 100644 index de4dfd25..00000000 --- a/src/math/s_modff.c +++ /dev/null @@ -1,52 +0,0 @@ -/* s_modff.c -- float version of s_modf.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float one = 1.0; - -float -modff(float x, float *iptr) -{ - int32_t i0,j0; - uint32_t i; - GET_FLOAT_WORD(i0,x); - j0 = ((i0>>23)&0xff)-0x7f; /* exponent of x */ - if(j0<23) { /* integer part in x */ - if(j0<0) { /* |x|<1 */ - SET_FLOAT_WORD(*iptr,i0&0x80000000); /* *iptr = +-0 */ - return x; - } else { - i = (0x007fffff)>>j0; - if((i0&i)==0) { /* x is integral */ - uint32_t ix; - *iptr = x; - GET_FLOAT_WORD(ix,x); - SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */ - return x; - } else { - SET_FLOAT_WORD(*iptr,i0&(~i)); - return x - *iptr; - } - } - } else { /* no fraction part */ - uint32_t ix; - *iptr = x*one; - GET_FLOAT_WORD(ix,x); - SET_FLOAT_WORD(x,ix&0x80000000); /* return +-0 */ - return x; - } -} diff --git a/src/math/s_nextafter.c b/src/math/s_nextafter.c deleted file mode 100644 index 46d298ec..00000000 --- a/src/math/s_nextafter.c +++ /dev/null @@ -1,72 +0,0 @@ -/* @(#)s_nextafter.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* IEEE functions - * nextafter(x,y) - * return the next machine floating-point number of x in the - * direction toward y. - * Special cases: - */ - -#include <math.h> -#include "math_private.h" - -double -nextafter(double x, double y) -{ - volatile double t; - int32_t hx,hy,ix,iy; - uint32_t lx,ly; - - EXTRACT_WORDS(hx,lx,x); - EXTRACT_WORDS(hy,ly,y); - ix = hx&0x7fffffff; /* |x| */ - iy = hy&0x7fffffff; /* |y| */ - - if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */ - ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */ - return x+y; - if(x==y) return y; /* x=y, return y */ - if((ix|lx)==0) { /* x == 0 */ - INSERT_WORDS(x,hy&0x80000000,1); /* return +-minsubnormal */ - t = x*x; - if(t==x) return t; else return x; /* raise underflow flag */ - } - if(hx>=0) { /* x > 0 */ - if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */ - if(lx==0) hx -= 1; - lx -= 1; - } else { /* x < y, x += ulp */ - lx += 1; - if(lx==0) hx += 1; - } - } else { /* x < 0 */ - if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */ - if(lx==0) hx -= 1; - lx -= 1; - } else { /* x > y, x += ulp */ - lx += 1; - if(lx==0) hx += 1; - } - } - hy = hx&0x7ff00000; - if(hy>=0x7ff00000) return x+x; /* overflow */ - if(hy<0x00100000) { /* underflow */ - t = x*x; - if(t!=x) { /* raise underflow flag */ - INSERT_WORDS(y,hx,lx); - return y; - } - } - INSERT_WORDS(x,hx,lx); - return x; -} diff --git a/src/math/s_nextafterf.c b/src/math/s_nextafterf.c deleted file mode 100644 index 7ce08838..00000000 --- a/src/math/s_nextafterf.c +++ /dev/null @@ -1,63 +0,0 @@ -/* s_nextafterf.c -- float version of s_nextafter.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -float -nextafterf(float x, float y) -{ - volatile float t; - int32_t hx,hy,ix,iy; - - GET_FLOAT_WORD(hx,x); - GET_FLOAT_WORD(hy,y); - ix = hx&0x7fffffff; /* |x| */ - iy = hy&0x7fffffff; /* |y| */ - - if((ix>0x7f800000) || /* x is nan */ - (iy>0x7f800000)) /* y is nan */ - return x+y; - if(x==y) return y; /* x=y, return y */ - if(ix==0) { /* x == 0 */ - SET_FLOAT_WORD(x,(hy&0x80000000)|1);/* return +-minsubnormal */ - t = x*x; - if(t==x) return t; else return x; /* raise underflow flag */ - } - if(hx>=0) { /* x > 0 */ - if(hx>hy) { /* x > y, x -= ulp */ - hx -= 1; - } else { /* x < y, x += ulp */ - hx += 1; - } - } else { /* x < 0 */ - if(hy>=0||hx>hy){ /* x < y, x -= ulp */ - hx -= 1; - } else { /* x > y, x += ulp */ - hx += 1; - } - } - hy = hx&0x7f800000; - if(hy>=0x7f800000) return x+x; /* overflow */ - if(hy<0x00800000) { /* underflow */ - t = x*x; - if(t!=x) { /* raise underflow flag */ - SET_FLOAT_WORD(y,hx); - return y; - } - } - SET_FLOAT_WORD(x,hx); - return x; -} diff --git a/src/math/s_remquo.c b/src/math/s_remquo.c deleted file mode 100644 index 1a2992d6..00000000 --- a/src/math/s_remquo.c +++ /dev/null @@ -1,149 +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. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const double Zero[] = {0.0, -0.0,}; - -/* - * Return the IEEE remainder and set *quo to the last n bits of the - * quotient, rounded to the nearest integer. We choose n=31 because - * we wind up computing all the integer bits of the quotient anyway as - * a side-effect of computing the remainder by the shift and subtract - * method. In practice, this is far more bits than are needed to use - * remquo in reduction algorithms. - */ -double -remquo(double x, double y, int *quo) -{ - int32_t n,hx,hy,hz,ix,iy,sx,i; - uint32_t lx,ly,lz,q,sxy; - - EXTRACT_WORDS(hx,lx,x); - EXTRACT_WORDS(hy,ly,y); - sxy = (hx ^ hy) & 0x80000000; - sx = hx&0x80000000; /* sign of x */ - hx ^=sx; /* |x| */ - hy &= 0x7fffffff; /* |y| */ - - /* purge off exception values */ - if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */ - ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */ - return (x*y)/(x*y); - if(hx<=hy) { - if((hx<hy)||(lx<ly)) { - q = 0; - goto fixup; /* |x|<|y| return x or x-y */ - } - if(lx==ly) { - *quo = 1; - return Zero[(uint32_t)sx>>31]; /* |x|=|y| return x*0*/ - } - } - - /* determine ix = ilogb(x) */ - if(hx<0x00100000) { /* subnormal x */ - if(hx==0) { - for (ix = -1043, i=lx; i>0; i<<=1) ix -=1; - } else { - for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1; - } - } else ix = (hx>>20)-1023; - - /* determine iy = ilogb(y) */ - if(hy<0x00100000) { /* subnormal y */ - if(hy==0) { - for (iy = -1043, i=ly; i>0; i<<=1) iy -=1; - } else { - for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1; - } - } else iy = (hy>>20)-1023; - - /* set up {hx,lx}, {hy,ly} and align y to x */ - if(ix >= -1022) - hx = 0x00100000|(0x000fffff&hx); - else { /* subnormal x, shift x to normal */ - n = -1022-ix; - if(n<=31) { - hx = (hx<<n)|(lx>>(32-n)); - lx <<= n; - } else { - hx = lx<<(n-32); - lx = 0; - } - } - if(iy >= -1022) - hy = 0x00100000|(0x000fffff&hy); - else { /* subnormal y, shift y to normal */ - n = -1022-iy; - if(n<=31) { - hy = (hy<<n)|(ly>>(32-n)); - ly <<= n; - } else { - hy = ly<<(n-32); - ly = 0; - } - } - - /* fix point fmod */ - n = ix - iy; - q = 0; - while(n--) { - hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; - if(hz<0){hx = hx+hx+(lx>>31); lx = lx+lx;} - else {hx = hz+hz+(lz>>31); lx = lz+lz; q++;} - q <<= 1; - } - hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1; - if(hz>=0) {hx=hz;lx=lz;q++;} - - /* convert back to floating value and restore the sign */ - if((hx|lx)==0) { /* return sign(x)*0 */ - *quo = (sxy ? -q : q); - return Zero[(uint32_t)sx>>31]; - } - while(hx<0x00100000) { /* normalize x */ - hx = hx+hx+(lx>>31); lx = lx+lx; - iy -= 1; - } - if(iy>= -1022) { /* normalize output */ - hx = ((hx-0x00100000)|((iy+1023)<<20)); - } else { /* subnormal output */ - n = -1022 - iy; - if(n<=20) { - lx = (lx>>n)|((uint32_t)hx<<(32-n)); - hx >>= n; - } else if (n<=31) { - lx = (hx<<(32-n))|(lx>>n); hx = sx; - } else { - lx = hx>>(n-32); hx = sx; - } - } -fixup: - INSERT_WORDS(x,hx,lx); - y = fabs(y); - if (y < 0x1p-1021) { - if (x+x>y || (x+x==y && (q & 1))) { - q++; - x-=y; - } - } else if (x>0.5*y || (x==0.5*y && (q & 1))) { - q++; - x-=y; - } - GET_HIGH_WORD(hx,x); - SET_HIGH_WORD(x,hx^sx); - q &= 0x7fffffff; - *quo = (sxy ? -q : q); - return x; -} diff --git a/src/math/s_remquof.c b/src/math/s_remquof.c deleted file mode 100644 index be2a561a..00000000 --- a/src/math/s_remquof.c +++ /dev/null @@ -1,118 +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. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float Zero[] = {0.0, -0.0,}; - -/* - * Return the IEEE remainder and set *quo to the last n bits of the - * quotient, rounded to the nearest integer. We choose n=31 because - * we wind up computing all the integer bits of the quotient anyway as - * a side-effect of computing the remainder by the shift and subtract - * method. In practice, this is far more bits than are needed to use - * remquo in reduction algorithms. - */ -float -remquof(float x, float y, int *quo) -{ - int32_t n,hx,hy,hz,ix,iy,sx,i; - uint32_t q,sxy; - - GET_FLOAT_WORD(hx,x); - GET_FLOAT_WORD(hy,y); - sxy = (hx ^ hy) & 0x80000000; - sx = hx&0x80000000; /* sign of x */ - hx ^=sx; /* |x| */ - hy &= 0x7fffffff; /* |y| */ - - /* purge off exception values */ - if(hy==0||hx>=0x7f800000||hy>0x7f800000) /* y=0,NaN;or x not finite */ - return (x*y)/(x*y); - if(hx<hy) { - q = 0; - goto fixup; /* |x|<|y| return x or x-y */ - } else if(hx==hy) { - *quo = 1; - return Zero[(uint32_t)sx>>31]; /* |x|=|y| return x*0*/ - } - - /* determine ix = ilogb(x) */ - if(hx<0x00800000) { /* subnormal x */ - for (ix = -126,i=(hx<<8); i>0; i<<=1) ix -=1; - } else ix = (hx>>23)-127; - - /* determine iy = ilogb(y) */ - if(hy<0x00800000) { /* subnormal y */ - for (iy = -126,i=(hy<<8); i>0; i<<=1) iy -=1; - } else iy = (hy>>23)-127; - - /* set up {hx,lx}, {hy,ly} and align y to x */ - if(ix >= -126) - hx = 0x00800000|(0x007fffff&hx); - else { /* subnormal x, shift x to normal */ - n = -126-ix; - hx <<= n; - } - if(iy >= -126) - hy = 0x00800000|(0x007fffff&hy); - else { /* subnormal y, shift y to normal */ - n = -126-iy; - hy <<= n; - } - - /* fix point fmod */ - n = ix - iy; - q = 0; - while(n--) { - hz=hx-hy; - if(hz<0) hx = hx << 1; - else {hx = hz << 1; q++;} - q <<= 1; - } - hz=hx-hy; - if(hz>=0) {hx=hz;q++;} - - /* convert back to floating value and restore the sign */ - if(hx==0) { /* return sign(x)*0 */ - *quo = (sxy ? -q : q); - return Zero[(uint32_t)sx>>31]; - } - while(hx<0x00800000) { /* normalize x */ - hx <<= 1; - iy -= 1; - } - if(iy>= -126) { /* normalize output */ - hx = ((hx-0x00800000)|((iy+127)<<23)); - } else { /* subnormal output */ - n = -126 - iy; - hx >>= n; - } -fixup: - SET_FLOAT_WORD(x,hx); - y = fabsf(y); - if (y < 0x1p-125f) { - if (x+x>y || (x+x==y && (q & 1))) { - q++; - x-=y; - } - } else if (x>0.5f*y || (x==0.5f*y && (q & 1))) { - q++; - x-=y; - } - GET_FLOAT_WORD(hx,x); - SET_FLOAT_WORD(x,hx^sx); - q &= 0x7fffffff; - *quo = (sxy ? -q : q); - return x; -} diff --git a/src/math/s_rint.c b/src/math/s_rint.c deleted file mode 100644 index aec7d3c9..00000000 --- a/src/math/s_rint.c +++ /dev/null @@ -1,80 +0,0 @@ -/* @(#)s_rint.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * rint(x) - * Return x rounded to integral value according to the prevailing - * rounding mode. - * Method: - * Using floating addition. - * Exception: - * Inexact flag raised if x not equal to rint(x). - */ - -#include <math.h> -#include "math_private.h" - -/* - * TWO23 is long double instead of double to avoid a bug in gcc. Without - * this, gcc thinks that TWO23[sx]+x and w-TWO23[sx] already have double - * precision and doesn't clip them to double precision when they are - * assigned and returned. - */ -static const long double -TWO52[2]={ - 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */ - -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */ -}; - -double -rint(double x) -{ - int32_t i0,j0,sx; - uint32_t i,i1; - double w,t; - EXTRACT_WORDS(i0,i1,x); - sx = (i0>>31)&1; - j0 = ((i0>>20)&0x7ff)-0x3ff; - if(j0<20) { - if(j0<0) { - if(((i0&0x7fffffff)|i1)==0) return x; - i1 |= (i0&0x0fffff); - i0 &= 0xfffe0000; - i0 |= ((i1|-i1)>>12)&0x80000; - SET_HIGH_WORD(x,i0); - w = TWO52[sx]+x; - t = w-TWO52[sx]; - GET_HIGH_WORD(i0,t); - SET_HIGH_WORD(t,(i0&0x7fffffff)|(sx<<31)); - return t; - } else { - i = (0x000fffff)>>j0; - if(((i0&i)|i1)==0) return x; /* x is integral */ - i>>=1; - if(((i0&i)|i1)!=0) { - if(j0==19) i1 = 0x40000000; else - i0 = (i0&(~i))|((0x20000)>>j0); - } - } - } else if (j0>51) { - if(j0==0x400) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } else { - i = ((uint32_t)(0xffffffff))>>(j0-20); - if((i1&i)==0) return x; /* x is integral */ - i>>=1; - if((i1&i)!=0) i1 = (i1&(~i))|((0x40000000)>>(j0-20)); - } - INSERT_WORDS(x,i0,i1); - w = TWO52[sx]+x; - return w-TWO52[sx]; -} diff --git a/src/math/s_rintf.c b/src/math/s_rintf.c deleted file mode 100644 index c441870d..00000000 --- a/src/math/s_rintf.c +++ /dev/null @@ -1,45 +0,0 @@ -/* s_rintf.c -- float version of s_rint.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -TWO23[2]={ - 8.3886080000e+06, /* 0x4b000000 */ - -8.3886080000e+06, /* 0xcb000000 */ -}; - -float -rintf(float x) -{ - int32_t i0,j0,sx; - volatile float w,t; /* volatile works around gcc bug */ - GET_FLOAT_WORD(i0,x); - sx = (i0>>31)&1; - j0 = ((i0>>23)&0xff)-0x7f; - if(j0<23) { - if(j0<0) { - if((i0&0x7fffffff)==0) return x; - w = TWO23[sx]+x; - t = w-TWO23[sx]; - return t; - } - w = TWO23[sx]+x; - return w-TWO23[sx]; - } - if(j0==0x80) return x+x; /* inf or NaN */ - else return x; /* x is integral */ -} diff --git a/src/math/s_scalbln.c b/src/math/s_scalbln.c deleted file mode 100644 index 12b9391b..00000000 --- a/src/math/s_scalbln.c +++ /dev/null @@ -1,61 +0,0 @@ -/* @(#)s_scalbn.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * scalbn (double x, int n) - * scalbn(x,n) returns x* 2**n computed by exponent - * manipulation rather than by actually performing an - * exponentiation or a multiplication. - */ - -#include <math.h> -#include "math_private.h" - -static const double -two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ -twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */ -huge = 1.0e+300, -tiny = 1.0e-300; - -double -scalbln (double x, long n) -{ - int32_t k,hx,lx; - EXTRACT_WORDS(hx,lx,x); - k = (hx&0x7ff00000)>>20; /* extract exponent */ - if (k==0) { /* 0 or subnormal x */ - if ((lx|(hx&0x7fffffff))==0) return x; /* +-0 */ - x *= two54; - GET_HIGH_WORD(hx,x); - k = ((hx&0x7ff00000)>>20) - 54; - if (n< -50000) return tiny*x; /*underflow*/ - } - if (k==0x7ff) return x+x; /* NaN or Inf */ - k = k+n; - if (k > 0x7fe) return huge*copysign(huge,x); /* overflow */ - if (k > 0) /* normal result */ - {SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); return x;} - if (k <= -54) { - if (n > 50000) /* in case integer overflow in n+k */ - return huge*copysign(huge,x); /*overflow*/ - else return tiny*copysign(tiny,x); /*underflow*/ - } - k += 54; /* subnormal result */ - SET_HIGH_WORD(x,(hx&0x800fffff)|(k<<20)); - return x*twom54; -} - -double -scalbn (double x, int n) -{ - return scalbln(x, n); -} diff --git a/src/math/s_scalblnf.c b/src/math/s_scalblnf.c deleted file mode 100644 index 21e7641c..00000000 --- a/src/math/s_scalblnf.c +++ /dev/null @@ -1,57 +0,0 @@ -/* s_scalbnf.c -- float version of s_scalbn.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float -two25 = 3.355443200e+07, /* 0x4c000000 */ -twom25 = 2.9802322388e-08, /* 0x33000000 */ -huge = 1.0e+30, -tiny = 1.0e-30; - -float -scalblnf (float x, long n) -{ - int32_t k,ix; - GET_FLOAT_WORD(ix,x); - k = (ix&0x7f800000)>>23; /* extract exponent */ - if (k==0) { /* 0 or subnormal x */ - if ((ix&0x7fffffff)==0) return x; /* +-0 */ - x *= two25; - GET_FLOAT_WORD(ix,x); - k = ((ix&0x7f800000)>>23) - 25; - if (n< -50000) return tiny*x; /*underflow*/ - } - if (k==0xff) return x+x; /* NaN or Inf */ - k = k+n; - if (k > 0xfe) return huge*copysignf(huge,x); /* overflow */ - if (k > 0) /* normal result */ - {SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); return x;} - if (k <= -25) { - if (n > 50000) /* in case integer overflow in n+k */ - return huge*copysignf(huge,x); /*overflow*/ - else return tiny*copysignf(tiny,x); /*underflow*/ - } - k += 25; /* subnormal result */ - SET_FLOAT_WORD(x,(ix&0x807fffff)|(k<<23)); - return x*twom25; -} - -float -scalbnf (float x, int n) -{ - return scalblnf(x, n); -} diff --git a/src/math/s_sinf.c b/src/math/s_sinf.c deleted file mode 100644 index d2b8e806..00000000 --- a/src/math/s_sinf.c +++ /dev/null @@ -1,45 +0,0 @@ -/* s_sinf.c -- float version of s_sin.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -float -sinf(float x) -{ - float y[2],z=0.0; - int32_t n, ix; - - GET_FLOAT_WORD(ix,x); - - /* |x| ~< pi/4 */ - ix &= 0x7fffffff; - if(ix <= 0x3f490fd8) return __kernel_sinf(x,z,0); - - /* sin(Inf or NaN) is NaN */ - else if (ix>=0x7f800000) return x-x; - - /* argument reduction needed */ - else { - n = __ieee754_rem_pio2f(x,y); - switch(n&3) { - case 0: return __kernel_sinf(y[0],y[1],1); - case 1: return __kernel_cosf(y[0],y[1]); - case 2: return -__kernel_sinf(y[0],y[1],1); - default: - return -__kernel_cosf(y[0],y[1]); - } - } -} diff --git a/src/math/s_tanf.c b/src/math/s_tanf.c deleted file mode 100644 index 660dd9c3..00000000 --- a/src/math/s_tanf.c +++ /dev/null @@ -1,40 +0,0 @@ -/* s_tanf.c -- float version of s_tan.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -float -tanf(float x) -{ - float y[2],z=0.0; - int32_t n, ix; - - GET_FLOAT_WORD(ix,x); - - /* |x| ~< pi/4 */ - ix &= 0x7fffffff; - if(ix <= 0x3f490fda) return __kernel_tanf(x,z,1); - - /* tan(Inf or NaN) is NaN */ - else if (ix>=0x7f800000) return x-x; /* NaN */ - - /* argument reduction needed */ - else { - n = __ieee754_rem_pio2f(x,y); - return __kernel_tanf(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even - -1 -- n odd */ - } -} diff --git a/src/math/s_tanh.c b/src/math/s_tanh.c deleted file mode 100644 index 78b8e849..00000000 --- a/src/math/s_tanh.c +++ /dev/null @@ -1,74 +0,0 @@ -/* @(#)s_tanh.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* Tanh(x) - * Return the Hyperbolic Tangent of x - * - * Method : - * x -x - * e - e - * 0. tanh(x) is defined to be ----------- - * x -x - * e + e - * 1. reduce x to non-negative by tanh(-x) = -tanh(x). - * 2. 0 <= x <= 2**-55 : tanh(x) := x*(one+x) - * -t - * 2**-55 < x <= 1 : tanh(x) := -----; t = expm1(-2x) - * t + 2 - * 2 - * 1 <= x <= 22.0 : tanh(x) := 1- ----- ; t=expm1(2x) - * t + 2 - * 22.0 < x <= INF : tanh(x) := 1. - * - * Special cases: - * tanh(NaN) is NaN; - * only tanh(0)=0 is exact for finite argument. - */ - -#include <math.h> -#include "math_private.h" - -static const double one=1.0, two=2.0, tiny = 1.0e-300; - -double -tanh(double x) -{ - double t,z; - int32_t jx,ix; - - /* High word of |x|. */ - GET_HIGH_WORD(jx,x); - ix = jx&0x7fffffff; - - /* x is INF or NaN */ - if(ix>=0x7ff00000) { - if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ - else return one/x-one; /* tanh(NaN) = NaN */ - } - - /* |x| < 22 */ - if (ix < 0x40360000) { /* |x|<22 */ - if (ix<0x3c800000) /* |x|<2**-55 */ - return x*(one+x); /* tanh(small) = small */ - if (ix>=0x3ff00000) { /* |x|>=1 */ - t = expm1(two*fabs(x)); - z = one - two/(t+two); - } else { - t = expm1(-two*fabs(x)); - z= -t/(t+two); - } - /* |x| > 22, return +-1 */ - } else { - z = one - tiny; /* raised inexact flag */ - } - return (jx>=0)? z: -z; -} diff --git a/src/math/s_tanhf.c b/src/math/s_tanhf.c deleted file mode 100644 index a0820409..00000000 --- a/src/math/s_tanhf.c +++ /dev/null @@ -1,52 +0,0 @@ -/* s_tanhf.c -- float version of s_tanh.c. - * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. - */ - -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -#include <math.h> -#include "math_private.h" - -static const float one=1.0, two=2.0, tiny = 1.0e-30; - -float -tanhf(float x) -{ - float t,z; - int32_t jx,ix; - - GET_FLOAT_WORD(jx,x); - ix = jx&0x7fffffff; - - /* x is INF or NaN */ - if(ix>=0x7f800000) { - if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */ - else return one/x-one; /* tanh(NaN) = NaN */ - } - - /* |x| < 22 */ - if (ix < 0x41b00000) { /* |x|<22 */ - if (ix<0x24000000) /* |x|<2**-55 */ - return x*(one+x); /* tanh(small) = small */ - if (ix>=0x3f800000) { /* |x|>=1 */ - t = expm1f(two*fabsf(x)); - z = one - two/(t+two); - } else { - t = expm1f(-two*fabsf(x)); - z= -t/(t+two); - } - /* |x| > 22, return +-1 */ - } else { - z = one - tiny; /* raised inexact flag */ - } - return (jx>=0)? z: -z; -} diff --git a/src/math/s_trunc.c b/src/math/s_trunc.c deleted file mode 100644 index 02c65567..00000000 --- a/src/math/s_trunc.c +++ /dev/null @@ -1,58 +0,0 @@ -/* @(#)s_floor.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * trunc(x) - * Return x rounded toward 0 to integral value - * Method: - * Bit twiddling. - * Exception: - * Inexact flag raised if x not equal to trunc(x). - */ - -#include <math.h> -#include "math_private.h" - -static const double huge = 1.0e300; - -double -trunc(double x) -{ - int32_t i0,i1,j0; - uint32_t i,j; - EXTRACT_WORDS(i0,i1,x); - j0 = ((i0>>20)&0x7ff)-0x3ff; - if(j0<20) { - if(j0<0) { /* raise inexact if x != 0 */ - if(huge+x>0.0) {/* |x|<1, so return 0*sign(x) */ - i0 &= 0x80000000U; - i1 = 0; - } - } else { - i = (0x000fffff)>>j0; - if(((i0&i)|i1)==0) return x; /* x is integral */ - if(huge+x>0.0) { /* raise inexact flag */ - i0 &= (~i); i1=0; - } - } - } else if (j0>51) { - if(j0==0x400) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } else { - i = ((uint32_t)(0xffffffff))>>(j0-20); - if((i1&i)==0) return x; /* x is integral */ - if(huge+x>0.0) /* raise inexact flag */ - i1 &= (~i); - } - INSERT_WORDS(x,i0,i1); - return x; -} diff --git a/src/math/s_truncf.c b/src/math/s_truncf.c deleted file mode 100644 index c253e62b..00000000 --- a/src/math/s_truncf.c +++ /dev/null @@ -1,50 +0,0 @@ -/* @(#)s_floor.c 5.1 93/09/24 */ -/* - * ==================================================== - * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. - * - * Developed at SunPro, a Sun Microsystems, Inc. business. - * Permission to use, copy, modify, and distribute this - * software is freely granted, provided that this notice - * is preserved. - * ==================================================== - */ - -/* - * truncf(x) - * Return x rounded toward 0 to integral value - * Method: - * Bit twiddling. - * Exception: - * Inexact flag raised if x not equal to truncf(x). - */ - -#include <math.h> -#include "math_private.h" - -static const float huge = 1.0e30F; - -float -truncf(float x) -{ - int32_t i0,j0; - uint32_t i; - GET_FLOAT_WORD(i0,x); - j0 = ((i0>>23)&0xff)-0x7f; - if(j0<23) { - if(j0<0) { /* raise inexact if x != 0 */ - if(huge+x>0.0F) /* |x|<1, so return 0*sign(x) */ - i0 &= 0x80000000; - } else { - i = (0x007fffff)>>j0; - if((i0&i)==0) return x; /* x is integral */ - if(huge+x>0.0F) /* raise inexact flag */ - i0 &= (~i); - } - } else { - if(j0==0x80) return x+x; /* inf or NaN */ - else return x; /* x is integral */ - } - SET_FLOAT_WORD(x,i0); - return x; -} diff --git a/src/math/scalb.c b/src/math/scalb.c new file mode 100644 index 00000000..7706e9cb --- /dev/null +++ b/src/math/scalb.c @@ -0,0 +1,34 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_scalb.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * scalb(x, fn) is provide for + * passing various standard test suite. One + * should use scalbn() instead. + */ + +#include "libm.h" + +double scalb(double x, double fn) +{ + if (isnan(x) || isnan(fn)) + return x*fn; + if (!isfinite(fn)) { + if (fn > 0.0) + return x*fn; + else + return x/(-fn); + } + if (rint(fn) != fn) return (fn-fn)/(fn-fn); + if ( fn > 65000.0) return scalbn(x, 65000); + if (-fn > 65000.0) return scalbn(x,-65000); + return scalbn(x,(int)fn); +} diff --git a/src/math/s_copysignf.c b/src/math/scalbf.c index d650e8e5..0cc091f1 100644 --- a/src/math/s_copysignf.c +++ b/src/math/scalbf.c @@ -1,7 +1,7 @@ -/* s_copysignf.c -- float version of s_copysign.c. +/* origin: FreeBSD /usr/src/lib/msun/src/e_scalbf.c */ +/* * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. */ - /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -13,21 +13,19 @@ * ==================================================== */ -/* - * copysignf(float x, float y) - * copysignf(x,y) returns a value with the magnitude of x and - * with the sign bit of y. - */ - -#include <math.h> -#include "math_private.h" +#include "libm.h" -float -copysignf(float x, float y) +float scalbf(float x, float fn) { - uint32_t ix,iy; - GET_FLOAT_WORD(ix,x); - GET_FLOAT_WORD(iy,y); - SET_FLOAT_WORD(x,(ix&0x7fffffff)|(iy&0x80000000)); - return x; + 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/scalbln.c b/src/math/scalbln.c new file mode 100644 index 00000000..53854fda --- /dev/null +++ b/src/math/scalbln.c @@ -0,0 +1,11 @@ +#include <limits.h> +#include "libm.h" + +double scalbln(double x, long n) +{ + if (n > INT_MAX) + n = INT_MAX; + else if (n < INT_MIN) + n = INT_MIN; + return scalbn(x, n); +} diff --git a/src/math/scalblnf.c b/src/math/scalblnf.c new file mode 100644 index 00000000..61600f18 --- /dev/null +++ b/src/math/scalblnf.c @@ -0,0 +1,11 @@ +#include <limits.h> +#include "libm.h" + +float scalblnf(float x, long n) +{ + if (n > INT_MAX) + n = INT_MAX; + else if (n < INT_MIN) + n = INT_MIN; + return scalbnf(x, n); +} diff --git a/src/math/scalblnl.c b/src/math/scalblnl.c new file mode 100644 index 00000000..82ebbed0 --- /dev/null +++ b/src/math/scalblnl.c @@ -0,0 +1,18 @@ +#include <limits.h> +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double scalblnl(long double x, long n) +{ + return scalbln(x, n); +} +#else +long double scalblnl(long double x, long n) +{ + if (n > INT_MAX) + n = INT_MAX; + else if (n < INT_MIN) + n = INT_MIN; + return scalbnl(x, n); +} +#endif diff --git a/src/math/scalbn.c b/src/math/scalbn.c new file mode 100644 index 00000000..b51551b5 --- /dev/null +++ b/src/math/scalbn.c @@ -0,0 +1,62 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_scalbn.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * scalbn (double x, int n) + * scalbn(x,n) returns x* 2**n computed by exponent + * manipulation rather than by actually performing an + * exponentiation or a multiplication. + */ + +#include "libm.h" + +static const double +two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ +twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */ +huge = 1.0e+300, +tiny = 1.0e-300; + +double scalbn(double x, int n) +{ +// FIXME: k+n check depends on signed int overflow.. use unsigned hx +// TODO: when long != int: +// scalbln(x,long n) { if(n>9999)n=9999; else if(n<-9999)n=-9999; return scalbn(x,n); } +// TODO: n < -50000 ... + int32_t k,hx,lx; + + EXTRACT_WORDS(hx, lx, x); + k = (hx&0x7ff00000)>>20; /* extract exponent */ + if (k == 0) { /* 0 or subnormal x */ + if ((lx|(hx&0x7fffffff)) == 0) /* +-0 */ + return x; + x *= two54; + GET_HIGH_WORD(hx, x); + k = ((hx&0x7ff00000)>>20) - 54; + if (n < -50000) + return tiny*x; /*underflow*/ + } + if (k == 0x7ff) /* NaN or Inf */ + return x + x; + k = k + n; + if (k > 0x7fe) + return huge*copysign(huge, x); /* overflow */ + if (k > 0) { /* normal result */ + SET_HIGH_WORD(x, (hx&0x800fffff)|(k<<20)); + return x; + } + if (k <= -54) + if (n > 50000) /* in case integer overflow in n+k */ + return huge*copysign(huge, x); /*overflow*/ + return tiny*copysign(tiny, x); /*underflow*/ + k += 54; /* subnormal result */ + SET_HIGH_WORD(x, (hx&0x800fffff)|(k<<20)); + return x*twom54; +} diff --git a/src/math/scalbnf.c b/src/math/scalbnf.c new file mode 100644 index 00000000..0a6168b0 --- /dev/null +++ b/src/math/scalbnf.c @@ -0,0 +1,54 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_scalbnf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float +two25 = 3.355443200e+07, /* 0x4c000000 */ +twom25 = 2.9802322388e-08, /* 0x33000000 */ +huge = 1.0e+30, +tiny = 1.0e-30; + +float scalbnf(float x, int n) +{ + int32_t k, ix; + GET_FLOAT_WORD(ix, x); + k = (ix&0x7f800000)>>23; /* extract exponent */ + if (k == 0) { /* 0 or subnormal x */ + if ((ix&0x7fffffff) == 0) /* +-0 */ + return x; + x *= two25; + GET_FLOAT_WORD(ix, x); + k = ((ix&0x7f800000)>>23) - 25; + if (n < -50000) + return tiny*x; /*underflow*/ + } + if (k == 0xff) /* NaN or Inf */ + return x + x; + k = k + n; + if (k > 0xfe) + return huge*copysignf(huge, x); /* overflow */ + if (k > 0) { /* normal result */ + SET_FLOAT_WORD(x, (ix&0x807fffff)|(k<<23)); + return x; + } + if (k <= -25) + if (n > 50000) /* in case integer overflow in n+k */ + return huge*copysignf(huge,x); /*overflow*/ + return tiny*copysignf(tiny, x); /*underflow*/ + k += 25; /* subnormal result */ + SET_FLOAT_WORD(x, (ix&0x807fffff)|(k<<23)); + return x*twom25; +} diff --git a/src/math/scalbnl.c b/src/math/scalbnl.c new file mode 100644 index 00000000..0ed5b7fd --- /dev/null +++ b/src/math/scalbnl.c @@ -0,0 +1,63 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_scalbnl.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * scalbnl (long double x, int n) + * scalbnl(x,n) returns x* 2**n computed by exponent + * manipulation rather than by actually performing an + * exponentiation or a multiplication. + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double scalbnl(long double x, int n) +{ + return scalbn(x, n); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +static const long double +huge = 0x1p16000L, +tiny = 0x1p-16000L; + +long double scalbnl(long double x, int n) +{ + union IEEEl2bits u; + int k; + + u.e = x; + k = u.bits.exp; /* extract exponent */ + if (k == 0) { /* 0 or subnormal x */ + if ((u.bits.manh|u.bits.manl) == 0) /* +-0 */ + return x; + u.e *= 0x1p128; + k = u.bits.exp - 128; + if (n < -50000) + return tiny*x; /*underflow*/ + } + if (k == 0x7fff) /* NaN or Inf */ + return x + x; + k = k + n; + if (k >= 0x7fff) + return huge*copysignl(huge, x); /* overflow */ + if (k > 0) { /* normal result */ + u.bits.exp = k; + return u.e; + } + if (k <= -128) + if (n > 50000) /* in case integer overflow in n+k */ + return huge*copysign(huge, x); /*overflow*/ + return tiny*copysign(tiny, x); /*underflow*/ + k += 128; /* subnormal result */ + u.bits.exp = k; + return u.e*0x1p-128; +} +#endif diff --git a/src/math/signgam.c b/src/math/signgam.c new file mode 100644 index 00000000..12cc32d7 --- /dev/null +++ b/src/math/signgam.c @@ -0,0 +1,2 @@ +#include <math.h> +int signgam = 0; diff --git a/src/math/s_sin.c b/src/math/sin.c index 2a2774ed..8e430f85 100644 --- a/src/math/s_sin.c +++ b/src/math/sin.c @@ -1,4 +1,4 @@ -/* @(#)s_sin.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_sin.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,14 +9,13 @@ * is preserved. * ==================================================== */ - /* sin(x) * Return sine function of x. * * kernel function: - * __kernel_sin ... sine function on [-pi/4,pi/4] - * __kernel_cos ... cose function on [-pi/4,pi/4] - * __ieee754_rem_pio2 ... argument reduction routine + * __sin ... sine function on [-pi/4,pi/4] + * __cos ... cose function on [-pi/4,pi/4] + * __rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on @@ -41,34 +40,38 @@ * TRIG(x) returns trig(x) nearly rounded */ -#include <math.h> -#include "math_private.h" +#include "libm.h" -double -sin(double x) +double sin(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); + /* High word of x. */ + GET_HIGH_WORD(ix, x); - /* |x| ~< pi/4 */ - ix &= 0x7fffffff; - if(ix <= 0x3fe921fb) return __kernel_sin(x,z,0); + /* |x| ~< pi/4 */ + ix &= 0x7fffffff; + if (ix <= 0x3fe921fb) { + if (ix < 0x3e500000) { /* |x| < 2**-26 */ + /* raise inexact if x != 0 */ + if ((int)x == 0) + return x; + } + return __sin(x, z, 0); + } - /* sin(Inf or NaN) is NaN */ - else if (ix>=0x7ff00000) return x-x; + /* sin(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_sin(y[0],y[1],1); - case 1: return __kernel_cos(y[0],y[1]); - case 2: return -__kernel_sin(y[0],y[1],1); - default: - return -__kernel_cos(y[0],y[1]); - } - } + /* argument reduction needed */ + n = __rem_pio2(x, y); + switch (n&3) { + case 0: return __sin(y[0], y[1], 1); + case 1: return __cos(y[0], y[1]); + case 2: return -__sin(y[0], y[1], 1); + default: + return -__cos(y[0], y[1]); + } } diff --git a/src/math/sinf.c b/src/math/sinf.c new file mode 100644 index 00000000..dcca67af --- /dev/null +++ b/src/math/sinf.c @@ -0,0 +1,73 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_sinf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + * Optimized by Bruce D. Evans. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +/* Small multiples of pi/2 rounded to double precision. */ +static const double +s1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */ +s2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */ +s3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */ +s4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */ + +float sinf(float x) +{ + double y; + int32_t n, hx, ix; + + GET_FLOAT_WORD(hx, x); + ix = hx & 0x7fffffff; + + if (ix <= 0x3f490fda) { /* |x| ~<= pi/4 */ + if (ix < 0x39800000) /* |x| < 2**-12 */ + /* raise inexact if x != 0 */ + if((int)x == 0) + return x; + return __sindf(x); + } + if (ix <= 0x407b53d1) { /* |x| ~<= 5*pi/4 */ + if (ix <= 0x4016cbe3) { /* |x| ~<= 3pi/4 */ + if (hx > 0) + return __cosdf(x - s1pio2); + else + return -__cosdf(x + s1pio2); + } + return __sindf(hx > 0 ? s2pio2 - x : -s2pio2 - x); + } + if (ix <= 0x40e231d5) { /* |x| ~<= 9*pi/4 */ + if (ix <= 0x40afeddf) { /* |x| ~<= 7*pi/4 */ + if (hx > 0) + return -__cosdf(x - s3pio2); + else + return __cosdf(x + s3pio2); + } + return __sindf(hx > 0 ? x - s4pio2 : x + s4pio2); + } + + /* sin(Inf or NaN) is NaN */ + if (ix >= 0x7f800000) + return x - x; + + /* general argument reduction needed */ + n = __rem_pio2f(x, &y); + switch (n&3) { + case 0: return __sindf(y); + case 1: return __cosdf(y); + case 2: return __sindf(-y); + default: + return -__cosdf(y); + } +} diff --git a/src/math/sinh.c b/src/math/sinh.c new file mode 100644 index 00000000..935879c5 --- /dev/null +++ b/src/math/sinh.c @@ -0,0 +1,71 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_sinh.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* sinh(x) + * Method : + * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 + * 1. Replace x by |x| (sinh(-x) = -sinh(x)). + * 2. + * E + E/(E+1) + * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x) + * 2 + * + * 22 <= x <= lnovft : sinh(x) := exp(x)/2 + * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2) + * ln2ovft < x : sinh(x) := x*shuge (overflow) + * + * Special cases: + * sinh(x) is |x| if x is +INF, -INF, or NaN. + * only sinh(0)=0 is exact for finite x. + */ + +#include "libm.h" + +static const double one = 1.0, huge = 1.0e307; + +double sinh(double x) +{ + double t, h; + int32_t ix, jx; + + /* High word of |x|. */ + GET_HIGH_WORD(jx, x); + ix = jx & 0x7fffffff; + + /* x is INF or NaN */ + if (ix >= 0x7ff00000) + return x + x; + + h = 0.5; + if (jx < 0) h = -h; + /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */ + if (ix < 0x40360000) { /* |x|<22 */ + if (ix < 0x3e300000) /* |x|<2**-28 */ + /* raise inexact, return x */ + if (huge+x > one) + return x; + t = expm1(fabs(x)); + if (ix < 0x3ff00000) + return h*(2.0*t - t*t/(t+one)); + return h*(t + t/(t+one)); + } + + /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */ + if (ix < 0x40862E42) + return h*exp(fabs(x)); + + /* |x| in [log(maxdouble), overflowthresold] */ + if (ix <= 0x408633CE) + return h * 2.0 * __expo2(fabs(x)); /* h is for sign only */ + + /* |x| > overflowthresold, sinh(x) overflow */ + return x*huge; +} diff --git a/src/math/sinhf.c b/src/math/sinhf.c new file mode 100644 index 00000000..056b5f86 --- /dev/null +++ b/src/math/sinhf.c @@ -0,0 +1,57 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_sinhf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float one = 1.0, huge = 1.0e37; + +float sinhf(float x) +{ + float t, h; + int32_t ix, jx; + + GET_FLOAT_WORD(jx, x); + ix = jx & 0x7fffffff; + + /* x is INF or NaN */ + if (ix >= 0x7f800000) + return x + x; + + h = 0.5; + if (jx < 0) + h = -h; + /* |x| in [0,9], return sign(x)*0.5*(E+E/(E+1))) */ + if (ix < 0x41100000) { /* |x|<9 */ + if (ix < 0x39800000) /* |x|<2**-12 */ + /* raise inexact, return x */ + if (huge+x > one) + return x; + t = expm1f(fabsf(x)); + if (ix < 0x3f800000) + return h*((float)2.0*t - t*t/(t+one)); + return h*(t + t/(t+one)); + } + + /* |x| in [9, logf(maxfloat)] return 0.5*exp(|x|) */ + if (ix < 0x42b17217) + return h*expf(fabsf(x)); + + /* |x| in [logf(maxfloat), overflowthresold] */ + if (ix <= 0x42b2d4fc) + return h * 2.0f * __expo2f(fabsf(x)); /* h is for sign only */ + + /* |x| > overflowthresold, sinh(x) overflow */ + return x*huge; +} diff --git a/src/math/sinhl.c b/src/math/sinhl.c new file mode 100644 index 00000000..2252dec9 --- /dev/null +++ b/src/math/sinhl.c @@ -0,0 +1,81 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_sinhl.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* sinhl(x) + * Method : + * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2 + * 1. Replace x by |x| (sinhl(-x) = -sinhl(x)). + * 2. + * E + E/(E+1) + * 0 <= x <= 25 : sinhl(x) := --------------, E=expm1l(x) + * 2 + * + * 25 <= x <= lnovft : sinhl(x) := expl(x)/2 + * lnovft <= x <= ln2ovft: sinhl(x) := expl(x/2)/2 * expl(x/2) + * ln2ovft < x : sinhl(x) := x*huge (overflow) + * + * Special cases: + * sinhl(x) is |x| if x is +INF, -INF, or NaN. + * only sinhl(0)=0 is exact for finite x. + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double sinhl(long double x) +{ + return sinh(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +static const long double one = 1.0, huge = 1.0e4931L; + +long double sinhl(long double x) +{ + long double t,w,h; + uint32_t jx,ix,i0,i1; + + /* Words of |x|. */ + GET_LDOUBLE_WORDS(jx, i0, i1, x); + ix = jx & 0x7fff; + + /* x is INF or NaN */ + if (ix == 0x7fff) return x + x; + + h = 0.5; + if (jx & 0x8000) + h = -h; + /* |x| in [0,25], return sign(x)*0.5*(E+E/(E+1))) */ + if (ix < 0x4003 || (ix == 0x4003 && i0 <= 0xc8000000)) { /* |x| < 25 */ + if (ix < 0x3fdf) /* |x|<2**-32 */ + if (huge + x > one) + return x;/* sinh(tiny) = tiny with inexact */ + t = expm1l(fabsl(x)); + if (ix < 0x3fff) + return h*(2.0*t - t*t/(t + one)); + return h*(t + t/(t + one)); + } + + /* |x| in [25, log(maxdouble)] return 0.5*exp(|x|) */ + if (ix < 0x400c || (ix == 0x400c && i0 < 0xb17217f7)) + return h*expl(fabsl(x)); + + /* |x| in [log(maxdouble), overflowthreshold] */ + if (ix < 0x400c || (ix == 0x400c && (i0 < 0xb174ddc0 || + (i0 == 0xb174ddc0 && i1 <= 0x31aec0ea)))) { + w = expl(0.5*fabsl(x)); + t = h*w; + return t*w; + } + + /* |x| > overflowthreshold, sinhl(x) overflow */ + return x*huge; +} +#endif diff --git a/src/math/sinl.c b/src/math/sinl.c new file mode 100644 index 00000000..0b1aeb75 --- /dev/null +++ b/src/math/sinl.c @@ -0,0 +1,84 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_sinl.c */ +/*- + * Copyright (c) 2007 Steven G. Kargl + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice unmodified, this list of conditions, and the following + * disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double sinl(long double x) +{ + return sin(x); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +#include "__rem_pio2l.h" + +long double sinl(long double x) +{ + union IEEEl2bits z; + int e0, s; + long double y[2]; + long double hi, lo; + + z.e = x; + s = z.bits.sign; + z.bits.sign = 0; + + /* If x = +-0 or x is a subnormal number, then sin(x) = x */ + if (z.bits.exp == 0) + return x; + + /* If x = NaN or Inf, then sin(x) = NaN. */ + if (z.bits.exp == 32767) + return (x - x) / (x - x); + + /* Optimize the case where x is already within range. */ + if (z.e < M_PI_4) { + hi = __sinl(z.e, 0, 0); + return s ? -hi : hi; + } + + e0 = __rem_pio2l(x, y); + hi = y[0]; + lo = y[1]; + + switch (e0 & 3) { + case 0: + hi = __sinl(hi, lo, 1); + break; + case 1: + hi = __cosl(hi, lo); + break; + case 2: + hi = - __sinl(hi, lo, 1); + break; + case 3: + hi = - __cosl(hi, lo); + break; + } + return hi; +} +#endif diff --git a/src/math/sqrt.c b/src/math/sqrt.c new file mode 100644 index 00000000..2ebd022b --- /dev/null +++ b/src/math/sqrt.c @@ -0,0 +1,185 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_sqrt.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunSoft, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* sqrt(x) + * Return correctly rounded sqrt. + * ------------------------------------------ + * | Use the hardware sqrt if you have one | + * ------------------------------------------ + * Method: + * Bit by bit method using integer arithmetic. (Slow, but portable) + * 1. Normalization + * Scale x to y in [1,4) with even powers of 2: + * find an integer k such that 1 <= (y=x*2^(2k)) < 4, then + * sqrt(x) = 2^k * sqrt(y) + * 2. Bit by bit computation + * Let q = sqrt(y) truncated to i bit after binary point (q = 1), + * i 0 + * i+1 2 + * s = 2*q , and y = 2 * ( y - q ). (1) + * i i i i + * + * To compute q from q , one checks whether + * i+1 i + * + * -(i+1) 2 + * (q + 2 ) <= y. (2) + * i + * -(i+1) + * If (2) is false, then q = q ; otherwise q = q + 2 . + * i+1 i i+1 i + * + * With some algebric manipulation, it is not difficult to see + * that (2) is equivalent to + * -(i+1) + * s + 2 <= y (3) + * i i + * + * The advantage of (3) is that s and y can be computed by + * i i + * the following recurrence formula: + * if (3) is false + * + * s = s , y = y ; (4) + * i+1 i i+1 i + * + * otherwise, + * -i -(i+1) + * s = s + 2 , y = y - s - 2 (5) + * i+1 i i+1 i i + * + * One may easily use induction to prove (4) and (5). + * Note. Since the left hand side of (3) contain only i+2 bits, + * it does not necessary to do a full (53-bit) comparison + * in (3). + * 3. Final rounding + * After generating the 53 bits result, we compute one more bit. + * Together with the remainder, we can decide whether the + * result is exact, bigger than 1/2ulp, or less than 1/2ulp + * (it will never equal to 1/2ulp). + * The rounding mode can be detected by checking whether + * huge + tiny is equal to huge, and whether huge - tiny is + * equal to huge for some floating point number "huge" and "tiny". + * + * Special cases: + * sqrt(+-0) = +-0 ... exact + * sqrt(inf) = inf + * sqrt(-ve) = NaN ... with invalid signal + * sqrt(NaN) = NaN ... with invalid signal for signaling NaN + */ + +#include "libm.h" + +static const double one = 1.0, tiny = 1.0e-300; + +double sqrt(double x) +{ + double z; + int32_t sign = (int)0x80000000; + int32_t ix0,s0,q,m,t,i; + uint32_t r,t1,s1,ix1,q1; + + EXTRACT_WORDS(ix0, ix1, x); + + /* take care of Inf and NaN */ + if ((ix0&0x7ff00000) == 0x7ff00000) { + return x*x + x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf, sqrt(-inf)=sNaN */ + } + /* take care of zero */ + if (ix0 <= 0) { + if (((ix0&~sign)|ix1) == 0) + return x; /* sqrt(+-0) = +-0 */ + if (ix0 < 0) + return (x-x)/(x-x); /* sqrt(-ve) = sNaN */ + } + /* normalize x */ + m = ix0>>20; + if (m == 0) { /* subnormal x */ + while (ix0 == 0) { + m -= 21; + ix0 |= (ix1>>11); + ix1 <<= 21; + } + for (i=0; (ix0&0x00100000) == 0; i++) + ix0<<=1; + m -= i - 1; + ix0 |= ix1>>(32-i); + ix1 <<= i; + } + m -= 1023; /* unbias exponent */ + ix0 = (ix0&0x000fffff)|0x00100000; + if (m & 1) { /* odd m, double x to make it even */ + ix0 += ix0 + ((ix1&sign)>>31); + ix1 += ix1; + } + m >>= 1; /* m = [m/2] */ + + /* generate sqrt(x) bit by bit */ + ix0 += ix0 + ((ix1&sign)>>31); + ix1 += ix1; + q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */ + r = 0x00200000; /* r = moving bit from right to left */ + + while (r != 0) { + t = s0 + r; + if (t <= ix0) { + s0 = t + r; + ix0 -= t; + q += r; + } + ix0 += ix0 + ((ix1&sign)>>31); + ix1 += ix1; + r >>= 1; + } + + r = sign; + while (r != 0) { + t1 = s1 + r; + t = s0; + if (t < ix0 || (t == ix0 && t1 <= ix1)) { + s1 = t1 + r; + if ((t1&sign) == sign && (s1&sign) == 0) + s0++; + ix0 -= t; + if (ix1 < t1) + ix0--; + ix1 -= t1; + q1 += r; + } + ix0 += ix0 + ((ix1&sign)>>31); + ix1 += ix1; + r >>= 1; + } + + /* use floating add to find out rounding direction */ + if ((ix0|ix1) != 0) { + z = one - tiny; /* raise inexact flag */ + if (z >= one) { + z = one + tiny; + if (q1 == (uint32_t)0xffffffff) { + q1 = 0; + q++; + } else if (z > one) { + if (q1 == (uint32_t)0xfffffffe) + q++; + q1 += 2; + } else + q1 += q1 & 1; + } + } + ix0 = (q>>1) + 0x3fe00000; + ix1 = q1>>1; + if (q&1) + ix1 |= sign; + ix0 += m << 20; + INSERT_WORDS(z, ix0, ix1); + return z; +} diff --git a/src/math/sqrtf.c b/src/math/sqrtf.c new file mode 100644 index 00000000..35c24e50 --- /dev/null +++ b/src/math/sqrtf.c @@ -0,0 +1,84 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/e_sqrtf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float one = 1.0, tiny = 1.0e-30; + +float sqrtf(float x) +{ + float z; + int32_t sign = (int)0x80000000; + int32_t ix,s,q,m,t,i; + uint32_t r; + + GET_FLOAT_WORD(ix, x); + + /* take care of Inf and NaN */ + if ((ix&0x7f800000) == 0x7f800000) + return x*x + x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf, sqrt(-inf)=sNaN */ + + /* take care of zero */ + if (ix <= 0) { + if ((ix&~sign) == 0) + return x; /* sqrt(+-0) = +-0 */ + if (ix < 0) + return (x-x)/(x-x); /* sqrt(-ve) = sNaN */ + } + /* normalize x */ + m = ix>>23; + if (m == 0) { /* subnormal x */ + for (i = 0; (ix&0x00800000) == 0; i++) + ix<<=1; + m -= i - 1; + } + m -= 127; /* unbias exponent */ + ix = (ix&0x007fffff)|0x00800000; + if (m&1) /* odd m, double x to make it even */ + ix += ix; + m >>= 1; /* m = [m/2] */ + + /* generate sqrt(x) bit by bit */ + ix += ix; + q = s = 0; /* q = sqrt(x) */ + r = 0x01000000; /* r = moving bit from right to left */ + + while (r != 0) { + t = s + r; + if (t <= ix) { + s = t+r; + ix -= t; + q += r; + } + ix += ix; + r >>= 1; + } + + /* use floating add to find out rounding direction */ + if (ix != 0) { + z = one - tiny; /* raise inexact flag */ + if (z >= one) { + z = one + tiny; + if (z > one) + q += 2; + else + q += q & 1; + } + } + ix = (q>>1) + 0x3f000000; + ix += m << 23; + SET_FLOAT_WORD(z, ix); + return z; +} diff --git a/src/math/i386/e_remainderf.s b/src/math/sqrtl.c index e69de29b..e69de29b 100644 --- a/src/math/i386/e_remainderf.s +++ b/src/math/sqrtl.c diff --git a/src/math/s_tan.c b/src/math/tan.c index 3333cb3d..2e1f3c83 100644 --- a/src/math/s_tan.c +++ b/src/math/tan.c @@ -1,4 +1,4 @@ -/* @(#)s_tan.c 5.1 93/09/24 */ +/* origin: FreeBSD /usr/src/lib/msun/src/s_tan.c */ /* * ==================================================== * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. @@ -9,13 +9,12 @@ * is preserved. * ==================================================== */ - /* tan(x) * Return tangent function of x. * * kernel function: - * __kernel_tan ... tangent function on [-pi/4,pi/4] - * __ieee754_rem_pio2 ... argument reduction routine + * __tan ... tangent function on [-pi/4,pi/4] + * __rem_pio2 ... argument reduction routine * * Method. * Let S,C and T denote the sin, cos and tan respectively on @@ -40,29 +39,31 @@ * TRIG(x) returns trig(x) nearly rounded */ -#include <math.h> -#include "math_private.h" +#include "libm.h" -double -tan(double x) +double tan(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); + /* High word of x. */ + GET_HIGH_WORD(ix, x); - /* |x| ~< pi/4 */ - ix &= 0x7fffffff; - if(ix <= 0x3fe921fb) return __kernel_tan(x,z,1); + /* |x| ~< pi/4 */ + ix &= 0x7fffffff; + if (ix <= 0x3fe921fb) { + if (ix < 0x3e400000) /* x < 2**-27 */ + /* raise inexact if x != 0 */ + if ((int)x == 0) + return x; + return __tan(x, z, 1); + } - /* tan(Inf or NaN) is NaN */ - else if (ix>=0x7ff00000) return x-x; /* NaN */ + /* tan(Inf or NaN) is NaN */ + if (ix >= 0x7ff00000) + return x - x; - /* argument reduction needed */ - else { - n = __ieee754_rem_pio2(x,y); - return __kernel_tan(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even - -1 -- n odd */ - } + /* argument reduction needed */ + n = __rem_pio2(x, y); + return __tan(y[0], y[1], 1 - ((n&1)<<1)); /* n even: 1, n odd: -1 */ } diff --git a/src/math/tanf.c b/src/math/tanf.c new file mode 100644 index 00000000..8b0dfb20 --- /dev/null +++ b/src/math/tanf.c @@ -0,0 +1,62 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_tanf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + * Optimized by Bruce D. Evans. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +/* Small multiples of pi/2 rounded to double precision. */ +static const double +t1pio2 = 1*M_PI_2, /* 0x3FF921FB, 0x54442D18 */ +t2pio2 = 2*M_PI_2, /* 0x400921FB, 0x54442D18 */ +t3pio2 = 3*M_PI_2, /* 0x4012D97C, 0x7F3321D2 */ +t4pio2 = 4*M_PI_2; /* 0x401921FB, 0x54442D18 */ + +float tanf(float x) +{ + double y; + int32_t n, hx, ix; + + GET_FLOAT_WORD(hx, x); + ix = hx & 0x7fffffff; + + if (ix <= 0x3f490fda) { /* |x| ~<= pi/4 */ + if (ix < 0x39800000) /* |x| < 2**-12 */ + /* return x and raise inexact if x != 0 */ + if ((int)x == 0) + return x; + return __tandf(x, 1); + } + if (ix <= 0x407b53d1) { /* |x| ~<= 5*pi/4 */ + if (ix <= 0x4016cbe3) /* |x| ~<= 3pi/4 */ + return __tandf((hx > 0 ? x-t1pio2 : x+t1pio2), -1); + else + return __tandf((hx > 0 ? x-t2pio2 : x+t2pio2), 1); + } + if (ix <= 0x40e231d5) { /* |x| ~<= 9*pi/4 */ + if (ix <= 0x40afeddf) /* |x| ~<= 7*pi/4 */ + return __tandf((hx > 0 ? x-t3pio2 : x+t3pio2), -1); + else + return __tandf((hx > 0 ? x-t4pio2 : x+t4pio2), 1); + } + + /* tan(Inf or NaN) is NaN */ + if (ix >= 0x7f800000) + return x - x; + + /* general argument reduction needed */ + n = __rem_pio2f(x, &y); + /* integer parameter: n even: 1; n odd: -1 */ + return __tandf(y, 1-((n&1)<<1)); +} diff --git a/src/math/tanh.c b/src/math/tanh.c new file mode 100644 index 00000000..957c43e9 --- /dev/null +++ b/src/math/tanh.c @@ -0,0 +1,73 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_tanh.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* Tanh(x) + * Return the Hyperbolic Tangent of x + * + * Method : + * x -x + * e - e + * 0. tanh(x) is defined to be ----------- + * x -x + * e + e + * 1. reduce x to non-negative by tanh(-x) = -tanh(x). + * 2. 0 <= x < 2**-28 : tanh(x) := x with inexact if x != 0 + * -t + * 2**-28 <= x < 1 : tanh(x) := -----; t = expm1(-2x) + * t + 2 + * 2 + * 1 <= x < 22 : tanh(x) := 1 - -----; t = expm1(2x) + * t + 2 + * 22 <= x <= INF : tanh(x) := 1. + * + * Special cases: + * tanh(NaN) is NaN; + * only tanh(0)=0 is exact for finite argument. + */ + +#include "libm.h" + +static const double one = 1.0, two = 2.0, tiny = 1.0e-300, huge = 1.0e300; + +double tanh(double x) +{ + double t,z; + int32_t jx,ix; + + GET_HIGH_WORD(jx, x); + ix = jx & 0x7fffffff; + + /* x is INF or NaN */ + if (ix >= 0x7ff00000) { + if (jx >= 0) + return one/x + one; /* tanh(+-inf)=+-1 */ + else + return one/x - one; /* tanh(NaN) = NaN */ + } + + if (ix < 0x40360000) { /* |x| < 22 */ + if (ix < 0x3e300000) { /* |x| < 2**-28 */ + /* tanh(tiny) = tiny with inexact */ + if (huge+x > one) + return x; + } + if (ix >= 0x3ff00000) { /* |x| >= 1 */ + t = expm1(two*fabs(x)); + z = one - two/(t+two); + } else { + t = expm1(-two*fabs(x)); + z= -t/(t+two); + } + } else { /* |x| >= 22, return +-1 */ + z = one - tiny; /* raise inexact */ + } + return jx >= 0 ? z : -z; +} diff --git a/src/math/tanhf.c b/src/math/tanhf.c new file mode 100644 index 00000000..97d0eb53 --- /dev/null +++ b/src/math/tanhf.c @@ -0,0 +1,53 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_tanhf.c */ +/* + * Conversion to float by Ian Lance Taylor, Cygnus Support, ian@cygnus.com. + */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +#include "libm.h" + +static const float one = 1.0, two = 2.0, tiny = 1.0e-30, huge = 1.0e30; + +float tanhf(float x) +{ + float t,z; + int32_t jx,ix; + + GET_FLOAT_WORD(jx, x); + ix = jx & 0x7fffffff; + + /* x is INF or NaN */ + if(ix >= 0x7f800000) { + if (jx >= 0) + return one/x + one; /* tanh(+-inf)=+-1 */ + else + return one/x - one; /* tanh(NaN) = NaN */ + } + + if (ix < 0x41100000) { /* |x| < 9 */ + if (ix < 0x39800000) { /* |x| < 2**-12 */ + /* tanh(tiny) = tiny with inexact */ + if (huge+x > one) + return x; + } + if (ix >= 0x3f800000) { /* |x|>=1 */ + t = expm1f(two*fabsf(x)); + z = one - two/(t+two); + } else { + t = expm1f(-two*fabsf(x)); + z = -t/(t+two); + } + } else { /* |x| >= 9, return +-1 */ + z = one - tiny; /* raise inexact */ + } + return jx >= 0 ? z : -z; +} diff --git a/src/math/tanhl.c b/src/math/tanhl.c new file mode 100644 index 00000000..e62be59b --- /dev/null +++ b/src/math/tanhl.c @@ -0,0 +1,83 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/s_tanhl.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* tanhl(x) + * Return the Hyperbolic Tangent of x + * + * Method : + * x -x + * e - e + * 0. tanhl(x) is defined to be ----------- + * x -x + * e + e + * 1. reduce x to non-negative by tanhl(-x) = -tanhl(x). + * 2. 0 <= x <= 2**-55 : tanhl(x) := x*(one+x) + * -t + * 2**-55 < x <= 1 : tanhl(x) := -----; t = expm1l(-2x) + * t + 2 + * 2 + * 1 <= x <= 23.0 : tanhl(x) := 1- ----- ; t=expm1l(2x) + * t + 2 + * 23.0 < x <= INF : tanhl(x) := 1. + * + * Special cases: + * tanhl(NaN) is NaN; + * only tanhl(0)=0 is exact for finite argument. + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double tanhl(long double x) +{ + return tanh(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +static const long double one=1.0, two=2.0, tiny = 1.0e-4900L; + +long double tanhl(long double x) +{ + long double t,z; + int32_t se; + uint32_t jj0,jj1,ix; + + /* High word of |x|. */ + GET_LDOUBLE_WORDS(se, jj0, jj1, x); + ix = se & 0x7fff; + + /* x is INF or NaN */ + if (ix == 0x7fff) { + /* for NaN it's not important which branch: tanhl(NaN) = NaN */ + if (se & 0x8000) + return one/x-one; /* tanhl(-inf)= -1; */ + return one/x+one; /* tanhl(+inf)= +1 */ + } + + /* |x| < 23 */ + if (ix < 0x4003 || (ix == 0x4003 && jj0 < 0xb8000000u)) { + if ((ix|jj0|jj1) == 0) /* x == +- 0 */ + return x; + if (ix < 0x3fc8) /* |x| < 2**-55 */ + return x*(one+tiny); /* tanh(small) = small */ + if (ix >= 0x3fff) { /* |x| >= 1 */ + t = expm1l(two*fabsl(x)); + z = one - two/(t+two); + } else { + t = expm1l(-two*fabsl(x)); + z = -t/(t+two); + } + /* |x| > 23, return +-1 */ + } else { + z = one - tiny; /* raise inexact flag */ + } + return se & 0x8000 ? -z : z; +} +#endif diff --git a/src/math/tanl.c b/src/math/tanl.c new file mode 100644 index 00000000..462ead91 --- /dev/null +++ b/src/math/tanl.c @@ -0,0 +1,84 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_tanl.c */ +/*- + * Copyright (c) 2007 Steven G. Kargl + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice unmodified, this list of conditions, and the following + * disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ +/* + * Limited testing on pseudorandom numbers drawn within [0:4e8] shows + * an accuracy of <= 1.5 ULP where 247024 values of x out of 40 million + * possibles resulted in tan(x) that exceeded 0.5 ULP (ie., 0.6%). + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double tanl(long double x) +{ + return tan(x); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +#include "__rem_pio2l.h" + +long double tanl(long double x) +{ + union IEEEl2bits z; + int e0, s; + long double y[2]; + long double hi, lo; + + z.e = x; + s = z.bits.sign; + z.bits.sign = 0; + + /* If x = +-0 or x is subnormal, then tan(x) = x. */ + if (z.bits.exp == 0) + return x; + + /* If x = NaN or Inf, then tan(x) = NaN. */ + if (z.bits.exp == 32767) + return (x - x) / (x - x); + + /* Optimize the case where x is already within range. */ + if (z.e < M_PI_4) { + hi = __tanl(z.e, 0, 0); + return s ? -hi : hi; + } + + e0 = __rem_pio2l(x, y); + hi = y[0]; + lo = y[1]; + + switch (e0 & 3) { + case 0: + case 2: + hi = __tanl(hi, lo, 0); + break; + case 1: + case 3: + hi = __tanl(hi, lo, 1); + break; + } + return hi; +} +#endif diff --git a/src/math/tgammal.c b/src/math/tgammal.c new file mode 100644 index 00000000..e5905506 --- /dev/null +++ b/src/math/tgammal.c @@ -0,0 +1,287 @@ +/* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_tgammal.c */ +/* + * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net> + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ +/* + * Gamma function + * + * + * SYNOPSIS: + * + * long double x, y, tgammal(); + * extern int signgam; + * + * y = tgammal( x ); + * + * + * DESCRIPTION: + * + * Returns gamma function of the argument. The result is + * correctly signed, and the sign (+1 or -1) is also + * returned in a global (extern) variable named signgam. + * This variable is also filled in by the logarithmic gamma + * function lgamma(). + * + * Arguments |x| <= 13 are reduced by recurrence and the function + * approximated by a rational function of degree 7/8 in the + * interval (2,3). Large arguments are handled by Stirling's + * formula. Large negative arguments are made positive using + * a reflection formula. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -40,+40 10000 3.6e-19 7.9e-20 + * IEEE -1755,+1755 10000 4.8e-18 6.5e-19 + * + * Accuracy for large arguments is dominated by error in powl(). + * + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double tgammal(long double x) +{ + return tgamma(x); +} +#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 +/* +tgamma(x+2) = tgamma(x+2) P(x)/Q(x) +0 <= x <= 1 +Relative error +n=7, d=8 +Peak error = 1.83e-20 +Relative error spread = 8.4e-23 +*/ +static long double P[8] = { + 4.212760487471622013093E-5L, + 4.542931960608009155600E-4L, + 4.092666828394035500949E-3L, + 2.385363243461108252554E-2L, + 1.113062816019361559013E-1L, + 3.629515436640239168939E-1L, + 8.378004301573126728826E-1L, + 1.000000000000000000009E0L, +}; +static long double Q[9] = { +-1.397148517476170440917E-5L, + 2.346584059160635244282E-4L, +-1.237799246653152231188E-3L, +-7.955933682494738320586E-4L, + 2.773706565840072979165E-2L, +-4.633887671244534213831E-2L, +-2.243510905670329164562E-1L, + 4.150160950588455434583E-1L, + 9.999999999999999999908E-1L, +}; + +/* +static long double P[] = { +-3.01525602666895735709e0L, +-3.25157411956062339893e1L, +-2.92929976820724030353e2L, +-1.70730828800510297666e3L, +-7.96667499622741999770e3L, +-2.59780216007146401957e4L, +-5.99650230220855581642e4L, +-7.15743521530849602425e4L +}; +static long double Q[] = { + 1.00000000000000000000e0L, +-1.67955233807178858919e1L, + 8.85946791747759881659e1L, + 5.69440799097468430177e1L, +-1.98526250512761318471e3L, + 3.31667508019495079814e3L, + 1.60577839621734713377e4L, +-2.97045081369399940529e4L, +-7.15743521530849602412e4L +}; +*/ +#define MAXGAML 1755.455L +/*static const long double LOGPI = 1.14472988584940017414L;*/ + +/* Stirling's formula for the gamma function +tgamma(x) = sqrt(2 pi) x^(x-.5) exp(-x) (1 + 1/x P(1/x)) +z(x) = x +13 <= x <= 1024 +Relative error +n=8, d=0 +Peak error = 9.44e-21 +Relative error spread = 8.8e-4 +*/ +static long double STIR[9] = { + 7.147391378143610789273E-4L, +-2.363848809501759061727E-5L, +-5.950237554056330156018E-4L, + 6.989332260623193171870E-5L, + 7.840334842744753003862E-4L, +-2.294719747873185405699E-4L, +-2.681327161876304418288E-3L, + 3.472222222230075327854E-3L, + 8.333333333333331800504E-2L, +}; + +#define MAXSTIR 1024.0L +static const long double SQTPI = 2.50662827463100050242E0L; + +/* 1/tgamma(x) = z P(z) + * z(x) = 1/x + * 0 < x < 0.03125 + * Peak relative error 4.2e-23 + */ +static long double S[9] = { +-1.193945051381510095614E-3L, + 7.220599478036909672331E-3L, +-9.622023360406271645744E-3L, +-4.219773360705915470089E-2L, + 1.665386113720805206758E-1L, +-4.200263503403344054473E-2L, +-6.558780715202540684668E-1L, + 5.772156649015328608253E-1L, + 1.000000000000000000000E0L, +}; + +/* 1/tgamma(-x) = z P(z) + * z(x) = 1/x + * 0 < x < 0.03125 + * Peak relative error 5.16e-23 + * Relative error spread = 2.5e-24 + */ +static long double SN[9] = { + 1.133374167243894382010E-3L, + 7.220837261893170325704E-3L, + 9.621911155035976733706E-3L, +-4.219773343731191721664E-2L, +-1.665386113944413519335E-1L, +-4.200263503402112910504E-2L, + 6.558780715202536547116E-1L, + 5.772156649015328608727E-1L, +-1.000000000000000000000E0L, +}; + +static const long double PIL = 3.1415926535897932384626L; + +/* Gamma function computed by Stirling's formula. + */ +static long double stirf(long double x) +{ + long double y, w, v; + + w = 1.0L/x; + /* For large x, use rational coefficients from the analytical expansion. */ + if (x > 1024.0L) + w = (((((6.97281375836585777429E-5L * w + + 7.84039221720066627474E-4L) * w + - 2.29472093621399176955E-4L) * w + - 2.68132716049382716049E-3L) * w + + 3.47222222222222222222E-3L) * w + + 8.33333333333333333333E-2L) * w + + 1.0L; + else + w = 1.0L + w * __polevll(w, STIR, 8); + y = expl(x); + if (x > MAXSTIR) { /* Avoid overflow in pow() */ + v = powl(x, 0.5L * x - 0.25L); + y = v * (v / y); + } else { + y = powl(x, x - 0.5L) / y; + } + y = SQTPI * y * w; + return y; +} + +long double tgammal(long double x) +{ + long double p, q, z; + int i; + + signgam = 1; + if (isnan(x)) + return NAN; + if (x == INFINITY) + return INFINITY; + if (x == -INFINITY) + return x - x; + q = fabsl(x); + if (q > 13.0L) { + if (q > MAXGAML) + goto goverf; + if (x < 0.0L) { + p = floorl(q); + if (p == q) + return (x - x) / (x - x); + i = p; + if ((i & 1) == 0) + signgam = -1; + z = q - p; + if (z > 0.5L) { + p += 1.0L; + z = q - p; + } + z = q * sinl(PIL * z); + z = fabsl(z) * stirf(q); + if (z <= PIL/LDBL_MAX) { +goverf: + return signgam * INFINITY; + } + z = PIL/z; + } else { + z = stirf(x); + } + return signgam * z; + } + + z = 1.0L; + while (x >= 3.0L) { + x -= 1.0L; + z *= x; + } + while (x < -0.03125L) { + z /= x; + x += 1.0L; + } + if (x <= 0.03125L) + goto small; + while (x < 2.0L) { + z /= x; + x += 1.0L; + } + if (x == 2.0L) + return z; + + x -= 2.0L; + p = __polevll(x, P, 7); + q = __polevll(x, Q, 8); + z = z * p / q; + if(z < 0) + signgam = -1; + return z; + +small: + if (x == 0.0L) + return (x - x) / (x - x); + if (x < 0.0L) { + x = -x; + q = z / (x * __polevll(x, SN, 8)); + signgam = -1; + } else + q = z / (x * __polevll(x, S, 8)); + return q; +} +#endif diff --git a/src/math/trunc.c b/src/math/trunc.c new file mode 100644 index 00000000..44b04ecc --- /dev/null +++ b/src/math/trunc.c @@ -0,0 +1,63 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_trunc.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * trunc(x) + * Return x rounded toward 0 to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to trunc(x). + */ + +#include "libm.h" + +static const double huge = 1.0e300; + +double trunc(double x) +{ + int32_t i0,i1,j0; + uint32_t i; + + EXTRACT_WORDS(i0, i1, x); + j0 = ((i0>>20)&0x7ff) - 0x3ff; + if (j0 < 20) { + if (j0 < 0) { /* |x|<1, return 0*sign(x) */ + /* raise inexact if x != 0 */ + if (huge+x > 0.0) { + i0 &= 0x80000000U; + i1 = 0; + } + } else { + i = 0x000fffff>>j0; + if (((i0&i)|i1) == 0) + return x; /* x is integral */ + /* raise inexact */ + if (huge+x > 0.0) { + i0 &= ~i; + i1 = 0; + } + } + } else if (j0 > 51) { + if (j0 == 0x400) + return x + x; /* inf or NaN */ + return x; /* x is integral */ + } else { + i = (uint32_t)0xffffffff>>(j0-20); + if ((i1&i) == 0) + return x; /* x is integral */ + /* raise inexact */ + if (huge+x > 0.0) + i1 &= ~i; + } + INSERT_WORDS(x, i0, i1); + return x; +} diff --git a/src/math/truncf.c b/src/math/truncf.c new file mode 100644 index 00000000..209586e1 --- /dev/null +++ b/src/math/truncf.c @@ -0,0 +1,52 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_truncf.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * truncf(x) + * Return x rounded toward 0 to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to truncf(x). + */ + +#include "libm.h" + +static const float huge = 1.0e30F; + +float truncf(float x) +{ + int32_t i0,j0; + uint32_t i; + + GET_FLOAT_WORD(i0, x); + j0 = ((i0>>23)&0xff) - 0x7f; + if (j0 < 23) { + if (j0 < 0) { /* |x|<1, return 0*sign(x) */ + /* raise inexact if x != 0 */ + if (huge+x > 0.0F) + i0 &= 0x80000000; + } else { + i = 0x007fffff>>j0; + if ((i0&i) == 0) + return x; /* x is integral */ + /* raise inexact */ + if (huge+x > 0.0F) + i0 &= ~i; + } + } else { + if (j0 == 0x80) + return x + x; /* inf or NaN */ + return x; /* x is integral */ + } + SET_FLOAT_WORD(x, i0); + return x; +} diff --git a/src/math/truncl.c b/src/math/truncl.c new file mode 100644 index 00000000..d817e9ad --- /dev/null +++ b/src/math/truncl.c @@ -0,0 +1,68 @@ +/* origin: FreeBSD /usr/src/lib/msun/src/s_truncl.c */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ +/* + * truncl(x) + * Return x rounded toward 0 to integral value + * Method: + * Bit twiddling. + * Exception: + * Inexact flag raised if x not equal to truncl(x). + */ + +#include "libm.h" + +#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 +long double truncl(long double x) +{ + return trunc(x); +} +#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384 +#ifdef LDBL_IMPLICIT_NBIT +#define MANH_SIZE (LDBL_MANH_SIZE + 1) +#else +#define MANH_SIZE LDBL_MANH_SIZE +#endif + +static const long double huge = 1.0e300; +static const float zero[] = { 0.0, -0.0 }; + +long double truncl(long double x) +{ + union IEEEl2bits u = { .e = x }; + int e = u.bits.exp - LDBL_MAX_EXP + 1; + + if (e < MANH_SIZE - 1) { + if (e < 0) { + /* raise inexact if x != 0 */ + if (huge + x > 0.0) + u.e = zero[u.bits.sign]; + } else { + uint64_t m = ((1llu << MANH_SIZE) - 1) >> (e + 1); + if (((u.bits.manh & m) | u.bits.manl) == 0) + return x; /* x is integral */ + /* raise inexact */ + if (huge + x > 0.0) { + u.bits.manh &= ~m; + u.bits.manl = 0; + } + } + } else if (e < LDBL_MANT_DIG - 1) { + uint64_t m = (uint64_t)-1 >> (64 - LDBL_MANT_DIG + e + 1); + if ((u.bits.manl & m) == 0) + return x; /* x is integral */ + /* raise inexact */ + if (huge + x > 0.0) + u.bits.manl &= ~m; + } + return u.e; +} +#endif diff --git a/src/math/x86_64/e_sqrt.s b/src/math/x86_64/sqrt.s index d3c609f9..d3c609f9 100644 --- a/src/math/x86_64/e_sqrt.s +++ b/src/math/x86_64/sqrt.s diff --git a/src/math/x86_64/e_sqrtf.s b/src/math/x86_64/sqrtf.s index eec48c60..eec48c60 100644 --- a/src/math/x86_64/e_sqrtf.s +++ b/src/math/x86_64/sqrtf.s diff --git a/src/math/x86_64/sqrtl.s b/src/math/x86_64/sqrtl.s new file mode 100644 index 00000000..23cd687d --- /dev/null +++ b/src/math/x86_64/sqrtl.s @@ -0,0 +1,5 @@ +.global sqrtl +.type sqrtl,@function +sqrtl: fldt 8(%rsp) + fsqrt + ret |