mirrors/cosmopolitan
1
0
Fork 0
mirror of https://github.com/jart/cosmopolitan.git synced 2025-03-15 05:16:30 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Remove sun musl fdlibm math library

Browse source 
The libm code from musl wasn't being used since most of these functions
are implemented using x87 which goes faster than a library intended for
risc machines.
This commit is contained in:
Justine Tunney 2021-01-31 18:25:16 -08:00
parent e6481efa80
commit fdc3fa9148
388 changed files with 304 additions and 19472 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile
View file

@ -92,8 +92,7 @@ include libc/stubs/stubs.mk #─┘
include libc/nexgen32e/nexgen32e.mk #─┐
include libc/intrin/intrin.mk # │
include libc/linux/linux.mk # │
include libc/math/math.mk # ├──metal
include libc/tinymath/tinymath.mk # │
include libc/tinymath/tinymath.mk # ├──metal
include third_party/compiler_rt/compiler_rt.mk # │
include libc/bits/bits.mk # │
include libc/str/str.mk # │
@ -160,7 +159,6 @@ include tool/viz/viz.mk
include tool/tool.mk
include test/libc/alg/test.mk
include test/libc/tinymath/test.mk
include test/libc/math/test.mk
include test/libc/intrin/test.mk
include test/libc/mem/test.mk
include test/libc/nexgen32e/test.mk

1
libc/libc.mk
View file

@ -18,7 +18,6 @@ o/$(MODE)/libc: o/$(MODE)/libc/alg \
o/$(MODE)/libc/intrin \
o/$(MODE)/libc/linux \
o/$(MODE)/libc/log \
o/$(MODE)/libc/math \
o/$(MODE)/libc/mem \
o/$(MODE)/libc/nexgen32e \
o/$(MODE)/libc/nt \

71
libc/math/__cos.c
View file

@ -1,71 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/k_cos.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __cos( x, y )
* kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164
* Input x is assumed to be bounded by ~pi/4 in magnitude.
* Input y is the tail of x.
*
* Algorithm
* 1. Since cos(-x) = cos(x), we need only to consider positive x.
* 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0.
* 3. cos(x) is approximated by a polynomial of degree 14 on
* [0,pi/4]
* 4 14
* cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x
* where the remez error is
*
* | 2 4 6 8 10 12 14 | -58
* |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2
* | |
*
* 4 6 8 10 12 14
* 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then
* cos(x) ~ 1 - x*x/2 + r
* since cos(x+y) ~ cos(x) - sin(x)*y
* ~ cos(x) - x*y,
* a correction term is necessary in cos(x) and hence
* cos(x+y) = 1 - (x*x/2 - (r - x*y))
* For better accuracy, rearrange to
* cos(x+y) ~ w + (tmp + (r-x*y))
* where w = 1 - x*x/2 and tmp is a tiny correction term
* (1 - x*x/2 == w + tmp exactly in infinite precision).
* The exactness of w + tmp in infinite precision depends on w
* and tmp having the same precision as x. If they have extra
* precision due to compiler bugs, then the extra precision is
* only good provided it is retained in all terms of the final
* expression for cos(). Retention happens in all cases tested
* under FreeBSD, so don't pessimize things by forcibly clipping
* any extra precision in w.
*/
#include "libc/math/libm.h"
static const double
C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */
C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */
C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */
C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */
C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */
C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */
double __cos(double x, double y)
{
double_t 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 = 1.0-hz;
return w + (((1.0-w)-hz) + (z*r-x*y));
}

35
libc/math/__cosdf.c
View file

@ -1,35 +0,0 @@
/* 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 "libc/math/libm.h"
/* |cos(x) - c(x)| < 2**-34.1 (~[-5.37e-11, 5.295e-11]). */
static const double
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_t r, w, z;
/* Try to optimize for parallel evaluation as in __tandf.c. */
z = x*x;
w = z*z;
r = C2+z*C3;
return ((1.0+z*C0) + w*C1) + (w*z)*r;
}

96
libc/math/__cosl.c
View file

@ -1,96 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/ld80/k_cosl.c */
/* origin: FreeBSD /usr/src/lib/msun/ld128/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 "libc/math/libm.h"
#if (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
#if LDBL_MANT_DIG == 64
/*
* 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 long double
C1 = 0.0416666666666666666136L; /* 0xaaaaaaaaaaaaaa9b.0p-68 */
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 */
#define POLY(z) (z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*(C6+z*C7)))))))
#elif LDBL_MANT_DIG == 113
/*
* ld128 version of __cos.c. See __cos.c for most comments.
*/
/*
* Domain [-0.7854, 0.7854], range ~[-1.80e-37, 1.79e-37]:
* |cos(x) - c(x))| < 2**-122.0
*
* 113-bit precision requires more care than 64-bit precision, since
* simple methods give a minimax polynomial with coefficient for x^2
* that is 1 ulp below 0.5, but we want it to be precisely 0.5. See
* above for more details.
*/
static const long double
C1 = 0.04166666666666666666666666666666658424671L,
C2 = -0.001388888888888888888888888888863490893732L,
C3 = 0.00002480158730158730158730158600795304914210L,
C4 = -0.2755731922398589065255474947078934284324e-6L,
C5 = 0.2087675698786809897659225313136400793948e-8L,
C6 = -0.1147074559772972315817149986812031204775e-10L,
C7 = 0.4779477332386808976875457937252120293400e-13L;
static const double
C8 = -0.1561920696721507929516718307820958119868e-15,
C9 = 0.4110317413744594971475941557607804508039e-18,
C10 = -0.8896592467191938803288521958313920156409e-21,
C11 = 0.1601061435794535138244346256065192782581e-23;
#define POLY(z) (z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*(C6+z*(C7+ \
z*(C8+z*(C9+z*(C10+z*C11)))))))))))
#endif
long double __cosl(long double x, long double y)
{
long double hz,z,r,w;
z = x*x;
r = POLY(z);
hz = 0.5*z;
w = 1.0-hz;
return w + (((1.0-w)-hz) + (z*r-x*y));
}
#endif

16
libc/math/__expo2.c
View file

@ -1,16 +0,0 @@
#include "libc/math/libm.h"
/* k is such that k*ln2 has minimal relative error and x - kln2 > log(DBL_MIN) */
static const int k = 2043;
static const double kln2 = 0x1.62066151add8bp+10;
/* exp(x)/2 for x >= log(DBL_MAX), slightly better than 0.5*exp(x/2)*exp(x/2) */
double __expo2(double x)
{
double scale;
/* note that k is odd and scale*scale overflows */
INSERT_WORDS(scale, (uint32_t)(0x3ff + k/2) << 20, 0);
/* exp(x - k ln2) * 2**(k-1) */
return exp(x - kln2) * scale * scale;
}

16
libc/math/__expo2f.c
View file

@ -1,16 +0,0 @@
#include "libc/math/libm.h"
/* k is such that k*ln2 has minimal relative error and x - kln2 > log(FLT_MIN) */
static const int k = 235;
static const float kln2 = 0x1.45c778p+7f;
/* expf(x)/2 for x >= log(FLT_MAX), slightly better than 0.5f*expf(x/2)*expf(x/2) */
float __expo2f(float x)
{
float scale;
/* note that k is odd and scale*scale overflows */
SET_FLOAT_WORD(scale, (uint32_t)(0x7f + k/2) << 23);
/* exp(x - k ln2) * 2**(k-1) */
return expf(x - kln2) * scale * scale;
}

37
libc/math/__fesetround.S
View file

@ -1,37 +0,0 @@
/*-*- mode:unix-assembly; indent-tabs-mode:t; tab-width:8; coding:utf-8 -*-│
│vi: set et ft=asm ts=8 tw=8 fenc=utf-8 :vi│
╞══════════════════════════════════════════════════════════════════════════════╡
│ Copyright 2020 Justine Alexandra Roberts Tunney │
│ │
│ Permission to use, copy, modify, and/or 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. │
╚─────────────────────────────────────────────────────────────────────────────*/
#include "libc/macros.h"
fesetround:
push %rax
xor %eax,%eax
mov %edi,%ecx
fnstcw (%rsp)
andb $0xf3,1(%rsp)
or %ch,1(%rsp)
fldcw (%rsp)
stmxcsr (%rsp)
shl $3,%ch
andb $0x9f,1(%rsp)
or %ch,1(%rsp)
ldmxcsr (%rsp)
pop %rcx
ret
.endfn fesetround,globl,hidden
.source __FILE__

10
libc/math/__fpclassify.c
View file

@ -1,10 +0,0 @@
#include "libc/math/math.h"
int __fpclassify(double x)
{
union {double f; uint64_t i;} u = {x};
int e = u.i>>52 & 0x7ff;
if (!e) return u.i<<1 ? FP_SUBNORMAL : FP_ZERO;
if (e==0x7ff) return u.i<<12 ? FP_NAN : FP_INFINITE;
return FP_NORMAL;
}

10
libc/math/__fpclassifyf.c
View file

@ -1,10 +0,0 @@
#include "libc/math/math.h"
int __fpclassifyf(float x)
{
union {float f; uint32_t i;} u = {x};
int e = u.i>>23 & 0xff;
if (!e) return u.i<<1 ? FP_SUBNORMAL : FP_ZERO;
if (e==0xff) return u.i<<9 ? FP_NAN : FP_INFINITE;
return FP_NORMAL;
}

42
libc/math/__fpclassifyl.c
View file

@ -1,42 +0,0 @@
#include "libc/math/libm.h"
#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
int __fpclassifyl(long double x)
{
return __fpclassify(x);
}
#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
int __fpclassifyl(long double x)
{
union ldshape u = {x};
int e = u.i.se & 0x7fff;
int msb = u.i.m>>63;
if (!e && !msb)
return u.i.m ? FP_SUBNORMAL : FP_ZERO;
if (e == 0x7fff) {
/* The x86 variant of 80-bit extended precision only admits
* one representation of each infinity, with the mantissa msb
* necessarily set. The version with it clear is invalid/nan.
* The m68k variant, however, allows either, and tooling uses
* the version with it clear. */
if (__BYTE_ORDER == __LITTLE_ENDIAN && !msb)
return FP_NAN;
return u.i.m << 1 ? FP_NAN : FP_INFINITE;
}
if (!msb)
return FP_NAN;
return FP_NORMAL;
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
int __fpclassifyl(long double x)
{
union ldshape u = {x};
int e = u.i.se & 0x7fff;
u.i.se = 0;
if (!e)
return u.i2.lo | u.i2.hi ? FP_SUBNORMAL : FP_ZERO;
if (e == 0x7fff)
return u.i2.lo | u.i2.hi ? FP_NAN : FP_INFINITE;
return FP_NORMAL;
}
#endif

27
libc/math/__invtrigl.c
View file

@ -1,27 +0,0 @@
#include "libc/math/__invtrigl.h"
static 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;
const long double pio2_hi = 1.57079632679489661926L;
const long double pio2_lo = -2.50827880633416601173e-20L;
/* used in asinl() and acosl() */
/* R(x^2) is a rational approximation of (asin(x)-x)/x^3 with Remez algorithm */
long double __invtrigl_R(long double z) {
long double p, q;
p = z * (pS0 +
z * (pS1 + z * (pS2 + z * (pS3 + z * (pS4 + z * (pS5 + z * pS6))))));
q = 1.0 + z * (qS1 + z * (qS2 + z * (qS3 + z * (qS4 + z * qS5))));
return p / q;
}

6
libc/math/__invtrigl.h
View file

@ -1,6 +0,0 @@
/* shared by acosl, asinl and atan2l */
#define pio2_hi __pio2_hi
#define pio2_lo __pio2_lo
extern const long double pio2_hi, pio2_lo;
long double __invtrigl_R(long double z);

6
libc/math/__math_divzero.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
double __math_divzero(uint32_t sign)
{
return fp_barrier(sign ? -1.0 : 1.0) / 0.0;
}

6
libc/math/__math_divzerof.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
float __math_divzerof(uint32_t sign)
{
return fp_barrierf(sign ? -1.0f : 1.0f) / 0.0f;
}

6
libc/math/__math_invalid.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
double __math_invalid(double x)
{
return (x - x) / (x - x);
}

6
libc/math/__math_invalidf.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
float __math_invalidf(float x)
{
return (x - x) / (x - x);
}

6
libc/math/__math_oflow.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
double __math_oflow(uint32_t sign)
{
return __math_xflow(sign, 0x1p769);
}

6
libc/math/__math_oflowf.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
float __math_oflowf(uint32_t sign)
{
return __math_xflowf(sign, 0x1p97f);
}

6
libc/math/__math_uflow.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
double __math_uflow(uint32_t sign)
{
return __math_xflow(sign, 0x1p-767);
}

6
libc/math/__math_uflowf.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
float __math_uflowf(uint32_t sign)
{
return __math_xflowf(sign, 0x1p-95f);
}

6
libc/math/__math_xflow.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
double __math_xflow(uint32_t sign, double y)
{
return eval_as_double(fp_barrier(sign ? -y : y) * y);
}

6
libc/math/__math_xflowf.c
View file

@ -1,6 +0,0 @@
#include "libc/math/libm.h"
float __math_xflowf(uint32_t sign, float y)
{
return eval_as_float(fp_barrierf(sign ? -y : y) * y);
}

93
libc/math/__polevll.c
View file

@ -1,93 +0,0 @@
/* 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 "libc/math/libm.h"
#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
#else
/*
* Polynomial evaluator:
* P[0] x^n + P[1] x^(n-1) + ... + P[n]
*/
long double __polevll(long double x, const 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, const long double *P, int n)
{
long double y;
n -= 1;
y = x + *P++;
do {
y = y * x + *P++;
} while (--n);
return y;
}
#endif

177
libc/math/__rem_pio2.c
View file

@ -1,177 +0,0 @@
/* 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 "libc/math/libm.h"
#if FLT_EVAL_METHOD==0 || FLT_EVAL_METHOD==1
#define EPS DBL_EPSILON
#elif FLT_EVAL_METHOD==2
#define EPS LDBL_EPSILON
#endif
/*
* 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
toint = 1.5/EPS,
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)
{
union {double f; uint64_t i;} u = {x};
double_t z,w,t,r,fn;
double tx[3],ty[2];
uint32_t ix;
int sign, n, ex, ey, i;
sign = u.i>>63;
ix = u.i>>32 & 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 (!sign) {
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 (!sign) {
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 (!sign) {
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 (!sign) {
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 */
medium:
/* rint(x/(pi/2)), Assume round-to-nearest. */
fn = (double_t)x*invpio2 + toint - toint;
n = (int32_t)fn;
r = x - fn*pio2_1;
w = fn*pio2_1t; /* 1st round, good to 85 bits */
y[0] = r - w;
u.f = y[0];
ey = u.i>>52 & 0x7ff;
ex = ix>>20;
if (ex - ey > 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;
u.f = y[0];
ey = u.i>>52 & 0x7ff;
if (ex - ey > 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) */
u.f = x;
u.i &= (uint64_t)-1>>12;
u.i |= (uint64_t)(0x3ff + 23)<<52;
z = u.f;
for (i=0; i < 2; i++) {
tx[i] = (double)(int32_t)z;
z = (z-tx[i])*0x1p24;
}
tx[i] = z;
/* skip zero terms, first term is non-zero */
while (tx[i] == 0.0)
i--;
n = __rem_pio2_large(tx,ty,(int)(ix>>20)-(0x3ff+23),i+1,1);
if (sign) {
y[0] = -ty[0];
y[1] = -ty[1];
return -n;
}
y[0] = ty[0];
y[1] = ty[1];
return n;
}

442
libc/math/__rem_pio2_large.c
View file

@ -1,442 +0,0 @@
/* 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 "libc/math/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 */
};
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 ? 0.0 : (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)(0x1p-24*z);
iq[i] = (int32_t)(z - 0x1p24*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 = 1.0 - z;
if (carry != 0)
z -= scalbn(1.0,q0);
}
}
/* check if recomputation is needed */
if (z == 0.0) {
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 >= 0x1p24) {
fw = (double)(int32_t)(0x1p-24*z);
iq[jz] = (int32_t)(z - 0x1p24*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(1.0,q0);
for (i=jz; i>=0; i--) {
q[i] = fw*(double)iq[i];
fw *= 0x1p-24;
}
/* 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];
// TODO: drop excess precision here once double_t is used
fw = (double)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;
}

75
libc/math/__rem_pio2f.c
View file

@ -1,75 +0,0 @@
/* 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 "libc/math/libm.h"
#if FLT_EVAL_METHOD==0 || FLT_EVAL_METHOD==1
#define EPS DBL_EPSILON
#elif FLT_EVAL_METHOD==2
#define EPS LDBL_EPSILON
#endif
/*
* invpio2: 53 bits of 2/pi
* pio2_1: first 25 bits of pi/2
* pio2_1t: pi/2 - pio2_1
*/
static const double
toint = 1.5/EPS,
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)
{
union {float f; uint32_t i;} u = {x};
double tx[1],ty[1];
double_t fn;
uint32_t ix;
int n, sign, e0;
ix = u.i & 0x7fffffff;
/* 25+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. */
fn = (double_t)x*invpio2 + toint - toint;
n = (int32_t)fn;
*y = x - fn*pio2_1 - fn*pio2_1t;
return n;
}
if(ix>=0x7f800000) { /* x is inf or NaN */
*y = x-x;
return 0;
}
/* scale x into [2^23, 2^24-1] */
sign = u.i>>31;
e0 = (ix>>23) - (0x7f+23); /* e0 = ilogb(|x|)-23, positive */
u.i = ix - (e0<<23);
tx[0] = u.f;
n = __rem_pio2_large(tx,ty,e0,1,0);
if (sign) {
*y = -ty[0];
return -n;
}
*y = ty[0];
return n;
}

141
libc/math/__rem_pio2l.c
View file

@ -1,141 +0,0 @@
/* 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 "libc/math/libm.h"
#if (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
/* ld80 and ld128 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
*/
static const long double toint = 1.5/LDBL_EPSILON;
#if LDBL_MANT_DIG == 64
/* u ~< 0x1p25*pi/2 */
#define SMALL(u) (((u.i.se & 0x7fffU)<<16 | u.i.m>>48) < ((0x3fff + 25)<<16 | 0x921f>>1 | 0x8000))
#define QUOBITS(x) ((uint32_t)(int32_t)x & 0x7fffffff)
#define ROUND1 22
#define ROUND2 61
#define NX 3
#define NY 2
/*
* 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
pio2_1 = 1.57079632679597125389e+00, /* 0x3FF921FB, 0x54444000 */
pio2_2 = -1.07463465549783099519e-12, /* -0x12e7b967674000.0p-92 */
pio2_3 = 6.36831716351370313614e-25; /* 0x18a2e037074000.0p-133 */
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 */
#elif LDBL_MANT_DIG == 113
/* u ~< 0x1p45*pi/2 */
#define SMALL(u) (((u.i.se & 0x7fffU)<<16 | u.i.top) < ((0x3fff + 45)<<16 | 0x921f))
#define QUOBITS(x) ((uint32_t)(int64_t)x & 0x7fffffff)
#define ROUND1 51
#define ROUND2 119
#define NX 5
#define NY 3
static const long double
invpio2 = 6.3661977236758134307553505349005747e-01L, /* 0x145f306dc9c882a53f84eafa3ea6a.0p-113 */
pio2_1 = 1.5707963267948966192292994253909555e+00L, /* 0x1921fb54442d18469800000000000.0p-112 */
pio2_1t = 2.0222662487959507323996846200947577e-21L, /* 0x13198a2e03707344a4093822299f3.0p-181 */
pio2_2 = 2.0222662487959507323994779168837751e-21L, /* 0x13198a2e03707344a400000000000.0p-181 */
pio2_2t = 2.0670321098263988236496903051604844e-43L, /* 0x127044533e63a0105df531d89cd91.0p-254 */
pio2_3 = 2.0670321098263988236499468110329591e-43L, /* 0x127044533e63a0105e00000000000.0p-254 */
pio2_3t = -2.5650587247459238361625433492959285e-65L; /* -0x159c4ec64ddaeb5f78671cbfb2210.0p-327 */
#endif
int __rem_pio2l(long double x, long double *y)
{
union ldshape u,uz;
long double z,w,t,r,fn;
double tx[NX],ty[NY];
int ex,ey,n,i;
u.f = x;
ex = u.i.se & 0x7fff;
if (SMALL(u)) {
/* rint(x/(pi/2)), Assume round-to-nearest. */
fn = x*invpio2 + toint - toint;
n = QUOBITS(fn);
r = x-fn*pio2_1;
w = fn*pio2_1t; /* 1st round good to 102/180 bits (ld80/ld128) */
y[0] = r-w;
u.f = y[0];
ey = u.i.se & 0x7fff;
if (ex - ey > ROUND1) { /* 2nd iteration needed, good to 141/248 (ld80/ld128) */
t = r;
w = fn*pio2_2;
r = t-w;
w = fn*pio2_2t-((t-r)-w);
y[0] = r-w;
u.f = y[0];
ey = u.i.se & 0x7fff;
if (ex - ey > ROUND2) { /* 3rd iteration, good to 180/316 bits */
t = r; /* will cover all possible cases (not verified for ld128) */
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) */
uz.f = x;
uz.i.se = 0x3fff + 23;
z = uz.f;
for (i=0; i < NX - 1; i++) {
tx[i] = (double)(int32_t)z;
z = (z-tx[i])*0x1p24;
}
tx[i] = z;
while (tx[i] == 0)
i--;
n = __rem_pio2_large(tx, ty, ex-0x3fff-23, i+1, NY);
w = ty[1];
if (NY == 3)
w += ty[2];
r = ty[0] + w;
/* TODO: for ld128 this does not follow the recommendation of the
comments of __rem_pio2_large which seem wrong if |ty[0]| > |ty[1]+ty[2]| */
w -= r - ty[0];
if (u.i.se >> 15) {
y[0] = -r;
y[1] = -w;
return -n;
}
y[0] = r;
y[1] = w;
return n;
}
#endif

13
libc/math/__signbit.c
View file

@ -1,13 +0,0 @@
#include "libc/math/libm.h"
// FIXME: macro in math.h
int __signbit(double x)
{
union {
double d;
uint64_t i;
} y = { x };
return y.i>>63;
}

11
libc/math/__signbitf.c
View file

@ -1,11 +0,0 @@
#include "libc/math/libm.h"
// FIXME: macro in math.h
int __signbitf(float x)
{
union {
float f;
uint32_t i;
} y = { x };
return y.i>>31;
}

14
libc/math/__signbitl.c
View file

@ -1,14 +0,0 @@
#include "libc/math/libm.h"
#if (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
int __signbitl(long double x)
{
union ldshape u = {x};
return u.i.se >> 15;
}
#elif LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
int __signbitl(long double x)
{
return __signbit(x);
}
#endif

64
libc/math/__sin.c
View file

@ -1,64 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/k_sin.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __sin( x, y, iy)
* kernel sin function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854
* Input x is assumed to be bounded by ~pi/4 in magnitude.
* Input y is the tail of x.
* Input iy indicates whether y is 0. (if iy=0, y assume to be 0).
*
* Algorithm
* 1. Since sin(-x) = -sin(x), we need only to consider positive x.
* 2. Callers must return sin(-0) = -0 without calling here since our
* odd polynomial is not evaluated in a way that preserves -0.
* Callers may do the optimization sin(x) ~ x for tiny x.
* 3. sin(x) is approximated by a polynomial of degree 13 on
* [0,pi/4]
* 3 13
* sin(x) ~ x + S1*x + ... + S6*x
* where
*
* |sin(x) 2 4 6 8 10 12 | -58
* |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2
* | x |
*
* 4. sin(x+y) = sin(x) + sin'(x')*y
* ~ sin(x) + (1-x*x/2)*y
* For better accuracy, let
* 3 2 2 2 2
* r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6))))
* then 3 2
* sin(x) = x + (S1*x + (x *(r-y/2)+y))
*/
#include "libc/math/libm.h"
static const double
S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */
S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */
S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */
S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */
S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */
S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */
double __sin(double x, double y, int iy)
{
double_t 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*(0.5*y - v*r) - y) - v*S1);
}

36
libc/math/__sindf.c
View file

@ -1,36 +0,0 @@
/* 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 "libc/math/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_t 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;
}

78
libc/math/__sinl.c
View file

@ -1,78 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/ld80/k_sinl.c */
/* origin: FreeBSD /usr/src/lib/msun/ld128/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 "libc/math/libm.h"
#if (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
#if LDBL_MANT_DIG == 64
/*
* 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 long double
S1 = -0.166666666666666666671L; /* -0xaaaaaaaaaaaaaaab.0p-66 */
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 */
#define POLY(z) (S2+z*(S3+z*(S4+z*(S5+z*(S6+z*(S7+z*S8))))))
#elif LDBL_MANT_DIG == 113
/*
* ld128 version of __sin.c. See __sin.c for most comments.
*/
/*
* Domain [-0.7854, 0.7854], range ~[-1.53e-37, 1.659e-37]
* |sin(x)/x - s(x)| < 2**-122.1
*
* See __cosl.c for more details about the polynomial.
*/
static const long double
S1 = -0.16666666666666666666666666666666666606732416116558L,
S2 = 0.0083333333333333333333333333333331135404851288270047L,
S3 = -0.00019841269841269841269841269839935785325638310428717L,
S4 = 0.27557319223985890652557316053039946268333231205686e-5L,
S5 = -0.25052108385441718775048214826384312253862930064745e-7L,
S6 = 0.16059043836821614596571832194524392581082444805729e-9L,
S7 = -0.76471637318198151807063387954939213287488216303768e-12L,
S8 = 0.28114572543451292625024967174638477283187397621303e-14L;
static const double
S9 = -0.82206352458348947812512122163446202498005154296863e-17,
S10 = 0.19572940011906109418080609928334380560135358385256e-19,
S11 = -0.38680813379701966970673724299207480965452616911420e-22,
S12 = 0.64038150078671872796678569586315881020659912139412e-25;
#define POLY(z) (S2+z*(S3+z*(S4+z*(S5+z*(S6+z*(S7+z*(S8+ \
z*(S9+z*(S10+z*(S11+z*S12))))))))))
#endif
long double __sinl(long double x, long double y, int iy)
{
long double z,r,v;
z = x*x;
v = z*x;
r = POLY(z);
if (iy == 0)
return x+v*(S1+z*r);
return x-((z*(0.5*y-v*r)-y)-v*S1);
}
#endif

110
libc/math/__tan.c
View file

@ -1,110 +0,0 @@
/* 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 odd indicates whether tan (if odd = 0) or -1/tan (if odd = 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 "libc/math/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 */
},
pio4 = 7.85398163397448278999e-01, /* 3FE921FB, 54442D18 */
pio4lo = 3.06161699786838301793e-17; /* 3C81A626, 33145C07 */
double __tan(double x, double y, int odd)
{
double_t z, r, v, w, s, a;
double w0, a0;
uint32_t hx;
int big, sign;
GET_HIGH_WORD(hx,x);
big = (hx&0x7fffffff) >= 0x3FE59428; /* |x| >= 0.6744 */
if (big) {
sign = hx>>31;
if (sign) {
x = -x;
y = -y;
}
x = (pio4 - x) + (pio4lo - y);
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) + s*T[0];
w = x + r;
if (big) {
s = 1 - 2*odd;
v = s - 2.0 * (x + (r - w*w/(w + s)));
return sign ? -v : v;
}
if (!odd)
return w;
/* -1.0/(x+r) has up to 2ulp error, so compute it accurately */
w0 = w;
SET_LOW_WORD(w0, 0);
v = r - (w0 - x); /* w0+v = r+x */
a0 = a = -1.0 / w;
SET_LOW_WORD(a0, 0);
return a0 + a*(1.0 + a0*w0 + a0*v);
}

54
libc/math/__tandf.c
View file

@ -1,54 +0,0 @@
/* 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 "libc/math/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 odd)
{
double_t 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);
return odd ? -1.0/r : r;
}

143
libc/math/__tanl.c
View file

@ -1,143 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/ld80/k_tanl.c */
/* origin: FreeBSD /usr/src/lib/msun/ld128/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 "libc/math/libm.h"
#if (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
#if LDBL_MANT_DIG == 64
/*
* 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.
*/
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 */
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 */
#define RPOLY(w) (T5 + w * (T9 + w * (T13 + w * (T17 + w * (T21 + \
w * (T25 + w * (T29 + w * T33)))))))
#define VPOLY(w) (T7 + w * (T11 + w * (T15 + w * (T19 + w * (T23 + \
w * (T27 + w * T31))))))
#elif LDBL_MANT_DIG == 113
/*
* ld128 version of __tan.c. See __tan.c for most comments.
*/
/*
* Domain [-0.67434, 0.67434], range ~[-3.37e-36, 1.982e-37]
* |tan(x)/x - t(x)| < 2**-117.8 (XXX should be ~1e-37)
*
* See __cosl.c for more details about the polynomial.
*/
static const long double
T3 = 0x1.5555555555555555555555555553p-2L,
T5 = 0x1.1111111111111111111111111eb5p-3L,
T7 = 0x1.ba1ba1ba1ba1ba1ba1ba1b694cd6p-5L,
T9 = 0x1.664f4882c10f9f32d6bbe09d8bcdp-6L,
T11 = 0x1.226e355e6c23c8f5b4f5762322eep-7L,
T13 = 0x1.d6d3d0e157ddfb5fed8e84e27b37p-9L,
T15 = 0x1.7da36452b75e2b5fce9ee7c2c92ep-10L,
T17 = 0x1.355824803674477dfcf726649efep-11L,
T19 = 0x1.f57d7734d1656e0aceb716f614c2p-13L,
T21 = 0x1.967e18afcb180ed942dfdc518d6cp-14L,
T23 = 0x1.497d8eea21e95bc7e2aa79b9f2cdp-15L,
T25 = 0x1.0b132d39f055c81be49eff7afd50p-16L,
T27 = 0x1.b0f72d33eff7bfa2fbc1059d90b6p-18L,
T29 = 0x1.5ef2daf21d1113df38d0fbc00267p-19L,
T31 = 0x1.1c77d6eac0234988cdaa04c96626p-20L,
T33 = 0x1.cd2a5a292b180e0bdd701057dfe3p-22L,
T35 = 0x1.75c7357d0298c01a31d0a6f7d518p-23L,
T37 = 0x1.2f3190f4718a9a520f98f50081fcp-24L,
pio4 = 0x1.921fb54442d18469898cc51701b8p-1L,
pio4lo = 0x1.cd129024e088a67cc74020bbea60p-116L;
static const double
T39 = 0.000000028443389121318352, /* 0x1e8a7592977938.0p-78 */
T41 = 0.000000011981013102001973, /* 0x19baa1b1223219.0p-79 */
T43 = 0.0000000038303578044958070, /* 0x107385dfb24529.0p-80 */
T45 = 0.0000000034664378216909893, /* 0x1dc6c702a05262.0p-81 */
T47 = -0.0000000015090641701997785, /* -0x19ecef3569ebb6.0p-82 */
T49 = 0.0000000029449552300483952, /* 0x194c0668da786a.0p-81 */
T51 = -0.0000000022006995706097711, /* -0x12e763b8845268.0p-81 */
T53 = 0.0000000015468200913196612, /* 0x1a92fc98c29554.0p-82 */
T55 = -0.00000000061311613386849674, /* -0x151106cbc779a9.0p-83 */
T57 = 1.4912469681508012e-10; /* 0x147edbdba6f43a.0p-85 */
#define RPOLY(w) (T5 + w * (T9 + w * (T13 + w * (T17 + w * (T21 + \
w * (T25 + w * (T29 + w * (T33 + w * (T37 + w * (T41 + \
w * (T45 + w * (T49 + w * (T53 + w * T57)))))))))))))
#define VPOLY(w) (T7 + w * (T11 + w * (T15 + w * (T19 + w * (T23 + \
w * (T27 + w * (T31 + w * (T35 + w * (T39 + w * (T43 + \
w * (T47 + w * (T51 + w * T55))))))))))))
#endif
long double __tanl(long double x, long double y, int odd) {
long double z, r, v, w, s, a, t;
int big, sign;
big = fabsl(x) >= 0.67434;
if (big) {
sign = 0;
if (x < 0) {
sign = 1;
x = -x;
y = -y;
}
x = (pio4 - x) + (pio4lo - y);
y = 0.0;
}
z = x * x;
w = z * z;
r = RPOLY(w);
v = z * VPOLY(w);
s = z * x;
r = y + z * (s * (r + v) + y) + T3 * s;
w = x + r;
if (big) {
s = 1 - 2*odd;
v = s - 2.0 * (x + (r - w * w / (w + s)));
return sign ? -v : v;
}
if (!odd)
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

101
libc/math/acos.c
View file

@ -1,101 +0,0 @@
/* 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 "libc/math/libm.h"
static const double
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 */
static double R(double z)
{
double_t p, q;
p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
q = 1.0+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
return p/q;
}
double acos(double x)
{
double z,w,s,c,df;
uint32_t hx,ix;
GET_HIGH_WORD(hx, x);
ix = hx & 0x7fffffff;
/* |x| >= 1 or nan */
if (ix >= 0x3ff00000) {
uint32_t lx;
GET_LOW_WORD(lx,x);
if ((ix-0x3ff00000 | lx) == 0) {
/* acos(1)=0, acos(-1)=pi */
if (hx >> 31)
return 2*pio2_hi + 0x1p-120f;
return 0;
}
return 0/(x-x);
}
/* |x| < 0.5 */
if (ix < 0x3fe00000) {
if (ix <= 0x3c600000) /* |x| < 2**-57 */
return pio2_hi + 0x1p-120f;
return pio2_hi - (x - (pio2_lo-x*R(x*x)));
}
/* x < -0.5 */
if (hx >> 31) {
z = (1.0+x)*0.5;
s = sqrt(z);
w = R(z)*s-pio2_lo;
return 2*(pio2_hi - (s+w));
}
/* x > 0.5 */
z = (1.0-x)*0.5;
s = sqrt(z);
df = s;
SET_LOW_WORD(df,0);
c = (z-df*df)/(s+df);
w = R(z)*s+c;
return 2*(df+w);
}

71
libc/math/acosf.c
View file

@ -1,71 +0,0 @@
/* 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 "libc/math/libm.h"
static const float
pio2_hi = 1.5707962513e+00, /* 0x3fc90fda */
pio2_lo = 7.5497894159e-08, /* 0x33a22168 */
pS0 = 1.6666586697e-01,
pS1 = -4.2743422091e-02,
pS2 = -8.6563630030e-03,
qS1 = -7.0662963390e-01;
static float R(float z)
{
float_t p, q;
p = z*(pS0+z*(pS1+z*pS2));
q = 1.0f+z*qS1;
return p/q;
}
float acosf(float x)
{
float z,w,s,c,df;
uint32_t hx,ix;
GET_FLOAT_WORD(hx, x);
ix = hx & 0x7fffffff;
/* |x| >= 1 or nan */
if (ix >= 0x3f800000) {
if (ix == 0x3f800000) {
if (hx >> 31)
return 2*pio2_hi + 0x1p-120f;
return 0;
}
return 0/(x-x);
}
/* |x| < 0.5 */
if (ix < 0x3f000000) {
if (ix <= 0x32800000) /* |x| < 2**-26 */
return pio2_hi + 0x1p-120f;
return pio2_hi - (x - (pio2_lo-x*R(x*x)));
}
/* x < -0.5 */
if (hx >> 31) {
z = (1+x)*0.5f;
s = sqrtf(z);
w = R(z)*s-pio2_lo;
return 2*(pio2_hi - (s+w));
}
/* x > 0.5 */
z = (1-x)*0.5f;
s = sqrtf(z);
GET_FLOAT_WORD(hx,s);
SET_FLOAT_WORD(df,hx&0xfffff000);
c = (z-df*df)/(s+df);
w = R(z)*s+c;
return 2*(df+w);
}

24
libc/math/acosh.c
View file

@ -1,24 +0,0 @@
#include "libc/math/libm.h"
#if FLT_EVAL_METHOD==2
#undef sqrt
#define sqrt sqrtl
#endif
/* acosh(x) = log(x + sqrt(x*x-1)) */
double acosh(double x)
{
union {double f; uint64_t i;} u = {.f = x};
unsigned e = u.i >> 52 & 0x7ff;
/* x < 1 domain error is handled in the called functions */
if (e < 0x3ff + 1)
/* |x| < 2, up to 2ulp error in [1,1.125] */
return log1p(x-1 + sqrt((x-1)*(x-1)+2*(x-1)));
if (e < 0x3ff + 26)
/* |x| < 0x1p26 */
return log(2*x - 1/(x+sqrt(x*x-1)));
/* |x| >= 0x1p26 or nan */
return log(x) + 0.693147180559945309417232121458176568;
}

26
libc/math/acoshf.c
View file

@ -1,26 +0,0 @@
#include "libc/math/libm.h"
#if FLT_EVAL_METHOD==2
#undef sqrtf
#define sqrtf sqrtl
#elif FLT_EVAL_METHOD==1
#undef sqrtf
#define sqrtf sqrt
#endif
/* acosh(x) = log(x + sqrt(x*x-1)) */
float acoshf(float x)
{
union {float f; uint32_t i;} u = {x};
uint32_t a = u.i & 0x7fffffff;
if (a < 0x3f800000+(1<<23))
/* |x| < 2, invalid if x < 1 or nan */
/* up to 2ulp error in [1,1.125] */
return log1pf(x-1 + sqrtf((x-1)*(x-1)+2*(x-1)));
if (a < 0x3f800000+(12<<23))
/* |x| < 0x1p12 */
return logf(2*x - 1/(x+sqrtf(x*x-1)));
/* x >= 0x1p12 */
return logf(x) + 0.693147180559945309417232121458176568f;
}

29
libc/math/acoshl.c
View file

@ -1,29 +0,0 @@
#include "libc/math/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
/* acosh(x) = log(x + sqrt(x*x-1)) */
long double acoshl(long double x)
{
union ldshape u = {x};
int e = u.i.se & 0x7fff;
if (e < 0x3fff + 1)
/* |x| < 2, invalid if x < 1 or nan */
return log1pl(x-1 + sqrtl((x-1)*(x-1)+2*(x-1)));
if (e < 0x3fff + 32)
/* |x| < 0x1p32 */
return logl(2*x - 1/(x+sqrtl(x*x-1)));
return logl(x) + 0.693147180559945309417232121458176568L;
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
// TODO: broken implementation to make things compile
long double acoshl(long double x)
{
return acosh(x);
}
#endif

67
libc/math/acosl.c
View file

@ -1,67 +0,0 @@
/* 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 "libc/math/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 "libc/math/__invtrigl.h"
#if LDBL_MANT_DIG == 64
#define CLEARBOTTOM(u) (u.i.m &= -1ULL << 32)
#elif LDBL_MANT_DIG == 113
#define CLEARBOTTOM(u) (u.i.lo = 0)
#endif
long double acosl(long double x)
{
union ldshape u = {x};
long double z, s, c, f;
uint16_t e = u.i.se & 0x7fff;
/* |x| >= 1 or nan */
if (e >= 0x3fff) {
if (x == 1)
return 0;
if (x == -1)
return 2*pio2_hi + 0x1p-120f;
return 0/(x-x);
}
/* |x| < 0.5 */
if (e < 0x3fff - 1) {
if (e < 0x3fff - LDBL_MANT_DIG - 1)
return pio2_hi + 0x1p-120f;
return pio2_hi - (__invtrigl_R(x*x)*x - pio2_lo + x);
}
/* x < -0.5 */
if (u.i.se >> 15) {
z = (1 + x)*0.5;
s = sqrtl(z);
return 2*(pio2_hi - (__invtrigl_R(z)*s - pio2_lo + s));
}
/* x > 0.5 */
z = (1 - x)*0.5;
s = sqrtl(z);
u.f = s;
CLEARBOTTOM(u);
f = u.f;
c = (z - f*f)/(s + f);
return 2*(__invtrigl_R(z)*s + c + f);
}
#endif

107
libc/math/asin.c
View file

@ -1,107 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/e_asin.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* asin(x)
* Method :
* Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ...
* we approximate asin(x) on [0,0.5] by
* asin(x) = x + x*x^2*R(x^2)
* where
* R(x^2) is a rational approximation of (asin(x)-x)/x^3
* and its remez error is bounded by
* |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75)
*
* For x in [0.5,1]
* asin(x) = pi/2-2*asin(sqrt((1-x)/2))
* Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2;
* then for x>0.98
* asin(x) = pi/2 - 2*(s+s*z*R(z))
* = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo)
* For x<=0.98, let pio4_hi = pio2_hi/2, then
* f = hi part of s;
* c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z)
* and
* asin(x) = pi/2 - 2*(s+s*z*R(z))
* = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo)
* = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c))
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN with invalid signal.
*
*/
#include "libc/math/libm.h"
static const double
pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
/* coefficients for R(x^2) */
pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
static double R(double z)
{
double_t p, q;
p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
q = 1.0+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
return p/q;
}
double asin(double x)
{
double z,r,s;
uint32_t hx,ix;
GET_HIGH_WORD(hx, x);
ix = hx & 0x7fffffff;
/* |x| >= 1 or nan */
if (ix >= 0x3ff00000) {
uint32_t lx;
GET_LOW_WORD(lx, x);
if ((ix-0x3ff00000 | lx) == 0)
/* asin(1) = +-pi/2 with inexact */
return x*pio2_hi + 0x1p-120f;
return 0/(x-x);
}
/* |x| < 0.5 */
if (ix < 0x3fe00000) {
/* if 0x1p-1022 <= |x| < 0x1p-26, avoid raising underflow */
if (ix < 0x3e500000 && ix >= 0x00100000)
return x;
return x + x*R(x*x);
}
/* 1 > |x| >= 0.5 */
z = (1 - fabs(x))*0.5;
s = sqrt(z);
r = R(z);
if (ix >= 0x3fef3333) { /* if |x| > 0.975 */
x = pio2_hi-(2*(s+s*r)-pio2_lo);
} else {
double f,c;
/* f+c = sqrt(z) */
f = s;
SET_LOW_WORD(f,0);
c = (z-f*f)/(s+f);
x = 0.5*pio2_hi - (2*s*r - (pio2_lo-2*c) - (0.5*pio2_hi-2*f));
}
if (hx >> 31)
return -x;
return x;
}

61
libc/math/asinf.c
View file

@ -1,61 +0,0 @@
/* 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 "libc/math/libm.h"
static const double
pio2 = 1.570796326794896558e+00;
static const float
/* coefficients for R(x^2) */
pS0 = 1.6666586697e-01,
pS1 = -4.2743422091e-02,
pS2 = -8.6563630030e-03,
qS1 = -7.0662963390e-01;
static float R(float z)
{
float_t p, q;
p = z*(pS0+z*(pS1+z*pS2));
q = 1.0f+z*qS1;
return p/q;
}
float asinf(float x)
{
double s;
float z;
uint32_t hx,ix;
GET_FLOAT_WORD(hx, x);
ix = hx & 0x7fffffff;
if (ix >= 0x3f800000) { /* |x| >= 1 */
if (ix == 0x3f800000) /* |x| == 1 */
return x*pio2 + 0x1p-120f; /* asin(+-1) = +-pi/2 with inexact */
return 0/(x-x); /* asin(|x|>1) is NaN */
}
if (ix < 0x3f000000) { /* |x| < 0.5 */
/* if 0x1p-126 <= |x| < 0x1p-12, avoid raising underflow */
if (ix < 0x39800000 && ix >= 0x00800000)
return x;
return x + x*R(x*x);
}
/* 1 > |x| >= 0.5 */
z = (1 - fabsf(x))*0.5f;
s = sqrt(z);
x = pio2 - 2*(s+s*R(z));
if (hx >> 31)
return -x;
return x;
}

28
libc/math/asinh.c
View file

@ -1,28 +0,0 @@
#include "libc/math/libm.h"
/* asinh(x) = sign(x)*log(|x|+sqrt(x*x+1)) ~= x - x^3/6 + o(x^5) */
double asinh(double x)
{
union {double f; uint64_t i;} u = {.f = x};
unsigned e = u.i >> 52 & 0x7ff;
unsigned s = u.i >> 63;
/* |x| */
u.i &= (uint64_t)-1/2;
x = u.f;
if (e >= 0x3ff + 26) {
/* |x| >= 0x1p26 or inf or nan */
x = log(x) + 0.693147180559945309417232121458176568;
} else if (e >= 0x3ff + 1) {
/* |x| >= 2 */
x = log(2*x + 1/(sqrt(x*x+1)+x));
} else if (e >= 0x3ff - 26) {
/* |x| >= 0x1p-26, up to 1.6ulp error in [0.125,0.5] */
x = log1p(x + x*x/(sqrt(x*x+1)+1));
} else {
/* |x| < 0x1p-26, raise inexact if x != 0 */
FORCE_EVAL(x + 0x1p120f);
}
return s ? -x : x;
}

28
libc/math/asinhf.c
View file

@ -1,28 +0,0 @@
#include "libc/math/libm.h"
/* asinh(x) = sign(x)*log(|x|+sqrt(x*x+1)) ~= x - x^3/6 + o(x^5) */
float asinhf(float x)
{
union {float f; uint32_t i;} u = {.f = x};
uint32_t i = u.i & 0x7fffffff;
unsigned s = u.i >> 31;
/* |x| */
u.i = i;
x = u.f;
if (i >= 0x3f800000 + (12<<23)) {
/* |x| >= 0x1p12 or inf or nan */
x = logf(x) + 0.693147180559945309417232121458176568f;
} else if (i >= 0x3f800000 + (1<<23)) {
/* |x| >= 2 */
x = logf(2*x + 1/(sqrtf(x*x+1)+x));
} else if (i >= 0x3f800000 - (12<<23)) {
/* |x| >= 0x1p-12, up to 1.6ulp error in [0.125,0.5] */
x = log1pf(x + x*x/(sqrtf(x*x+1)+1));
} else {
/* |x| < 0x1p-12, raise inexact if x!=0 */
FORCE_EVAL(x + 0x1p120f);
}
return s ? -x : x;
}

41
libc/math/asinhl.c
View file

@ -1,41 +0,0 @@
#include "libc/math/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
/* asinh(x) = sign(x)*log(|x|+sqrt(x*x+1)) ~= x - x^3/6 + o(x^5) */
long double asinhl(long double x)
{
union ldshape u = {x};
unsigned e = u.i.se & 0x7fff;
unsigned s = u.i.se >> 15;
/* |x| */
u.i.se = e;
x = u.f;
if (e >= 0x3fff + 32) {
/* |x| >= 0x1p32 or inf or nan */
x = logl(x) + 0.693147180559945309417232121458176568L;
} else if (e >= 0x3fff + 1) {
/* |x| >= 2 */
x = logl(2*x + 1/(sqrtl(x*x+1)+x));
} else if (e >= 0x3fff - 32) {
/* |x| >= 0x1p-32 */
x = log1pl(x + x*x/(sqrtl(x*x+1)+1));
} else {
/* |x| < 0x1p-32, raise inexact if x!=0 */
FORCE_EVAL(x + 0x1p120f);
}
return s ? -x : x;
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
// TODO: broken implementation to make things compile
long double asinhl(long double x)
{
return asinh(x);
}
#endif

71
libc/math/asinl.c
View file

@ -1,71 +0,0 @@
/* 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 "libc/math/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 "libc/math/__invtrigl.h"
#if LDBL_MANT_DIG == 64
#define CLOSETO1(u) (u.i.m>>56 >= 0xf7)
#define CLEARBOTTOM(u) (u.i.m &= -1ULL << 32)
#elif LDBL_MANT_DIG == 113
#define CLOSETO1(u) (u.i.top >= 0xee00)
#define CLEARBOTTOM(u) (u.i.lo = 0)
#endif
long double asinl(long double x)
{
union ldshape u = {x};
long double z, r, s;
uint16_t e = u.i.se & 0x7fff;
int sign = u.i.se >> 15;
if (e >= 0x3fff) { /* |x| >= 1 or nan */
/* asin(+-1)=+-pi/2 with inexact */
if (x == 1 || x == -1)
return x*pio2_hi + 0x1p-120f;
return 0/(x-x);
}
if (e < 0x3fff - 1) { /* |x| < 0.5 */
if (e < 0x3fff - (LDBL_MANT_DIG+1)/2) {
/* return x with inexact if x!=0 */
FORCE_EVAL(x + 0x1p120f);
return x;
}
return x + x*__invtrigl_R(x*x);
}
/* 1 > |x| >= 0.5 */
z = (1.0 - fabsl(x))*0.5;
s = sqrtl(z);
r = __invtrigl_R(z);
if (CLOSETO1(u)) {
x = pio2_hi - (2*(s+s*r)-pio2_lo);
} else {
long double f, c;
u.f = s;
CLEARBOTTOM(u);
f = u.f;
c = (z - f*f)/(s + f);
x = 0.5*pio2_hi-(2*s*r - (pio2_lo-2*c) - (0.5*pio2_hi-2*f));
}
return sign ? -x : x;
}
#endif

116
libc/math/atan.c
View file

@ -1,116 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/s_atan.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunPro, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* atan(x)
* Method
* 1. Reduce x to positive by atan(x) = -atan(-x).
* 2. According to the integer k=4t+0.25 chopped, t=x, the argument
* is further reduced to one of the following intervals and the
* arctangent of t is evaluated by the corresponding formula:
*
* [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
* [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) )
* [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) )
* [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) )
* [39/16,INF] atan(x) = atan(INF) + atan( -1/t )
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "libc/math/libm.h"
static const double atanhi[] = {
4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */
7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */
9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */
1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */
};
static const double atanlo[] = {
2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */
3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */
1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */
6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */
};
static const double aT[] = {
3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */
-1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */
1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */
-1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */
9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */
-7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */
6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */
-5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */
4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */
-3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */
1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */
};
double atan(double x)
{
double_t w,s1,s2,z;
uint32_t ix,sign;
int id;
GET_HIGH_WORD(ix, x);
sign = ix >> 31;
ix &= 0x7fffffff;
if (ix >= 0x44100000) { /* if |x| >= 2^66 */
if (isnan(x))
return x;
z = atanhi[3] + 0x1p-120f;
return sign ? -z : z;
}
if (ix < 0x3fdc0000) { /* |x| < 0.4375 */
if (ix < 0x3e400000) { /* |x| < 2^-27 */
if (ix < 0x00100000)
/* raise underflow for subnormal x */
FORCE_EVAL((float)x);
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-1.0)/(2.0+x);
} else { /* 11/16 <= |x| < 19/16 */
id = 1;
x = (x-1.0)/(x+1.0);
}
} else {
if (ix < 0x40038000) { /* |x| < 2.4375 */
id = 2;
x = (x-1.5)/(1.0+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 sign ? -z : z;
}

107
libc/math/atan2.c
View file

@ -1,107 +0,0 @@
/* 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 "libc/math/libm.h"
static const double
pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */
pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */
double atan2(double y, double x)
{
double z;
uint32_t m,lx,ly,ix,iy;
if (isnan(x) || isnan(y))
return x+y;
EXTRACT_WORDS(ix, lx, x);
EXTRACT_WORDS(iy, ly, y);
if ((ix-0x3ff00000 | lx) == 0) /* x = 1.0 */
return atan(y);
m = ((iy>>31)&1) | ((ix>>30)&2); /* 2*sign(x)+sign(y) */
ix = ix & 0x7fffffff;
iy = iy & 0x7fffffff;
/* when y = 0 */
if ((iy|ly) == 0) {
switch(m) {
case 0:
case 1: return y; /* atan(+-0,+anything)=+-0 */
case 2: return pi; /* atan(+0,-anything) = pi */
case 3: return -pi; /* atan(-0,-anything) =-pi */
}
}
/* when x = 0 */
if ((ix|lx) == 0)
return m&1 ? -pi/2 : pi/2;
/* when x is INF */
if (ix == 0x7ff00000) {
if (iy == 0x7ff00000) {
switch(m) {
case 0: return pi/4; /* atan(+INF,+INF) */
case 1: return -pi/4; /* atan(-INF,+INF) */
case 2: return 3*pi/4; /* atan(+INF,-INF) */
case 3: return -3*pi/4; /* atan(-INF,-INF) */
}
} else {
switch(m) {
case 0: return 0.0; /* atan(+...,+INF) */
case 1: return -0.0; /* atan(-...,+INF) */
case 2: return pi; /* atan(+...,-INF) */
case 3: return -pi; /* atan(-...,-INF) */
}
}
}
/* |y/x| > 0x1p64 */
if (ix+(64<<20) < iy || iy == 0x7ff00000)
return m&1 ? -pi/2 : pi/2;
/* z = atan(|y/x|) without spurious underflow */
if ((m&2) && iy+(64<<20) < ix) /* |y/x| < 0x1p-64, x<0 */
z = 0;
else
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(-,-) */
}
}

83
libc/math/atan2f.c
View file

@ -1,83 +0,0 @@
/* 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 "libc/math/libm.h"
static const float
pi = 3.1415927410e+00, /* 0x40490fdb */
pi_lo = -8.7422776573e-08; /* 0xb3bbbd2e */
float atan2f(float y, float x)
{
float z;
uint32_t m,ix,iy;
if (isnan(x) || isnan(y))
return x+y;
GET_FLOAT_WORD(ix, x);
GET_FLOAT_WORD(iy, y);
if (ix == 0x3f800000) /* x=1.0 */
return atanf(y);
m = ((iy>>31)&1) | ((ix>>30)&2); /* 2*sign(x)+sign(y) */
ix &= 0x7fffffff;
iy &= 0x7fffffff;
/* when y = 0 */
if (iy == 0) {
switch (m) {
case 0:
case 1: return y; /* atan(+-0,+anything)=+-0 */
case 2: return pi; /* atan(+0,-anything) = pi */
case 3: return -pi; /* atan(-0,-anything) =-pi */
}
}
/* when x = 0 */
if (ix == 0)
return m&1 ? -pi/2 : pi/2;
/* when x is INF */
if (ix == 0x7f800000) {
if (iy == 0x7f800000) {
switch (m) {
case 0: return pi/4; /* atan(+INF,+INF) */
case 1: return -pi/4; /* atan(-INF,+INF) */
case 2: return 3*pi/4; /*atan(+INF,-INF)*/
case 3: return -3*pi/4; /*atan(-INF,-INF)*/
}
} else {
switch (m) {
case 0: return 0.0f; /* atan(+...,+INF) */
case 1: return -0.0f; /* atan(-...,+INF) */
case 2: return pi; /* atan(+...,-INF) */
case 3: return -pi; /* atan(-...,-INF) */
}
}
}
/* |y/x| > 0x1p26 */
if (ix+(26<<23) < iy || iy == 0x7f800000)
return m&1 ? -pi/2 : pi/2;
/* z = atan(|y/x|) with correct underflow */
if ((m&2) && iy+(26<<23) < ix) /*|y/x| < 0x1p-26, x < 0 */
z = 0.0;
else
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(-,-) */
}
}

91
libc/math/atan2l.c
View file

@ -1,91 +0,0 @@
/* 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 "libc/math/__invtrigl.h"
#include "libc/math/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
long double atan2l(long double y, long double x) {
union ldshape ux, uy;
long double z;
int m, ex, ey;
if (isnan(x) || isnan(y)) return x + y;
if (x == 1) return atanl(y);
ux.f = x;
uy.f = y;
ex = ux.i.se & 0x7fff;
ey = uy.i.se & 0x7fff;
m = 2 * (ux.i.se >> 15) | uy.i.se >> 15;
if (y == 0) {
switch (m) {
case 0:
case 1:
return y; /* atan(+-0,+anything)=+-0 */
case 2:
return 2 * pio2_hi; /* atan(+0,-anything) = pi */
case 3:
return -2 * pio2_hi; /* atan(-0,-anything) =-pi */
}
}
if (x == 0) return m & 1 ? -pio2_hi : pio2_hi;
if (ex == 0x7fff) {
if (ey == 0x7fff) {
switch (m) {
case 0:
return pio2_hi / 2; /* atan(+INF,+INF) */
case 1:
return -pio2_hi / 2; /* atan(-INF,+INF) */
case 2:
return 1.5 * pio2_hi; /* atan(+INF,-INF) */
case 3:
return -1.5 * pio2_hi; /* atan(-INF,-INF) */
}
} else {
switch (m) {
case 0:
return 0.0; /* atan(+...,+INF) */
case 1:
return -0.0; /* atan(-...,+INF) */
case 2:
return 2 * pio2_hi; /* atan(+...,-INF) */
case 3:
return -2 * pio2_hi; /* atan(-...,-INF) */
}
}
}
if (ex + 120 < ey || ey == 0x7fff) return m & 1 ? -pio2_hi : pio2_hi;
/* z = atan(|y/x|) without spurious underflow */
if ((m & 2) && ey + 120 < ex) /* |y/x| < 0x1p-120, x<0 */
z = 0.0;
else
z = atanl(fabsl(y / x));
switch (m) {
case 0:
return z; /* atan(+,+) */
case 1:
return -z; /* atan(-,+) */
case 2:
return 2 * __pio2_hi - (z - 2 * pio2_lo); /* atan(+,-) */
default: /* case 3 */
return (z - 2 * __pio2_lo) - 2 * pio2_hi; /* atan(-,-) */
}
}
#endif

94
libc/math/atanf.c
View file

@ -1,94 +0,0 @@
/* 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 "libc/math/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,
};
float atanf(float x)
{
float_t w,s1,s2,z;
uint32_t ix,sign;
int id;
GET_FLOAT_WORD(ix, x);
sign = ix>>31;
ix &= 0x7fffffff;
if (ix >= 0x4c800000) { /* if |x| >= 2**26 */
if (isnan(x))
return x;
z = atanhi[3] + 0x1p-120f;
return sign ? -z : z;
}
if (ix < 0x3ee00000) { /* |x| < 0.4375 */
if (ix < 0x39800000) { /* |x| < 2**-12 */
if (ix < 0x00800000)
/* raise underflow for subnormal x */
FORCE_EVAL(x*x);
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 = (2.0f*x - 1.0f)/(2.0f + x);
} else { /* 11/16 <= |x| < 19/16 */
id = 1;
x = (x - 1.0f)/(x + 1.0f);
}
} else {
if (ix < 0x401c0000) { /* |x| < 2.4375 */
id = 2;
x = (x - 1.5f)/(1.0f + 1.5f*x);
} else { /* 2.4375 <= |x| < 2**26 */
id = 3;
x = -1.0f/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 sign ? -z : z;
}

29
libc/math/atanh.c
View file

@ -1,29 +0,0 @@
#include "libc/math/libm.h"
/* atanh(x) = log((1+x)/(1-x))/2 = log1p(2x/(1-x))/2 ~= x + x^3/3 + o(x^5) */
double atanh(double x)
{
union {double f; uint64_t i;} u = {.f = x};
unsigned e = u.i >> 52 & 0x7ff;
unsigned s = u.i >> 63;
double_t y;
/* |x| */
u.i &= (uint64_t)-1/2;
y = u.f;
if (e < 0x3ff - 1) {
if (e < 0x3ff - 32) {
/* handle underflow */
if (e == 0)
FORCE_EVAL((float)y);
} else {
/* |x| < 0.5, up to 1.7ulp error */
y = 0.5*log1p(2*y + 2*y*y/(1-y));
}
} else {
/* avoid overflow */
y = 0.5*log1p(2*(y/(1-y)));
}
return s ? -y : y;
}

28
libc/math/atanhf.c
View file

@ -1,28 +0,0 @@
#include "libc/math/libm.h"
/* atanh(x) = log((1+x)/(1-x))/2 = log1p(2x/(1-x))/2 ~= x + x^3/3 + o(x^5) */
float atanhf(float x)
{
union {float f; uint32_t i;} u = {.f = x};
unsigned s = u.i >> 31;
float_t y;
/* |x| */
u.i &= 0x7fffffff;
y = u.f;
if (u.i < 0x3f800000 - (1<<23)) {
if (u.i < 0x3f800000 - (32<<23)) {
/* handle underflow */
if (u.i < (1<<23))
FORCE_EVAL((float)(y*y));
} else {
/* |x| < 0.5, up to 1.7ulp error */
y = 0.5f*log1pf(2*y + 2*y*y/(1-y));
}
} else {
/* avoid overflow */
y = 0.5f*log1pf(2*(y/(1-y)));
}
return s ? -y : y;
}

35
libc/math/atanhl.c
View file

@ -1,35 +0,0 @@
#include "libc/math/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_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
/* atanh(x) = log((1+x)/(1-x))/2 = log1p(2x/(1-x))/2 ~= x + x^3/3 + o(x^5) */
long double atanhl(long double x)
{
union ldshape u = {x};
unsigned e = u.i.se & 0x7fff;
unsigned s = u.i.se >> 15;
/* |x| */
u.i.se = e;
x = u.f;
if (e < 0x3ff - 1) {
if (e < 0x3ff - LDBL_MANT_DIG/2) {
/* handle underflow */
if (e == 0)
FORCE_EVAL((float)x);
} else {
/* |x| < 0.5, up to 1.7ulp error */
x = 0.5*log1pl(2*x + 2*x*x/(1-x));
}
} else {
/* avoid overflow */
x = 0.5*log1pl(2*(x/(1-x)));
}
return s ? -x : x;
}
#endif

184
libc/math/atanl.c
View file

@ -1,184 +0,0 @@
/* 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 "libc/math/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
#if LDBL_MANT_DIG == 64
#define EXPMAN(u) ((u.i.se & 0x7fff)<<8 | (u.i.m>>55 & 0xff))
static const long double atanhi[] = {
4.63647609000806116202e-01L,
7.85398163397448309628e-01L,
9.82793723247329067960e-01L,
1.57079632679489661926e+00L,
};
static const long double atanlo[] = {
1.18469937025062860669e-20L,
-1.25413940316708300586e-20L,
2.55232234165405176172e-20L,
-2.50827880633416601173e-20L,
};
static 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,
};
static 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 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]))));
}
#elif LDBL_MANT_DIG == 113
#define EXPMAN(u) ((u.i.se & 0x7fff)<<8 | u.i.top>>8)
static const long double atanhi[] = {
4.63647609000806116214256231461214397e-01L,
7.85398163397448309615660845819875699e-01L,
9.82793723247329067985710611014666038e-01L,
1.57079632679489661923132169163975140e+00L,
};
static const long double atanlo[] = {
4.89509642257333492668618435220297706e-36L,
2.16795253253094525619926100651083806e-35L,
-2.31288434538183565909319952098066272e-35L,
4.33590506506189051239852201302167613e-35L,
};
static const long double aT[] = {
3.33333333333333333333333333333333125e-01L,
-1.99999999999999999999999999999180430e-01L,
1.42857142857142857142857142125269827e-01L,
-1.11111111111111111111110834490810169e-01L,
9.09090909090909090908522355708623681e-02L,
-7.69230769230769230696553844935357021e-02L,
6.66666666666666660390096773046256096e-02L,
-5.88235294117646671706582985209643694e-02L,
5.26315789473666478515847092020327506e-02L,
-4.76190476189855517021024424991436144e-02L,
4.34782608678695085948531993458097026e-02L,
-3.99999999632663469330634215991142368e-02L,
3.70370363987423702891250829918659723e-02L,
-3.44827496515048090726669907612335954e-02L,
3.22579620681420149871973710852268528e-02L,
-3.03020767654269261041647570626778067e-02L,
2.85641979882534783223403715930946138e-02L,
-2.69824879726738568189929461383741323e-02L,
2.54194698498808542954187110873675769e-02L,
-2.35083879708189059926183138130183215e-02L,
2.04832358998165364349957325067131428e-02L,
-1.54489555488544397858507248612362957e-02L,
8.64492360989278761493037861575248038e-03L,
-2.58521121597609872727919154569765469e-03L,
};
static 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] + x * (aT[14] + x * (aT[16] +
x * (aT[18] + x * (aT[20] + x * aT[22])))))))))));
}
static 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] + x * (aT[13] + x * (aT[15] + x * (aT[17] +
x * (aT[19] + x * (aT[21] + x * aT[23])))))))))));
}
#endif
long double atanl(long double x)
{
union ldshape u = {x};
long double w, s1, s2, z;
int id;
unsigned e = u.i.se & 0x7fff;
unsigned sign = u.i.se >> 15;
unsigned expman;
if (e >= 0x3fff + LDBL_MANT_DIG + 1) { /* if |x| is large, atan(x)~=pi/2 */
if (isnan(x))
return x;
return sign ? -atanhi[3] : atanhi[3];
}
/* Extract the exponent and the first few bits of the mantissa. */
expman = EXPMAN(u);
if (expman < ((0x3fff - 2) << 8) + 0xc0) { /* |x| < 0.4375 */
if (e < 0x3fff - (LDBL_MANT_DIG+1)/2) { /* if |x| is small, atanl(x)~=x */
/* raise underflow if subnormal */
if (e == 0)
FORCE_EVAL((float)x);
return x;
}
id = -1;
} else {
x = fabsl(x);
if (expman < (0x3fff << 8) + 0x30) { /* |x| < 1.1875 */
if (expman < ((0x3fff - 1) << 8) + 0x60) { /* 7/16 <= |x| < 11/16 */
id = 0;
x = (2.0*x-1.0)/(2.0+x);
} else { /* 11/16 <= |x| < 19/16 */
id = 1;
x = (x-1.0)/(x+1.0);
}
} else {
if (expman < ((0x3fff + 1) << 8) + 0x38) { /* |x| < 2.4375 */
id = 2;
x = (x-1.5)/(1.0+1.5*x);
} else { /* 2.4375 <= |x| */
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 sign ? -z : z;
}
#endif

102
libc/math/cbrt.c
View file

@ -1,102 +0,0 @@
/* 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 "libc/math/math.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)
{
union {double f; uint64_t i;} u = {x};
double_t r,s,t,w;
uint32_t hx = u.i>>32 & 0x7fffffff;
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? */
u.f = x*0x1p54;
hx = u.i>>32 & 0x7fffffff;
if (hx == 0)
return x; /* cbrt(0) is itself */
hx = hx/3 + B2;
} else
hx = hx/3 + B1;
u.i &= 1ULL<<63;
u.i |= (uint64_t)hx << 32;
t = u.f;
/*
* 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 __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.f = t;
u.i = (u.i + 0x80000000) & 0xffffffffc0000000ULL;
t = u.f;
/* 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;
}

65
libc/math/cbrtf.c
View file

@ -1,65 +0,0 @@
/* 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 "libc/math/math.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_t r,T;
union {float f; uint32_t i;} u = {x};
uint32_t hx = u.i & 0x7fffffff;
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 */
u.f = x*0x1p24f;
hx = u.i & 0x7fffffff;
hx = hx/3 + B2;
} else
hx = hx/3 + B1;
u.i &= 0x80000000;
u.i |= hx;
/*
* 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 = u.f;
r = T*T*T;
T = T*((double_t)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_t)x+x+r)/(x+r+r);
/* rounding to 24 bits is perfect in round-to-nearest mode */
return T;
}

124
libc/math/cbrtl.c
View file

@ -1,124 +0,0 @@
/* 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 "libc/math/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
static const unsigned B1 = 709958130; /* B1 = (127-127.0/3-0.03306235651)*2**23 */
long double cbrtl(long double x)
{
union ldshape u = {x}, v;
union {float f; uint32_t i;} uft;
long double r, s, t, w;
double_t dr, dt, dx;
float_t ft;
int e = u.i.se & 0x7fff;
int sign = u.i.se & 0x8000;
/*
* If x = +-Inf, then cbrt(x) = +-Inf.
* If x = NaN, then cbrt(x) = NaN.
*/
if (e == 0x7fff)
return x + x;
if (e == 0) {
/* Adjust subnormal numbers. */
u.f *= 0x1p120;
e = u.i.se & 0x7fff;
/* If x = +-0, then cbrt(x) = +-0. */
if (e == 0)
return x;
e -= 120;
}
e -= 0x3fff;
u.i.se = 0x3fff;
x = u.f;
switch (e % 3) {
case 1:
case -2:
x *= 2;
e--;
break;
case 2:
case -1:
x *= 4;
e -= 2;
break;
}
v.f = 1.0;
v.i.se = sign | (0x3fff + e/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: */
uft.f = x;
uft.i = (uft.i & 0x7fffffff)/3 + B1;
ft = uft.f;
/* ~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).
*/
t = dt + (0x1.0p32L + 0x1.0p-31L) - 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;
#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.f;
return t;
}
#endif

31
libc/math/ceil.c
View file

@ -1,31 +0,0 @@
#include "libc/math/libm.h"
#if FLT_EVAL_METHOD==0 || FLT_EVAL_METHOD==1
#define EPS DBL_EPSILON
#elif FLT_EVAL_METHOD==2
#define EPS LDBL_EPSILON
#endif
static const double_t toint = 1/EPS;
double ceil(double x)
{
union {double f; uint64_t i;} u = {x};
int e = u.i >> 52 & 0x7ff;
double_t y;
if (e >= 0x3ff+52 || x == 0)
return x;
/* y = int(x) - x, where int(x) is an integer neighbor of x */
if (u.i >> 63)
y = x - toint + toint - x;
else
y = x + toint - toint - x;
/* special case because of non-nearest rounding modes */
if (e <= 0x3ff-1) {
FORCE_EVAL(y);
return u.i >> 63 ? -0.0 : 1;
}
if (y < 0)
return x + y + 1;
return x + y;
}

27
libc/math/ceilf.c
View file

@ -1,27 +0,0 @@
#include "libc/math/libm.h"
float ceilf(float x)
{
union {float f; uint32_t i;} u = {x};
int e = (int)(u.i >> 23 & 0xff) - 0x7f;
uint32_t m;
if (e >= 23)
return x;
if (e >= 0) {
m = 0x007fffff >> e;
if ((u.i & m) == 0)
return x;
FORCE_EVAL(x + 0x1p120f);
if (u.i >> 31 == 0)
u.i += m;
u.i &= ~m;
} else {
FORCE_EVAL(x + 0x1p120f);
if (u.i >> 31)
u.f = -0.0;
else if (u.i << 1)
u.f = 1.0;
}
return u.f;
}

34
libc/math/ceill.c
View file

@ -1,34 +0,0 @@
#include "libc/math/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
static const long double toint = 1/LDBL_EPSILON;
long double ceill(long double x)
{
union ldshape u = {x};
int e = u.i.se & 0x7fff;
long double y;
if (e >= 0x3fff+LDBL_MANT_DIG-1 || x == 0)
return x;
/* y = int(x) - x, where int(x) is an integer neighbor of x */
if (u.i.se >> 15)
y = x - toint + toint - x;
else
y = x + toint - toint - x;
/* special case because of non-nearest rounding modes */
if (e <= 0x3fff-1) {
FORCE_EVAL(y);
return u.i.se >> 15 ? -0.0 : 1;
}
if (y < 0)
return x + y + 1;
return x + y;
}
#endif

8
libc/math/copysign.c
View file

@ -1,8 +0,0 @@
#include "libc/math/libm.h"
double copysign(double x, double y) {
union {double f; uint64_t i;} ux={x}, uy={y};
ux.i &= -1ULL/2;
ux.i |= uy.i & 1ULL<<63;
return ux.f;
}

9
libc/math/copysignf.c
View file

@ -1,9 +0,0 @@
#include "libc/math/math.h"
float copysignf(float x, float y)
{
union {float f; uint32_t i;} ux={x}, uy={y};
ux.i &= 0x7fffffff;
ux.i |= uy.i & 0x80000000;
return ux.f;
}

16
libc/math/copysignl.c
View file

@ -1,16 +0,0 @@
#include "libc/math/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.i.se &= 0x7fff;
ux.i.se |= uy.i.se & 0x8000;
return ux.f;
}
#endif

77
libc/math/cos.c
View file

@ -1,77 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/s_cos.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunPro, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* cos(x)
* Return cosine function of x.
*
* kernel function:
* __sin ... sine function on [-pi/4,pi/4]
* __cos ... cosine function on [-pi/4,pi/4]
* __rem_pio2 ... argument reduction routine
*
* Method.
* Let S,C and T denote the sin, cos and tan respectively on
* [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
* in [-pi/4 , +pi/4], and let n = k mod 4.
* We have
*
* n sin(x) cos(x) tan(x)
* ----------------------------------------------------------
* 0 S C T
* 1 C -S -1/T
* 2 -S -C T
* 3 -C S -1/T
* ----------------------------------------------------------
*
* Special cases:
* Let trig be any of sin, cos, or tan.
* trig(+-INF) is NaN, with signals;
* trig(NaN) is that NaN;
*
* Accuracy:
* TRIG(x) returns trig(x) nearly rounded
*/
#include "libc/math/libm.h"
double cos(double x)
{
double y[2];
uint32_t ix;
unsigned n;
GET_HIGH_WORD(ix, x);
ix &= 0x7fffffff;
/* |x| ~< pi/4 */
if (ix <= 0x3fe921fb) {
if (ix < 0x3e46a09e) { /* |x| < 2**-27 * sqrt(2) */
/* raise inexact if x!=0 */
FORCE_EVAL(x + 0x1p120f);
return 1.0;
}
return __cos(x, 0);
}
/* cos(Inf or NaN) is NaN */
if (ix >= 0x7ff00000)
return x-x;
/* argument reduction */
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);
}
}

78
libc/math/cosf.c
View file

@ -1,78 +0,0 @@
/* 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 "libc/math/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;
uint32_t ix;
unsigned n, sign;
GET_FLOAT_WORD(ix, x);
sign = ix >> 31;
ix &= 0x7fffffff;
if (ix <= 0x3f490fda) { /* |x| ~<= pi/4 */
if (ix < 0x39800000) { /* |x| < 2**-12 */
/* raise inexact if x != 0 */
FORCE_EVAL(x + 0x1p120f);
return 1.0f;
}
return __cosdf(x);
}
if (ix <= 0x407b53d1) { /* |x| ~<= 5*pi/4 */
if (ix > 0x4016cbe3) /* |x| ~> 3*pi/4 */
return -__cosdf(sign ? x+c2pio2 : x-c2pio2);
else {
if (sign)
return __sindf(x + c1pio2);
else
return __sindf(c1pio2 - x);
}
}
if (ix <= 0x40e231d5) { /* |x| ~<= 9*pi/4 */
if (ix > 0x40afeddf) /* |x| ~> 7*pi/4 */
return __cosdf(sign ? x+c4pio2 : x-c4pio2);
else {
if (sign)
return __sindf(-x - c3pio2);
else
return __sindf(x - c3pio2);
}
}
/* 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);
}
}

40
libc/math/cosh.c
View file

@ -1,40 +0,0 @@
#include "libc/math/libm.h"
/* cosh(x) = (exp(x) + 1/exp(x))/2
* = 1 + 0.5*(exp(x)-1)*(exp(x)-1)/exp(x)
* = 1 + x*x/2 + o(x^4)
*/
double cosh(double x)
{
union {double f; uint64_t i;} u = {.f = x};
uint32_t w;
double t;
/* |x| */
u.i &= (uint64_t)-1/2;
x = u.f;
w = u.i >> 32;
/* |x| < log(2) */
if (w < 0x3fe62e42) {
if (w < 0x3ff00000 - (26<<20)) {
/* raise inexact if x!=0 */
FORCE_EVAL(x + 0x1p120f);
return 1;
}
t = expm1(x);
return 1 + t*t/(2*(1+t));
}
/* |x| < log(DBL_MAX) */
if (w < 0x40862e42) {
t = exp(x);
/* note: if x>log(0x1p26) then the 1/t is not needed */
return 0.5*(t + 1/t);
}
/* |x| > log(DBL_MAX) or nan */
/* note: the result is stored to handle overflow */
t = __expo2(x);
return t;
}

33
libc/math/coshf.c
View file

@ -1,33 +0,0 @@
#include "libc/math/libm.h"
float coshf(float x)
{
union {float f; uint32_t i;} u = {.f = x};
uint32_t w;
float t;
/* |x| */
u.i &= 0x7fffffff;
x = u.f;
w = u.i;
/* |x| < log(2) */
if (w < 0x3f317217) {
if (w < 0x3f800000 - (12<<23)) {
FORCE_EVAL(x + 0x1p120f);
return 1;
}
t = expm1f(x);
return 1 + t*t/(2*(1+t));
}
/* |x| < log(FLT_MAX) */
if (w < 0x42b17217) {
t = expf(x);
return 0.5f*(t + 1/t);
}
/* |x| > log(FLT_MAX) or nan */
t = __expo2f(x);
return t;
}

47
libc/math/coshl.c
View file

@ -1,47 +0,0 @@
#include "libc/math/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
long double coshl(long double x)
{
union ldshape u = {x};
unsigned ex = u.i.se & 0x7fff;
uint32_t w;
long double t;
/* |x| */
u.i.se = ex;
x = u.f;
w = u.i.m >> 32;
/* |x| < log(2) */
if (ex < 0x3fff-1 || (ex == 0x3fff-1 && w < 0xb17217f7)) {
if (ex < 0x3fff-32) {
FORCE_EVAL(x + 0x1p120f);
return 1;
}
t = expm1l(x);
return 1 + t*t/(2*(1+t));
}
/* |x| < log(LDBL_MAX) */
if (ex < 0x3fff+13 || (ex == 0x3fff+13 && w < 0xb17217f7)) {
t = expl(x);
return 0.5*(t + 1/t);
}
/* |x| > log(LDBL_MAX) or nan */
t = expl(0.5*x);
return 0.5*t*t;
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
// TODO: broken implementation to make things compile
long double coshl(long double x)
{
return cosh(x);
}
#endif

39
libc/math/cosl.c
View file

@ -1,39 +0,0 @@
#include "libc/math/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
long double cosl(long double x)
{
union ldshape u = {x};
unsigned n;
long double y[2], hi, lo;
u.i.se &= 0x7fff;
if (u.i.se == 0x7fff)
return x - x;
x = u.f;
if (x < M_PI_4) {
if (u.i.se < 0x3fff - LDBL_MANT_DIG)
/* raise inexact if x!=0 */
return 1.0 + x;
return __cosl(x, 0);
}
n = __rem_pio2l(x, y);
hi = y[0];
lo = y[1];
switch (n & 3) {
case 0:
return __cosl(hi, lo);
case 1:
return -__sinl(hi, lo, 1);
case 2:
return -__cosl(hi, lo);
case 3:
default:
return __sinl(hi, lo, 1);
}
}
#endif

7
libc/math/drem.c
View file

@ -1,7 +0,0 @@
#include "libc/math/math.h"
double drem(double x, double y)
{
int q;
return remquo(x, y, &q);
}

273
libc/math/erf.c
View file

@ -1,273 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/s_erf.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunPro, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* double erf(double x)
* double erfc(double x)
* x
* 2 |\
* erf(x) = --------- | exp(-t*t)dt
* sqrt(pi) \|
* 0
*
* erfc(x) = 1-erf(x)
* Note that
* erf(-x) = -erf(x)
* erfc(-x) = 2 - erfc(x)
*
* Method:
* 1. For |x| in [0, 0.84375]
* erf(x) = x + x*R(x^2)
* erfc(x) = 1 - erf(x) if x in [-.84375,0.25]
* = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375]
* where R = P/Q where P is an odd poly of degree 8 and
* Q is an odd poly of degree 10.
* -57.90
* | R - (erf(x)-x)/x | <= 2
*
*
* Remark. The formula is derived by noting
* erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
* and that
* 2/sqrt(pi) = 1.128379167095512573896158903121545171688
* is close to one. The interval is chosen because the fix
* point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
* near 0.6174), and by some experiment, 0.84375 is chosen to
* guarantee the error is less than one ulp for erf.
*
* 2. For |x| in [0.84375,1.25], let s = |x| - 1, and
* c = 0.84506291151 rounded to single (24 bits)
* erf(x) = sign(x) * (c + P1(s)/Q1(s))
* erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0
* 1+(c+P1(s)/Q1(s)) if x < 0
* |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06
* Remark: here we use the taylor series expansion at x=1.
* erf(1+s) = erf(1) + s*Poly(s)
* = 0.845.. + P1(s)/Q1(s)
* That is, we use rational approximation to approximate
* erf(1+s) - (c = (single)0.84506291151)
* Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
* where
* P1(s) = degree 6 poly in s
* Q1(s) = degree 6 poly in s
*
* 3. For x in [1.25,1/0.35(~2.857143)],
* erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1)
* erf(x) = 1 - erfc(x)
* where
* R1(z) = degree 7 poly in z, (z=1/x^2)
* S1(z) = degree 8 poly in z
*
* 4. For x in [1/0.35,28]
* erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
* = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6<x<0
* = 2.0 - tiny (if x <= -6)
* erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6, else
* erf(x) = sign(x)*(1.0 - tiny)
* where
* R2(z) = degree 6 poly in z, (z=1/x^2)
* S2(z) = degree 7 poly in z
*
* Note1:
* To compute exp(-x*x-0.5625+R/S), let s be a single
* precision number and s := x; then
* -x*x = -s*s + (s-x)*(s+x)
* exp(-x*x-0.5626+R/S) =
* exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S);
* Note2:
* Here 4 and 5 make use of the asymptotic series
* exp(-x*x)
* erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) )
* x*sqrt(pi)
* We use rational approximation to approximate
* g(s)=f(1/x^2) = log(erfc(x)*x) - x*x + 0.5625
* Here is the error bound for R1/S1 and R2/S2
* |R1/S1 - f(x)| < 2**(-62.57)
* |R2/S2 - f(x)| < 2**(-61.52)
*
* 5. For inf > x >= 28
* erf(x) = sign(x) *(1 - tiny) (raise inexact)
* erfc(x) = tiny*tiny (raise underflow) if x > 0
* = 2 - tiny if x<0
*
* 7. Special case:
* erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
* erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
* erfc/erf(NaN) is NaN
*/
#include "libc/math/libm.h"
static const double
erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */
/*
* Coefficients for approximation to erf on [0,0.84375]
*/
efx8 = 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */
pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */
pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */
pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */
pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */
pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */
qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */
qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */
qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */
qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */
qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */
/*
* Coefficients for approximation to erf in [0.84375,1.25]
*/
pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */
pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */
pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */
pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */
pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */
pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */
pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */
qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */
qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */
qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */
qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */
qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */
qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */
/*
* Coefficients for approximation to erfc in [1.25,1/0.35]
*/
ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */
ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */
ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */
ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */
ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */
ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */
ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */
ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */
sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */
sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */
sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */
sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */
sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */
sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */
sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */
sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */
/*
* Coefficients for approximation to erfc in [1/.35,28]
*/
rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */
rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */
rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */
rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */
rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */
rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */
rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */
sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */
sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */
sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */
sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */
sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */
sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */
sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */
static double erfc1(double x)
{
double_t s,P,Q;
s = fabs(x) - 1;
P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
Q = 1+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
return 1 - erx - P/Q;
}
static double erfc2(uint32_t ix, double x)
{
double_t s,R,S;
double z;
if (ix < 0x3ff40000) /* |x| < 1.25 */
return erfc1(x);
x = fabs(x);
s = 1/(x*x);
if (ix < 0x4006db6d) { /* |x| < 1/.35 ~ 2.85714 */
R = ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
ra5+s*(ra6+s*ra7))))));
S = 1.0+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
sa5+s*(sa6+s*(sa7+s*sa8)))))));
} else { /* |x| > 1/.35 */
R = rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
rb5+s*rb6)))));
S = 1.0+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
sb5+s*(sb6+s*sb7))))));
}
z = x;
SET_LOW_WORD(z,0);
return exp(-z*z-0.5625)*exp((z-x)*(z+x)+R/S)/x;
}
double erf(double x)
{
double r,s,z,y;
uint32_t ix;
int sign;
GET_HIGH_WORD(ix, x);
sign = ix>>31;
ix &= 0x7fffffff;
if (ix >= 0x7ff00000) {
/* erf(nan)=nan, erf(+-inf)=+-1 */
return 1-2*sign + 1/x;
}
if (ix < 0x3feb0000) { /* |x| < 0.84375 */
if (ix < 0x3e300000) { /* |x| < 2**-28 */
/* avoid underflow */
return 0.125*(8*x + efx8*x);
}
z = x*x;
r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
s = 1.0+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
y = r/s;
return x + x*y;
}
if (ix < 0x40180000) /* 0.84375 <= |x| < 6 */
y = 1 - erfc2(ix,x);
else
y = 1 - 0x1p-1022;
return sign ? -y : y;
}
double erfc(double x)
{
double r,s,z,y;
uint32_t ix;
int sign;
GET_HIGH_WORD(ix, x);
sign = ix>>31;
ix &= 0x7fffffff;
if (ix >= 0x7ff00000) {
/* erfc(nan)=nan, erfc(+-inf)=0,2 */
return 2*sign + 1/x;
}
if (ix < 0x3feb0000) { /* |x| < 0.84375 */
if (ix < 0x3c700000) /* |x| < 2**-56 */
return 1.0 - x;
z = x*x;
r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
s = 1.0+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
y = r/s;
if (sign || ix < 0x3fd00000) { /* x < 1/4 */
return 1.0 - (x+x*y);
}
return 0.5 - (x - 0.5 + x*y);
}
if (ix < 0x403c0000) { /* 0.84375 <= |x| < 28 */
return sign ? 2 - erfc2(ix,x) : erfc2(ix,x);
}
return sign ? 2 - 0x1p-1022 : 0x1p-1022*0x1p-1022;
}

183
libc/math/erff.c
View file

@ -1,183 +0,0 @@
/* 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 "libc/math/libm.h"
static const float
erx = 8.4506291151e-01, /* 0x3f58560b */
/*
* Coefficients for approximation to erf on [0,0.84375]
*/
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 */
static float erfc1(float x)
{
float_t s,P,Q;
s = fabsf(x) - 1;
P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
Q = 1+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
return 1 - erx - P/Q;
}
static float erfc2(uint32_t ix, float x)
{
float_t s,R,S;
float z;
if (ix < 0x3fa00000) /* |x| < 1.25 */
return erfc1(x);
x = fabsf(x);
s = 1/(x*x);
if (ix < 0x4036db6d) { /* |x| < 1/0.35 */
R = ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
ra5+s*(ra6+s*ra7))))));
S = 1.0f+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 = 1.0f+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
sb5+s*(sb6+s*sb7))))));
}
GET_FLOAT_WORD(ix, x);
SET_FLOAT_WORD(z, ix&0xffffe000);
return expf(-z*z - 0.5625f) * expf((z-x)*(z+x) + R/S)/x;
}
float erff(float x)
{
float r,s,z,y;
uint32_t ix;
int sign;
GET_FLOAT_WORD(ix, x);
sign = ix>>31;
ix &= 0x7fffffff;
if (ix >= 0x7f800000) {
/* erf(nan)=nan, erf(+-inf)=+-1 */
return 1-2*sign + 1/x;
}
if (ix < 0x3f580000) { /* |x| < 0.84375 */
if (ix < 0x31800000) { /* |x| < 2**-28 */
/*avoid underflow */
return 0.125f*(8*x + efx8*x);
}
z = x*x;
r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
s = 1+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
y = r/s;
return x + x*y;
}
if (ix < 0x40c00000) /* |x| < 6 */
y = 1 - erfc2(ix,x);
else
y = 1 - 0x1p-120f;
return sign ? -y : y;
}
float erfcf(float x)
{
float r,s,z,y;
uint32_t ix;
int sign;
GET_FLOAT_WORD(ix, x);
sign = ix>>31;
ix &= 0x7fffffff;
if (ix >= 0x7f800000) {
/* erfc(nan)=nan, erfc(+-inf)=0,2 */
return 2*sign + 1/x;
}
if (ix < 0x3f580000) { /* |x| < 0.84375 */
if (ix < 0x23800000) /* |x| < 2**-56 */
return 1.0f - x;
z = x*x;
r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
s = 1.0f+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
y = r/s;
if (sign || ix < 0x3e800000) /* x < 1/4 */
return 1.0f - (x+x*y);
return 0.5f - (x - 0.5f + x*y);
}
if (ix < 0x41e00000) { /* |x| < 28 */
return sign ? 2 - erfc2(ix,x) : erfc2(ix,x);
}
return sign ? 2 - 0x1p-120f : 0x1p-120f*0x1p-120f;
}

353
libc/math/erfl.c
View file

@ -1,353 +0,0 @@
/* 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 "libc/math/libm.h"
#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
long double erfl(long double x)
{
return erf(x);
}
long double erfcl(long double x)
{
return erfc(x);
}
#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
static const long double
erx = 0.845062911510467529296875L,
/*
* Coefficients for approximation to erf on [0,0.84375]
*/
/* 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 */
};
static long double erfc1(long double x)
{
long double s,P,Q;
s = fabsl(x) - 1;
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))))));
return 1 - erx - P / Q;
}
static long double erfc2(uint32_t ix, long double x)
{
union ldshape u;
long double s,z,R,S;
if (ix < 0x3fffa000) /* 0.84375 <= |x| < 1.25 */
return erfc1(x);
x = fabsl(x);
s = 1 / (x * x);
if (ix < 0x4000b6db) { /* 1.25 <= |x| < 2.857 ~ 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) { /* 2.857 <= |x| < 6.6666259765625 */
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 { /* 6.666 <= |x| < 107 (erfc only) */
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))));
}
u.f = x;
u.i.m &= -1ULL << 40;
z = u.f;
return expl(-z*z - 0.5625) * expl((z - x) * (z + x) + R / S) / x;
}
long double erfl(long double x)
{
long double r, s, z, y;
union ldshape u = {x};
uint32_t ix = (u.i.se & 0x7fffU)<<16 | u.i.m>>48;
int sign = u.i.se >> 15;
if (ix >= 0x7fff0000)
/* erf(nan)=nan, erf(+-inf)=+-1 */
return 1 - 2*sign + 1/x;
if (ix < 0x3ffed800) { /* |x| < 0.84375 */
if (ix < 0x3fde8000) { /* |x| < 2**-33 */
return 0.125 * (8 * x + efx8 * x); /* avoid underflow */
}
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 < 0x4001d555) /* |x| < 6.6666259765625 */
y = 1 - erfc2(ix,x);
else
y = 1 - 0x1p-16382L;
return sign ? -y : y;
}
long double erfcl(long double x)
{
long double r, s, z, y;
union ldshape u = {x};
uint32_t ix = (u.i.se & 0x7fffU)<<16 | u.i.m>>48;
int sign = u.i.se >> 15;
if (ix >= 0x7fff0000)
/* erfc(nan) = nan, erfc(+-inf) = 0,2 */
return 2*sign + 1/x;
if (ix < 0x3ffed800) { /* |x| < 0.84375 */
if (ix < 0x3fbe0000) /* |x| < 2**-65 */
return 1.0 - 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 1.0 - (x + x * y);
return 0.5 - (x - 0.5 + x * y);
}
if (ix < 0x4005d600) /* |x| < 107 */
return sign ? 2 - erfc2(ix,x) : erfc2(ix,x);
y = 0x1p-16382L;
return sign ? 2 - y : y*y;
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
// TODO: broken implementation to make things compile
long double erfl(long double x)
{
return erf(x);
}
long double erfcl(long double x)
{
return erfc(x);
}
#endif

133
libc/math/exp.c
View file

@ -1,133 +0,0 @@
/*
* Double-precision e^x function.
*
* Copyright (c) 2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#include "libc/math/math.h"
#include "libc/math/libm.h"
#include "libc/math/exp_data.h"
#define N (1 << EXP_TABLE_BITS)
#define InvLn2N __exp_data.invln2N
#define NegLn2hiN __exp_data.negln2hiN
#define NegLn2loN __exp_data.negln2loN
#define Shift __exp_data.shift
#define T __exp_data.tab
#define C2 __exp_data.poly[5 - EXP_POLY_ORDER]
#define C3 __exp_data.poly[6 - EXP_POLY_ORDER]
#define C4 __exp_data.poly[7 - EXP_POLY_ORDER]
#define C5 __exp_data.poly[8 - EXP_POLY_ORDER]
/* Handle cases that may overflow or underflow when computing the result that
is scale*(1+TMP) without intermediate rounding. The bit representation of
scale is in SBITS, however it has a computed exponent that may have
overflown into the sign bit so that needs to be adjusted before using it as
a double. (int32_t)KI is the k used in the argument reduction and exponent
adjustment of scale, positive k here means the result may overflow and
negative k means the result may underflow. */
static inline double specialcase(double_t tmp, uint64_t sbits, uint64_t ki)
{
double_t scale, y;
if ((ki & 0x80000000) == 0) {
/* k > 0, the exponent of scale might have overflowed by <= 460. */
sbits -= 1009ull << 52;
scale = asdouble(sbits);
y = 0x1p1009 * (scale + scale * tmp);
return eval_as_double(y);
}
/* k < 0, need special care in the subnormal range. */
sbits += 1022ull << 52;
scale = asdouble(sbits);
y = scale + scale * tmp;
if (y < 1.0) {
/* Round y to the right precision before scaling it into the subnormal
range to avoid double rounding that can cause 0.5+E/2 ulp error where
E is the worst-case ulp error outside the subnormal range. So this
is only useful if the goal is better than 1 ulp worst-case error. */
double_t hi, lo;
lo = scale - y + scale * tmp;
hi = 1.0 + y;
lo = 1.0 - hi + y + lo;
y = eval_as_double(hi + lo) - 1.0;
/* Avoid -0.0 with downward rounding. */
if (WANT_ROUNDING && y == 0.0)
y = 0.0;
/* The underflow exception needs to be signaled explicitly. */
fp_force_eval(fp_barrier(0x1p-1022) * 0x1p-1022);
}
y = 0x1p-1022 * y;
return eval_as_double(y);
}
/* Top 12 bits of a double (sign and exponent bits). */
static inline uint32_t top12(double x)
{
return asuint64(x) >> 52;
}
double exp(double x)
{
uint32_t abstop;
uint64_t ki, idx, top, sbits;
double_t kd, z, r, r2, scale, tail, tmp;
abstop = top12(x) & 0x7ff;
if (predict_false(abstop - top12(0x1p-54) >= top12(512.0) - top12(0x1p-54))) {
if (abstop - top12(0x1p-54) >= 0x80000000)
/* Avoid spurious underflow for tiny x. */
/* Note: 0 is common input. */
return WANT_ROUNDING ? 1.0 + x : 1.0;
if (abstop >= top12(1024.0)) {
if (asuint64(x) == asuint64(-INFINITY))
return 0.0;
if (abstop >= top12(INFINITY))
return 1.0 + x;
if (asuint64(x) >> 63)
return __math_uflow(0);
else
return __math_oflow(0);
}
/* Large x is special cased below. */
abstop = 0;
}
/* exp(x) = 2^(k/N) * exp(r), with exp(r) in [2^(-1/2N),2^(1/2N)]. */
/* x = ln2/N*k + r, with int k and r in [-ln2/2N, ln2/2N]. */
z = InvLn2N * x;
#if TOINT_INTRINSICS
kd = roundtoint(z);
ki = converttoint(z);
#elif EXP_USE_TOINT_NARROW
/* z - kd is in [-0.5-2^-16, 0.5] in all rounding modes. */
kd = eval_as_double(z + Shift);
ki = asuint64(kd) >> 16;
kd = (double_t)(int32_t)ki;
#else
/* z - kd is in [-1, 1] in non-nearest rounding modes. */
kd = eval_as_double(z + Shift);
ki = asuint64(kd);
kd -= Shift;
#endif
r = x + kd * NegLn2hiN + kd * NegLn2loN;
/* 2^(k/N) ~= scale * (1 + tail). */
idx = 2 * (ki % N);
top = ki << (52 - EXP_TABLE_BITS);
tail = asdouble(T[idx]);
/* This is only a valid scale when -1023*N < k < 1024*N. */
sbits = T[idx + 1] + top;
/* exp(x) = 2^(k/N) * exp(r) ~= scale + scale * (tail + exp(r) - 1). */
/* Evaluation is optimized assuming superscalar pipelined execution. */
r2 = r * r;
/* Without fma the worst case error is 0.25/N ulp larger. */
/* Worst case error is less than 0.5+1.11/N+(abs poly error * 2^53) ulp. */
tmp = tail + r + r2 * (C2 + r * C3) + r2 * r2 * (C4 + r * C5);
if (predict_false(abstop == 0))
return specialcase(tmp, sbits, ki);
scale = asdouble(sbits);
/* Note: tmp == 0 or |tmp| > 2^-200 and scale > 2^-739, so there
is no spurious underflow here even without fma. */
return eval_as_double(scale + scale * tmp);
}

23
libc/math/exp10.c
View file

@ -1,23 +0,0 @@
#define _GNU_SOURCE
#include "libc/math/libm.h"
double exp10(double x)
{
static const double p10[] = {
1e-15, 1e-14, 1e-13, 1e-12, 1e-11, 1e-10,
1e-9, 1e-8, 1e-7, 1e-6, 1e-5, 1e-4, 1e-3, 1e-2, 1e-1,
1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
1e10, 1e11, 1e12, 1e13, 1e14, 1e15
};
double n, y = modf(x, &n);
union {double f; uint64_t i;} u = {n};
/* fabs(n) < 16 without raising invalid on nan */
if ((u.i>>52 & 0x7ff) < 0x3ff+4) {
if (!y) return p10[(int)n+15];
y = exp2(3.32192809488736234787031942948939 * y);
return y * p10[(int)n+15];
}
return pow(10.0, x);
}
weak_alias(exp10, pow10);

21
libc/math/exp10f.c
View file

@ -1,21 +0,0 @@
#define _GNU_SOURCE
#include "libc/math/libm.h"
float exp10f(float x)
{
static const float p10[] = {
1e-7f, 1e-6f, 1e-5f, 1e-4f, 1e-3f, 1e-2f, 1e-1f,
1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7
};
float n, y = modff(x, &n);
union {float f; uint32_t i;} u = {n};
/* fabsf(n) < 8 without raising invalid on nan */
if ((u.i>>23 & 0xff) < 0x7f+3) {
if (!y) return p10[(int)n+7];
y = exp2f(3.32192809488736234787031942948939f * y);
return y * p10[(int)n+7];
}
return exp2(3.32192809488736234787031942948939 * x);
}
weak_alias(exp10f, pow10f);

31
libc/math/exp10l.c
View file

@ -1,31 +0,0 @@
#define _GNU_SOURCE
#include "libc/math/math.h"
#include "libc/math/libm.h"
#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
long double exp10l(long double x)
{
return exp10(x);
}
#elif (LDBL_MANT_DIG == 64 || LDBL_MANT_DIG == 113) && LDBL_MAX_EXP == 16384
long double exp10l(long double x)
{
static const long double p10[] = {
1e-15L, 1e-14L, 1e-13L, 1e-12L, 1e-11L, 1e-10L,
1e-9L, 1e-8L, 1e-7L, 1e-6L, 1e-5L, 1e-4L, 1e-3L, 1e-2L, 1e-1L,
1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
1e10, 1e11, 1e12, 1e13, 1e14, 1e15
};
long double n, y = modfl(x, &n);
union ldshape u = {n};
/* fabsl(n) < 16 without raising invalid on nan */
if ((u.i.se & 0x7fff) < 0x3fff+4) {
if (!y) return p10[(int)n+15];
y = exp2l(3.32192809488736234787031942948939L * y);
return y * p10[(int)n+15];
}
return powl(10.0, x);
}
#endif
weak_alias(exp10l, pow10l);

120
libc/math/exp2.c
View file

@ -1,120 +0,0 @@
/*
* Double-precision 2^x function.
*
* Copyright (c) 2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#include "libc/math/math.h"
#include "libc/math/libm.h"
#include "libc/math/exp_data.h"
#define N (1 << EXP_TABLE_BITS)
#define Shift __exp_data.exp2_shift
#define T __exp_data.tab
#define C1 __exp_data.exp2_poly[0]
#define C2 __exp_data.exp2_poly[1]
#define C3 __exp_data.exp2_poly[2]
#define C4 __exp_data.exp2_poly[3]
#define C5 __exp_data.exp2_poly[4]
/* Handle cases that may overflow or underflow when computing the result that
is scale*(1+TMP) without intermediate rounding. The bit representation of
scale is in SBITS, however it has a computed exponent that may have
overflown into the sign bit so that needs to be adjusted before using it as
a double. (int32_t)KI is the k used in the argument reduction and exponent
adjustment of scale, positive k here means the result may overflow and
negative k means the result may underflow. */
static inline double specialcase(double_t tmp, uint64_t sbits, uint64_t ki)
{
double_t scale, y;
if ((ki & 0x80000000) == 0) {
/* k > 0, the exponent of scale might have overflowed by 1. */
sbits -= 1ull << 52;
scale = asdouble(sbits);
y = 2 * (scale + scale * tmp);
return eval_as_double(y);
}
/* k < 0, need special care in the subnormal range. */
sbits += 1022ull << 52;
scale = asdouble(sbits);
y = scale + scale * tmp;
if (y < 1.0) {
/* Round y to the right precision before scaling it into the subnormal
range to avoid double rounding that can cause 0.5+E/2 ulp error where
E is the worst-case ulp error outside the subnormal range. So this
is only useful if the goal is better than 1 ulp worst-case error. */
double_t hi, lo;
lo = scale - y + scale * tmp;
hi = 1.0 + y;
lo = 1.0 - hi + y + lo;
y = eval_as_double(hi + lo) - 1.0;
/* Avoid -0.0 with downward rounding. */
if (WANT_ROUNDING && y == 0.0)
y = 0.0;
/* The underflow exception needs to be signaled explicitly. */
fp_force_eval(fp_barrier(0x1p-1022) * 0x1p-1022);
}
y = 0x1p-1022 * y;
return eval_as_double(y);
}
/* Top 12 bits of a double (sign and exponent bits). */
static inline uint32_t top12(double x)
{
return asuint64(x) >> 52;
}
double exp2(double x)
{
uint32_t abstop;
uint64_t ki, idx, top, sbits;
double_t kd, r, r2, scale, tail, tmp;
abstop = top12(x) & 0x7ff;
if (predict_false(abstop - top12(0x1p-54) >= top12(512.0) - top12(0x1p-54))) {
if (abstop - top12(0x1p-54) >= 0x80000000)
/* Avoid spurious underflow for tiny x. */
/* Note: 0 is common input. */
return WANT_ROUNDING ? 1.0 + x : 1.0;
if (abstop >= top12(1024.0)) {
if (asuint64(x) == asuint64(-INFINITY))
return 0.0;
if (abstop >= top12(INFINITY))
return 1.0 + x;
if (!(asuint64(x) >> 63))
return __math_oflow(0);
else if (asuint64(x) >= asuint64(-1075.0))
return __math_uflow(0);
}
if (2 * asuint64(x) > 2 * asuint64(928.0))
/* Large x is special cased below. */
abstop = 0;
}
/* exp2(x) = 2^(k/N) * 2^r, with 2^r in [2^(-1/2N),2^(1/2N)]. */
/* x = k/N + r, with int k and r in [-1/2N, 1/2N]. */
kd = eval_as_double(x + Shift);
ki = asuint64(kd); /* k. */
kd -= Shift; /* k/N for int k. */
r = x - kd;
/* 2^(k/N) ~= scale * (1 + tail). */
idx = 2 * (ki % N);
top = ki << (52 - EXP_TABLE_BITS);
tail = asdouble(T[idx]);
/* This is only a valid scale when -1023*N < k < 1024*N. */
sbits = T[idx + 1] + top;
/* exp2(x) = 2^(k/N) * 2^r ~= scale + scale * (tail + 2^r - 1). */
/* Evaluation is optimized assuming superscalar pipelined execution. */
r2 = r * r;
/* Without fma the worst case error is 0.5/N ulp larger. */
/* Worst case error is less than 0.5+0.86/N+(abs poly error * 2^53) ulp. */
tmp = tail + r * C1 + r2 * (C2 + r * C3) + r2 * r2 * (C4 + r * C5);
if (predict_false(abstop == 0))
return specialcase(tmp, sbits, ki);
scale = asdouble(sbits);
/* Note: tmp == 0 or |tmp| > 2^-65 and scale > 2^-928, so there
is no spurious underflow here even without fma. */
return eval_as_double(scale + scale * tmp);
}

69
libc/math/exp2f.c
View file

@ -1,69 +0,0 @@
/* clang-format off */
/*
* Single-precision 2^x function.
*
* Copyright (c) 2017-2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#include "libc/math/math.h"
#include "libc/math/libm.h"
#include "libc/math/exp2f_data.h"
/*
EXP2F_TABLE_BITS = 5
EXP2F_POLY_ORDER = 3
ULP error: 0.502 (nearest rounding.)
Relative error: 1.69 * 2^-34 in [-1/64, 1/64] (before rounding.)
Wrong count: 168353 (all nearest rounding wrong results with fma.)
Non-nearest ULP error: 1 (rounded ULP error)
*/
#define N (1 << EXP2F_TABLE_BITS)
#define T __exp2f_data.tab
#define C __exp2f_data.poly
#define SHIFT __exp2f_data.shift_scaled
static inline uint32_t top12(float x)
{
return asuint(x) >> 20;
}
float exp2f(float x)
{
uint32_t abstop;
uint64_t ki, t;
double_t kd, xd, z, r, r2, y, s;
xd = (double_t)x;
abstop = top12(x) & 0x7ff;
if (predict_false(abstop >= top12(128.0f))) {
/* |x| >= 128 or x is nan. */
if (asuint(x) == asuint(-INFINITY))
return 0.0f;
if (abstop >= top12(INFINITY))
return x + x;
if (x > 0.0f)
return __math_oflowf(0);
if (x <= -150.0f)
return __math_uflowf(0);
}
/* x = k/N + r with r in [-1/(2N), 1/(2N)] and int k. */
kd = eval_as_double(xd + SHIFT);
ki = asuint64(kd);
kd -= SHIFT; /* k/N for int k. */
r = xd - kd;
/* exp2(x) = 2^(k/N) * 2^r ~= s * (C0*r^3 + C1*r^2 + C2*r + 1) */
t = T[ki % N];
t += ki << (52 - EXP2F_TABLE_BITS);
s = asdouble(t);
z = C[0] * r + C[1];
r2 = r * r;
y = C[2] * r + 1;
y = z * r2 + y;
y = y * s;
return eval_as_float(y);
}

35
libc/math/exp2f_data.c
View file

@ -1,35 +0,0 @@
/*
* Shared data between expf, exp2f and powf.
*
* Copyright (c) 2017-2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#include "libc/math/exp2f_data.h"
#define N (1 << EXP2F_TABLE_BITS)
const struct exp2f_data __exp2f_data = {
/* tab[i] = uint(2^(i/N)) - (i << 52-BITS)
used for computing 2^(k/N) for an int |k| < 150 N as
double(tab[k%N] + (k << 52-BITS)) */
.tab = {
0x3ff0000000000000, 0x3fefd9b0d3158574, 0x3fefb5586cf9890f, 0x3fef9301d0125b51,
0x3fef72b83c7d517b, 0x3fef54873168b9aa, 0x3fef387a6e756238, 0x3fef1e9df51fdee1,
0x3fef06fe0a31b715, 0x3feef1a7373aa9cb, 0x3feedea64c123422, 0x3feece086061892d,
0x3feebfdad5362a27, 0x3feeb42b569d4f82, 0x3feeab07dd485429, 0x3feea47eb03a5585,
0x3feea09e667f3bcd, 0x3fee9f75e8ec5f74, 0x3feea11473eb0187, 0x3feea589994cce13,
0x3feeace5422aa0db, 0x3feeb737b0cdc5e5, 0x3feec49182a3f090, 0x3feed503b23e255d,
0x3feee89f995ad3ad, 0x3feeff76f2fb5e47, 0x3fef199bdd85529c, 0x3fef3720dcef9069,
0x3fef5818dcfba487, 0x3fef7c97337b9b5f, 0x3fefa4afa2a490da, 0x3fefd0765b6e4540,
},
.shift_scaled = 0x1.8p+52 / N,
.poly = {
0x1.c6af84b912394p-5, 0x1.ebfce50fac4f3p-3, 0x1.62e42ff0c52d6p-1,
},
.shift = 0x1.8p+52,
.invln2_scaled = 0x1.71547652b82fep+0 * N,
.poly_scaled = {
0x1.c6af84b912394p-5/N/N/N, 0x1.ebfce50fac4f3p-3/N/N, 0x1.62e42ff0c52d6p-1/N,
},
};

20
libc/math/exp2f_data.h
View file

@ -1,20 +0,0 @@
/*
* Copyright (c) 2017-2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#ifndef _EXP2F_DATA_H
#define _EXP2F_DATA_H
/* Shared between expf, exp2f and powf. */
#define EXP2F_TABLE_BITS 5
#define EXP2F_POLY_ORDER 3
extern const struct exp2f_data {
unsigned long long tab[1 << EXP2F_TABLE_BITS];
double shift_scaled;
double poly[EXP2F_POLY_ORDER];
double shift;
double invln2_scaled;
double poly_scaled[EXP2F_POLY_ORDER];
} __exp2f_data;
#endif

619
libc/math/exp2l.c
View file

@ -1,619 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/ld80/s_exp2l.c and /usr/src/lib/msun/ld128/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 "libc/math/libm.h"
#if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024
long double exp2l(long double x)
{
return exp2(x);
}
#elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384
#define TBLBITS 7
#define TBLSIZE (1 << TBLBITS)
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 ldshape u = {x};
int e = u.i.se & 0x7fff;
long double r, z;
uint32_t i0;
union {uint32_t u; int32_t i;} k;
/* Filter out exceptional cases. */
if (e >= 0x3fff + 13) { /* |x| >= 8192 or x is NaN */
if (u.i.se >= 0x3fff + 14 && u.i.se >> 15 == 0)
/* overflow */
return x * 0x1p16383L;
if (e == 0x7fff) /* -inf or -nan */
return -1/x;
if (x < -16382) {
if (x <= -16446 || x - 0x1p63 + 0x1p63 != x)
/* underflow */
FORCE_EVAL((float)(-0x1p-149/x));
if (x <= -16446)
return 0;
}
} else if (e < 0x3fff - 64) {
return 1 + x;
}
/*
* Reduce x, computing z, i0, and k. The low bits of x + redux
* contain the 16-bit integer part of the exponent (k) followed by
* TBLBITS fractional bits (i0). We use bit tricks to extract these
* as integers, then set z to the remainder.
*
* Example: Suppose x is 0xabc.123456p0 and TBLBITS is 8.
* Then the low-order word of x + redux is 0x000abc12,
* We split this into k = 0xabc and i0 = 0x12 (adjusted to
* index into the table), then we compute z = 0x0.003456p0.
*/
u.f = x + redux;
i0 = u.i.m + TBLSIZE / 2;
k.u = i0 / TBLSIZE * TBLSIZE;
k.i /= TBLSIZE;
i0 %= TBLSIZE;
u.f -= redux;
z = x - u.f;
/* Compute r = exp2l(y) = exp2lt[i0] * p(z). */
long double t_hi = tbl[2*i0];
long double t_lo = tbl[2*i0 + 1];
/* XXX This gives > 1 ulp errors outside of FE_TONEAREST mode */
r = t_lo + (t_hi + t_lo) * z * (P1 + z * (P2 + z * (P3 + z * (P4
+ z * (P5 + z * P6))))) + t_hi;
return scalbnl(r, k.i);
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
#define TBLBITS 7
#define TBLSIZE (1 << TBLBITS)
static const long double
P1 = 0x1.62e42fefa39ef35793c7673007e6p-1L,
P2 = 0x1.ebfbdff82c58ea86f16b06ec9736p-3L,
P3 = 0x1.c6b08d704a0bf8b33a762bad3459p-5L,
P4 = 0x1.3b2ab6fba4e7729ccbbe0b4f3fc2p-7L,
P5 = 0x1.5d87fe78a67311071dee13fd11d9p-10L,
P6 = 0x1.430912f86c7876f4b663b23c5fe5p-13L;
static const double
P7 = 0x1.ffcbfc588b041p-17,
P8 = 0x1.62c0223a5c7c7p-20,
P9 = 0x1.b52541ff59713p-24,
P10 = 0x1.e4cf56a391e22p-28,
redux = 0x1.8p112 / TBLSIZE;
static const long double tbl[TBLSIZE] = {
0x1.6a09e667f3bcc908b2fb1366dfeap-1L,
0x1.6c012750bdabeed76a99800f4edep-1L,
0x1.6dfb23c651a2ef220e2cbe1bc0d4p-1L,
0x1.6ff7df9519483cf87e1b4f3e1e98p-1L,
0x1.71f75e8ec5f73dd2370f2ef0b148p-1L,
0x1.73f9a48a58173bd5c9a4e68ab074p-1L,
0x1.75feb564267c8bf6e9aa33a489a8p-1L,
0x1.780694fde5d3f619ae02808592a4p-1L,
0x1.7a11473eb0186d7d51023f6ccb1ap-1L,
0x1.7c1ed0130c1327c49334459378dep-1L,
0x1.7e2f336cf4e62105d02ba1579756p-1L,
0x1.80427543e1a11b60de67649a3842p-1L,
0x1.82589994cce128acf88afab34928p-1L,
0x1.8471a4623c7acce52f6b97c6444cp-1L,
0x1.868d99b4492ec80e41d90ac2556ap-1L,
0x1.88ac7d98a669966530bcdf2d4cc0p-1L,
0x1.8ace5422aa0db5ba7c55a192c648p-1L,
0x1.8cf3216b5448bef2aa1cd161c57ap-1L,
0x1.8f1ae991577362b982745c72eddap-1L,
0x1.9145b0b91ffc588a61b469f6b6a0p-1L,
0x1.93737b0cdc5e4f4501c3f2540ae8p-1L,
0x1.95a44cbc8520ee9b483695a0e7fep-1L,
0x1.97d829fde4e4f8b9e920f91e8eb6p-1L,
0x1.9a0f170ca07b9ba3109b8c467844p-1L,
0x1.9c49182a3f0901c7c46b071f28dep-1L,
0x1.9e86319e323231824ca78e64c462p-1L,
0x1.a0c667b5de564b29ada8b8cabbacp-1L,
0x1.a309bec4a2d3358c171f770db1f4p-1L,
0x1.a5503b23e255c8b424491caf88ccp-1L,
0x1.a799e1330b3586f2dfb2b158f31ep-1L,
0x1.a9e6b5579fdbf43eb243bdff53a2p-1L,
0x1.ac36bbfd3f379c0db966a3126988p-1L,
0x1.ae89f995ad3ad5e8734d17731c80p-1L,
0x1.b0e07298db66590842acdfc6fb4ep-1L,
0x1.b33a2b84f15faf6bfd0e7bd941b0p-1L,
0x1.b59728de559398e3881111648738p-1L,
0x1.b7f76f2fb5e46eaa7b081ab53ff6p-1L,
0x1.ba5b030a10649840cb3c6af5b74cp-1L,
0x1.bcc1e904bc1d2247ba0f45b3d06cp-1L,
0x1.bf2c25bd71e088408d7025190cd0p-1L,
0x1.c199bdd85529c2220cb12a0916bap-1L,
0x1.c40ab5fffd07a6d14df820f17deap-1L,
0x1.c67f12e57d14b4a2137fd20f2a26p-1L,
0x1.c8f6d9406e7b511acbc48805c3f6p-1L,
0x1.cb720dcef90691503cbd1e949d0ap-1L,
0x1.cdf0b555dc3f9c44f8958fac4f12p-1L,
0x1.d072d4a07897b8d0f22f21a13792p-1L,
0x1.d2f87080d89f18ade123989ea50ep-1L,
0x1.d5818dcfba48725da05aeb66dff8p-1L,
0x1.d80e316c98397bb84f9d048807a0p-1L,
0x1.da9e603db3285708c01a5b6d480cp-1L,
0x1.dd321f301b4604b695de3c0630c0p-1L,
0x1.dfc97337b9b5eb968cac39ed284cp-1L,
0x1.e264614f5a128a12761fa17adc74p-1L,
0x1.e502ee78b3ff6273d130153992d0p-1L,
0x1.e7a51fbc74c834b548b2832378a4p-1L,
0x1.ea4afa2a490d9858f73a18f5dab4p-1L,
0x1.ecf482d8e67f08db0312fb949d50p-1L,
0x1.efa1bee615a27771fd21a92dabb6p-1L,
0x1.f252b376bba974e8696fc3638f24p-1L,
0x1.f50765b6e4540674f84b762861a6p-1L,
0x1.f7bfdad9cbe138913b4bfe72bd78p-1L,
0x1.fa7c1819e90d82e90a7e74b26360p-1L,
0x1.fd3c22b8f71f10975ba4b32bd006p-1L,
0x1.0000000000000000000000000000p+0L,
0x1.0163da9fb33356d84a66ae336e98p+0L,
0x1.02c9a3e778060ee6f7caca4f7a18p+0L,
0x1.04315e86e7f84bd738f9a20da442p+0L,
0x1.059b0d31585743ae7c548eb68c6ap+0L,
0x1.0706b29ddf6ddc6dc403a9d87b1ep+0L,
0x1.0874518759bc808c35f25d942856p+0L,
0x1.09e3ecac6f3834521e060c584d5cp+0L,
0x1.0b5586cf9890f6298b92b7184200p+0L,
0x1.0cc922b7247f7407b705b893dbdep+0L,
0x1.0e3ec32d3d1a2020742e4f8af794p+0L,
0x1.0fb66affed31af232091dd8a169ep+0L,
0x1.11301d0125b50a4ebbf1aed9321cp+0L,
0x1.12abdc06c31cbfb92bad324d6f84p+0L,
0x1.1429aaea92ddfb34101943b2588ep+0L,
0x1.15a98c8a58e512480d573dd562aep+0L,
0x1.172b83c7d517adcdf7c8c50eb162p+0L,
0x1.18af9388c8de9bbbf70b9a3c269cp+0L,
0x1.1a35beb6fcb753cb698f692d2038p+0L,
0x1.1bbe084045cd39ab1e72b442810ep+0L,
0x1.1d4873168b9aa7805b8028990be8p+0L,
0x1.1ed5022fcd91cb8819ff61121fbep+0L,
0x1.2063b88628cd63b8eeb0295093f6p+0L,
0x1.21f49917ddc962552fd29294bc20p+0L,
0x1.2387a6e75623866c1fadb1c159c0p+0L,
0x1.251ce4fb2a63f3582ab7de9e9562p+0L,
0x1.26b4565e27cdd257a673281d3068p+0L,
0x1.284dfe1f5638096cf15cf03c9fa0p+0L,
0x1.29e9df51fdee12c25d15f5a25022p+0L,
0x1.2b87fd0dad98ffddea46538fca24p+0L,
0x1.2d285a6e4030b40091d536d0733ep+0L,
0x1.2ecafa93e2f5611ca0f45d5239a4p+0L,
0x1.306fe0a31b7152de8d5a463063bep+0L,
0x1.32170fc4cd8313539cf1c3009330p+0L,
0x1.33c08b26416ff4c9c8610d96680ep+0L,
0x1.356c55f929ff0c94623476373be4p+0L,
0x1.371a7373aa9caa7145502f45452ap+0L,
0x1.38cae6d05d86585a9cb0d9bed530p+0L,
0x1.3a7db34e59ff6ea1bc9299e0a1fep+0L,
0x1.3c32dc313a8e484001f228b58cf0p+0L,
0x1.3dea64c12342235b41223e13d7eep+0L,
0x1.3fa4504ac801ba0bf701aa417b9cp+0L,
0x1.4160a21f72e29f84325b8f3dbacap+0L,
0x1.431f5d950a896dc704439410b628p+0L,
0x1.44e086061892d03136f409df0724p+0L,
0x1.46a41ed1d005772512f459229f0ap+0L,
0x1.486a2b5c13cd013c1a3b69062f26p+0L,
0x1.4a32af0d7d3de672d8bcf46f99b4p+0L,
0x1.4bfdad5362a271d4397afec42e36p+0L,
0x1.4dcb299fddd0d63b36ef1a9e19dep+0L,
0x1.4f9b2769d2ca6ad33d8b69aa0b8cp+0L,
0x1.516daa2cf6641c112f52c84d6066p+0L,
0x1.5342b569d4f81df0a83c49d86bf4p+0L,
0x1.551a4ca5d920ec52ec620243540cp+0L,
0x1.56f4736b527da66ecb004764e61ep+0L,
0x1.58d12d497c7fd252bc2b7343d554p+0L,
0x1.5ab07dd48542958c93015191e9a8p+0L,
0x1.5c9268a5946b701c4b1b81697ed4p+0L,
0x1.5e76f15ad21486e9be4c20399d12p+0L,
0x1.605e1b976dc08b076f592a487066p+0L,
0x1.6247eb03a5584b1f0fa06fd2d9eap+0L,
0x1.6434634ccc31fc76f8714c4ee122p+0L,
0x1.66238825522249127d9e29b92ea2p+0L,
0x1.68155d44ca973081c57227b9f69ep+0L,
};
static const float eps[TBLSIZE] = {
-0x1.5c50p-101,
-0x1.5d00p-106,
0x1.8e90p-102,
-0x1.5340p-103,
0x1.1bd0p-102,
-0x1.4600p-105,
-0x1.7a40p-104,
0x1.d590p-102,
-0x1.d590p-101,
0x1.b100p-103,
-0x1.0d80p-105,
0x1.6b00p-103,
-0x1.9f00p-105,
0x1.c400p-103,
0x1.e120p-103,
-0x1.c100p-104,
-0x1.9d20p-103,
0x1.a800p-108,
0x1.4c00p-106,
-0x1.9500p-106,
0x1.6900p-105,
-0x1.29d0p-100,
0x1.4c60p-103,
0x1.13a0p-102,
-0x1.5b60p-103,
-0x1.1c40p-103,
0x1.db80p-102,
0x1.91a0p-102,
0x1.dc00p-105,
0x1.44c0p-104,
0x1.9710p-102,
0x1.8760p-103,
-0x1.a720p-103,
0x1.ed20p-103,
-0x1.49c0p-102,
-0x1.e000p-111,
0x1.86a0p-103,
0x1.2b40p-103,
-0x1.b400p-108,
0x1.1280p-99,
-0x1.02d8p-102,
-0x1.e3d0p-103,
-0x1.b080p-105,
-0x1.f100p-107,
-0x1.16c0p-105,
-0x1.1190p-103,
-0x1.a7d2p-100,
0x1.3450p-103,
-0x1.67c0p-105,
0x1.4b80p-104,
-0x1.c4e0p-103,
0x1.6000p-108,
-0x1.3f60p-105,
0x1.93f0p-104,
0x1.5fe0p-105,
0x1.6f80p-107,
-0x1.7600p-106,
0x1.21e0p-106,
-0x1.3a40p-106,
-0x1.40c0p-104,
-0x1.9860p-105,
-0x1.5d40p-108,
-0x1.1d70p-106,
0x1.2760p-105,
0x0.0000p+0,
0x1.21e2p-104,
-0x1.9520p-108,
-0x1.5720p-106,
-0x1.4810p-106,
-0x1.be00p-109,
0x1.0080p-105,
-0x1.5780p-108,
-0x1.d460p-105,
-0x1.6140p-105,
0x1.4630p-104,
0x1.ad50p-103,
0x1.82e0p-105,
0x1.1d3cp-101,
0x1.6100p-107,
0x1.ec30p-104,
0x1.f200p-108,
0x1.0b40p-103,
0x1.3660p-102,
0x1.d9d0p-103,
-0x1.02d0p-102,
0x1.b070p-103,
0x1.b9c0p-104,
-0x1.01c0p-103,
-0x1.dfe0p-103,
0x1.1b60p-104,
-0x1.ae94p-101,
-0x1.3340p-104,
0x1.b3d8p-102,
-0x1.6e40p-105,
-0x1.3670p-103,
0x1.c140p-104,
0x1.1840p-101,
0x1.1ab0p-102,
-0x1.a400p-104,
0x1.1f00p-104,
-0x1.7180p-103,
0x1.4ce0p-102,
0x1.9200p-107,
-0x1.54c0p-103,
0x1.1b80p-105,
-0x1.1828p-101,
0x1.5720p-102,
-0x1.a060p-100,
0x1.9160p-102,
0x1.a280p-104,
0x1.3400p-107,
0x1.2b20p-102,
0x1.7800p-108,
0x1.cfd0p-101,
0x1.2ef0p-102,
-0x1.2760p-99,
0x1.b380p-104,
0x1.0048p-101,
-0x1.60b0p-102,
0x1.a1ccp-100,
-0x1.a640p-104,
-0x1.08a0p-101,
0x1.7e60p-102,
0x1.22c0p-103,
-0x1.7200p-106,
0x1.f0f0p-102,
0x1.eb4ep-99,
0x1.c6e0p-103,
};
/*
* exp2l(x): compute the base 2 exponential of x
*
* Accuracy: Peak error < 0.502 ulp.
*
* 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**-8 + 2**-98 for the table used.
*
* We compute exp2(i/TBLSIZE) via table lookup and exp2(z - eps[i]) via
* a degree-10 minimax polynomial with maximum error under 2**-120.
* 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**-122.
*
* Note that the range of i is +-TBLSIZE/2, so we actually index the tables
* by i0 = i + TBLSIZE/2.
*
* 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).
*/
long double
exp2l(long double x)
{
union ldshape u = {x};
int e = u.i.se & 0x7fff;
long double r, z, t;
uint32_t i0;
union {uint32_t u; int32_t i;} k;
/* Filter out exceptional cases. */
if (e >= 0x3fff + 14) { /* |x| >= 16384 or x is NaN */
if (u.i.se >= 0x3fff + 15 && u.i.se >> 15 == 0)
/* overflow */
return x * 0x1p16383L;
if (e == 0x7fff) /* -inf or -nan */
return -1/x;
if (x < -16382) {
if (x <= -16495 || x - 0x1p112 + 0x1p112 != x)
/* underflow */
FORCE_EVAL((float)(-0x1p-149/x));
if (x <= -16446)
return 0;
}
} else if (e < 0x3fff - 114) {
return 1 + x;
}
/*
* Reduce x, computing z, i0, and k. The low bits of x + redux
* contain the 16-bit integer part of the exponent (k) followed by
* TBLBITS fractional bits (i0). We use bit tricks to extract these
* as integers, then set z to the remainder.
*
* Example: Suppose x is 0xabc.123456p0 and TBLBITS is 8.
* Then the low-order word of x + redux is 0x000abc12,
* We split this into k = 0xabc and i0 = 0x12 (adjusted to
* index into the table), then we compute z = 0x0.003456p0.
*/
u.f = x + redux;
i0 = u.i2.lo + TBLSIZE / 2;
k.u = i0 / TBLSIZE * TBLSIZE;
k.i /= TBLSIZE;
i0 %= TBLSIZE;
u.f -= redux;
z = x - u.f;
/* Compute r = exp2(y) = exp2t[i0] * p(z - eps[i]). */
t = tbl[i0];
z -= eps[i0];
r = t + t * z * (P1 + z * (P2 + z * (P3 + z * (P4 + z * (P5 + z * (P6
+ z * (P7 + z * (P8 + z * (P9 + z * P10)))))))));
return scalbnl(r, k.i);
}
#endif

182
libc/math/exp_data.c
View file

@ -1,182 +0,0 @@
/*
* Shared data between exp, exp2 and pow.
*
* Copyright (c) 2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#include "libc/math/exp_data.h"
#define N (1 << EXP_TABLE_BITS)
const struct exp_data __exp_data = {
// N/ln2
.invln2N = 0x1.71547652b82fep0 * N,
// -ln2/N
.negln2hiN = -0x1.62e42fefa0000p-8,
.negln2loN = -0x1.cf79abc9e3b3ap-47,
// Used for rounding when !TOINT_INTRINSICS
#if EXP_USE_TOINT_NARROW
.shift = 0x1800000000.8p0,
#else
.shift = 0x1.8p52,
#endif
// exp polynomial coefficients.
.poly = {
// abs error: 1.555*2^-66
// ulp error: 0.509 (0.511 without fma)
// if |x| < ln2/256+eps
// abs error if |x| < ln2/256+0x1p-15: 1.09*2^-65
// abs error if |x| < ln2/128: 1.7145*2^-56
0x1.ffffffffffdbdp-2,
0x1.555555555543cp-3,
0x1.55555cf172b91p-5,
0x1.1111167a4d017p-7,
},
.exp2_shift = 0x1.8p52 / N,
// exp2 polynomial coefficients.
.exp2_poly = {
// abs error: 1.2195*2^-65
// ulp error: 0.507 (0.511 without fma)
// if |x| < 1/256
// abs error if |x| < 1/128: 1.9941*2^-56
0x1.62e42fefa39efp-1,
0x1.ebfbdff82c424p-3,
0x1.c6b08d70cf4b5p-5,
0x1.3b2abd24650ccp-7,
0x1.5d7e09b4e3a84p-10,
},
// 2^(k/N) ~= H[k]*(1 + T[k]) for int k in [0,N)
// tab[2*k] = asuint64(T[k])
// tab[2*k+1] = asuint64(H[k]) - (k << 52)/N
.tab = {
0x0, 0x3ff0000000000000,
0x3c9b3b4f1a88bf6e, 0x3feff63da9fb3335,
0xbc7160139cd8dc5d, 0x3fefec9a3e778061,
0xbc905e7a108766d1, 0x3fefe315e86e7f85,
0x3c8cd2523567f613, 0x3fefd9b0d3158574,
0xbc8bce8023f98efa, 0x3fefd06b29ddf6de,
0x3c60f74e61e6c861, 0x3fefc74518759bc8,
0x3c90a3e45b33d399, 0x3fefbe3ecac6f383,
0x3c979aa65d837b6d, 0x3fefb5586cf9890f,
0x3c8eb51a92fdeffc, 0x3fefac922b7247f7,
0x3c3ebe3d702f9cd1, 0x3fefa3ec32d3d1a2,
0xbc6a033489906e0b, 0x3fef9b66affed31b,
0xbc9556522a2fbd0e, 0x3fef9301d0125b51,
0xbc5080ef8c4eea55, 0x3fef8abdc06c31cc,
0xbc91c923b9d5f416, 0x3fef829aaea92de0,
0x3c80d3e3e95c55af, 0x3fef7a98c8a58e51,
0xbc801b15eaa59348, 0x3fef72b83c7d517b,
0xbc8f1ff055de323d, 0x3fef6af9388c8dea,
0x3c8b898c3f1353bf, 0x3fef635beb6fcb75,
0xbc96d99c7611eb26, 0x3fef5be084045cd4,
0x3c9aecf73e3a2f60, 0x3fef54873168b9aa,
0xbc8fe782cb86389d, 0x3fef4d5022fcd91d,
0x3c8a6f4144a6c38d, 0x3fef463b88628cd6,
0x3c807a05b0e4047d, 0x3fef3f49917ddc96,
0x3c968efde3a8a894, 0x3fef387a6e756238,
0x3c875e18f274487d, 0x3fef31ce4fb2a63f,
0x3c80472b981fe7f2, 0x3fef2b4565e27cdd,
0xbc96b87b3f71085e, 0x3fef24dfe1f56381,
0x3c82f7e16d09ab31, 0x3fef1e9df51fdee1,
0xbc3d219b1a6fbffa, 0x3fef187fd0dad990,
0x3c8b3782720c0ab4, 0x3fef1285a6e4030b,
0x3c6e149289cecb8f, 0x3fef0cafa93e2f56,
0x3c834d754db0abb6, 0x3fef06fe0a31b715,
0x3c864201e2ac744c, 0x3fef0170fc4cd831,
0x3c8fdd395dd3f84a, 0x3feefc08b26416ff,
0xbc86a3803b8e5b04, 0x3feef6c55f929ff1,
0xbc924aedcc4b5068, 0x3feef1a7373aa9cb,
0xbc9907f81b512d8e, 0x3feeecae6d05d866,
0xbc71d1e83e9436d2, 0x3feee7db34e59ff7,
0xbc991919b3ce1b15, 0x3feee32dc313a8e5,
0x3c859f48a72a4c6d, 0x3feedea64c123422,
0xbc9312607a28698a, 0x3feeda4504ac801c,
0xbc58a78f4817895b, 0x3feed60a21f72e2a,
0xbc7c2c9b67499a1b, 0x3feed1f5d950a897,
0x3c4363ed60c2ac11, 0x3feece086061892d,
0x3c9666093b0664ef, 0x3feeca41ed1d0057,
0x3c6ecce1daa10379, 0x3feec6a2b5c13cd0,
0x3c93ff8e3f0f1230, 0x3feec32af0d7d3de,
0x3c7690cebb7aafb0, 0x3feebfdad5362a27,
0x3c931dbdeb54e077, 0x3feebcb299fddd0d,
0xbc8f94340071a38e, 0x3feeb9b2769d2ca7,
0xbc87deccdc93a349, 0x3feeb6daa2cf6642,
0xbc78dec6bd0f385f, 0x3feeb42b569d4f82,
0xbc861246ec7b5cf6, 0x3feeb1a4ca5d920f,
0x3c93350518fdd78e, 0x3feeaf4736b527da,
0x3c7b98b72f8a9b05, 0x3feead12d497c7fd,
0x3c9063e1e21c5409, 0x3feeab07dd485429,
0x3c34c7855019c6ea, 0x3feea9268a5946b7,
0x3c9432e62b64c035, 0x3feea76f15ad2148,
0xbc8ce44a6199769f, 0x3feea5e1b976dc09,
0xbc8c33c53bef4da8, 0x3feea47eb03a5585,
0xbc845378892be9ae, 0x3feea34634ccc320,
0xbc93cedd78565858, 0x3feea23882552225,
0x3c5710aa807e1964, 0x3feea155d44ca973,
0xbc93b3efbf5e2228, 0x3feea09e667f3bcd,
0xbc6a12ad8734b982, 0x3feea012750bdabf,
0xbc6367efb86da9ee, 0x3fee9fb23c651a2f,
0xbc80dc3d54e08851, 0x3fee9f7df9519484,
0xbc781f647e5a3ecf, 0x3fee9f75e8ec5f74,
0xbc86ee4ac08b7db0, 0x3fee9f9a48a58174,
0xbc8619321e55e68a, 0x3fee9feb564267c9,
0x3c909ccb5e09d4d3, 0x3feea0694fde5d3f,
0xbc7b32dcb94da51d, 0x3feea11473eb0187,
0x3c94ecfd5467c06b, 0x3feea1ed0130c132,
0x3c65ebe1abd66c55, 0x3feea2f336cf4e62,
0xbc88a1c52fb3cf42, 0x3feea427543e1a12,
0xbc9369b6f13b3734, 0x3feea589994cce13,
0xbc805e843a19ff1e, 0x3feea71a4623c7ad,
0xbc94d450d872576e, 0x3feea8d99b4492ed,
0x3c90ad675b0e8a00, 0x3feeaac7d98a6699,
0x3c8db72fc1f0eab4, 0x3feeace5422aa0db,
0xbc65b6609cc5e7ff, 0x3feeaf3216b5448c,
0x3c7bf68359f35f44, 0x3feeb1ae99157736,
0xbc93091fa71e3d83, 0x3feeb45b0b91ffc6,
0xbc5da9b88b6c1e29, 0x3feeb737b0cdc5e5,
0xbc6c23f97c90b959, 0x3feeba44cbc8520f,
0xbc92434322f4f9aa, 0x3feebd829fde4e50,
0xbc85ca6cd7668e4b, 0x3feec0f170ca07ba,
0x3c71affc2b91ce27, 0x3feec49182a3f090,
0x3c6dd235e10a73bb, 0x3feec86319e32323,
0xbc87c50422622263, 0x3feecc667b5de565,
0x3c8b1c86e3e231d5, 0x3feed09bec4a2d33,
0xbc91bbd1d3bcbb15, 0x3feed503b23e255d,
0x3c90cc319cee31d2, 0x3feed99e1330b358,
0x3c8469846e735ab3, 0x3feede6b5579fdbf,
0xbc82dfcd978e9db4, 0x3feee36bbfd3f37a,
0x3c8c1a7792cb3387, 0x3feee89f995ad3ad,
0xbc907b8f4ad1d9fa, 0x3feeee07298db666,
0xbc55c3d956dcaeba, 0x3feef3a2b84f15fb,
0xbc90a40e3da6f640, 0x3feef9728de5593a,
0xbc68d6f438ad9334, 0x3feeff76f2fb5e47,
0xbc91eee26b588a35, 0x3fef05b030a1064a,
0x3c74ffd70a5fddcd, 0x3fef0c1e904bc1d2,
0xbc91bdfbfa9298ac, 0x3fef12c25bd71e09,
0x3c736eae30af0cb3, 0x3fef199bdd85529c,
0x3c8ee3325c9ffd94, 0x3fef20ab5fffd07a,
0x3c84e08fd10959ac, 0x3fef27f12e57d14b,
0x3c63cdaf384e1a67, 0x3fef2f6d9406e7b5,
0x3c676b2c6c921968, 0x3fef3720dcef9069,
0xbc808a1883ccb5d2, 0x3fef3f0b555dc3fa,
0xbc8fad5d3ffffa6f, 0x3fef472d4a07897c,
0xbc900dae3875a949, 0x3fef4f87080d89f2,
0x3c74a385a63d07a7, 0x3fef5818dcfba487,
0xbc82919e2040220f, 0x3fef60e316c98398,
0x3c8e5a50d5c192ac, 0x3fef69e603db3285,
0x3c843a59ac016b4b, 0x3fef7321f301b460,
0xbc82d52107b43e1f, 0x3fef7c97337b9b5f,
0xbc892ab93b470dc9, 0x3fef864614f5a129,
0x3c74b604603a88d3, 0x3fef902ee78b3ff6,
0x3c83c5ec519d7271, 0x3fef9a51fbc74c83,
0xbc8ff7128fd391f0, 0x3fefa4afa2a490da,
0xbc8dae98e223747d, 0x3fefaf482d8e67f1,
0x3c8ec3bc41aa2008, 0x3fefba1bee615a27,
0x3c842b94c3a9eb32, 0x3fefc52b376bba97,
0x3c8a64a931d185ee, 0x3fefd0765b6e4540,
0xbc8e37bae43be3ed, 0x3fefdbfdad9cbe14,
0x3c77893b4d91cd9d, 0x3fefe7c1819e90d8,
0x3c5305c14160cc89, 0x3feff3c22b8f71f1,
},
};

24
libc/math/exp_data.h
View file

@ -1,24 +0,0 @@
/*
* Copyright (c) 2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#ifndef _EXP_DATA_H
#define _EXP_DATA_H
#define EXP_TABLE_BITS 7
#define EXP_POLY_ORDER 5
#define EXP_USE_TOINT_NARROW 0
#define EXP2_POLY_ORDER 5
extern const struct exp_data {
double invln2N;
double shift;
double negln2hiN;
double negln2loN;
double poly[4]; /* Last four coefficients. */
double exp2_shift;
double exp2_poly[EXP2_POLY_ORDER];
uint64_t tab[2*(1 << EXP_TABLE_BITS)];
} __exp_data;
#endif

79
libc/math/expf.c
View file

@ -1,79 +0,0 @@
/*
* Single-precision e^x function.
*
* Copyright (c) 2017-2018, Arm Limited.
* SPDX-License-Identifier: MIT
*/
#include "libc/math/math.h"
#include "libc/math/libm.h"
#include "libc/math/exp2f_data.h"
/*
EXP2F_TABLE_BITS = 5
EXP2F_POLY_ORDER = 3
ULP error: 0.502 (nearest rounding.)
Relative error: 1.69 * 2^-34 in [-ln2/64, ln2/64] (before rounding.)
Wrong count: 170635 (all nearest rounding wrong results with fma.)
Non-nearest ULP error: 1 (rounded ULP error)
*/
#define N (1 << EXP2F_TABLE_BITS)
#define InvLn2N __exp2f_data.invln2_scaled
#define T __exp2f_data.tab
#define C __exp2f_data.poly_scaled
static inline uint32_t top12(float x)
{
return asuint(x) >> 20;
}
float expf(float x)
{
uint32_t abstop;
uint64_t ki, t;
double_t kd, xd, z, r, r2, y, s;
xd = (double_t)x;
abstop = top12(x) & 0x7ff;
if (predict_false(abstop >= top12(88.0f))) {
/* |x| >= 88 or x is nan. */
if (asuint(x) == asuint(-INFINITY))
return 0.0f;
if (abstop >= top12(INFINITY))
return x + x;
if (x > 0x1.62e42ep6f) /* x > log(0x1p128) ~= 88.72 */
return __math_oflowf(0);
if (x < -0x1.9fe368p6f) /* x < log(0x1p-150) ~= -103.97 */
return __math_uflowf(0);
}
/* x*N/Ln2 = k + r with r in [-1/2, 1/2] and int k. */
z = InvLn2N * xd;
/* Round and convert z to int, the result is in [-150*N, 128*N] and
ideally ties-to-even rule is used, otherwise the magnitude of r
can be bigger which gives larger approximation error. */
#if TOINT_INTRINSICS
kd = roundtoint(z);
ki = converttoint(z);
#else
# define SHIFT __exp2f_data.shift
kd = eval_as_double(z + SHIFT);
ki = asuint64(kd);
kd -= SHIFT;
#endif
r = z - kd;
/* exp(x) = 2^(k/N) * 2^(r/N) ~= s * (C0*r^3 + C1*r^2 + C2*r + 1) */
t = T[ki % N];
t += ki << (52 - EXP2F_TABLE_BITS);
s = asdouble(t);
z = C[0] * r + C[1];
r2 = r * r;
y = C[2] * r + 1;
y = z * r2 + y;
y = y * s;
return eval_as_float(y);
}

128
libc/math/expl.c
View file

@ -1,128 +0,0 @@
/* 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 5/6 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 "libc/math/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 const long double P[3] = {
1.2617719307481059087798E-4L,
3.0299440770744196129956E-2L,
9.9999999999999999991025E-1L,
};
static const long double Q[4] = {
3.0019850513866445504159E-6L,
2.5244834034968410419224E-3L,
2.2726554820815502876593E-1L,
2.0000000000000000000897E0L,
};
static const long double
LN2HI = 6.9314575195312500000000E-1L,
LN2LO = 1.4286068203094172321215E-6L,
LOG2E = 1.4426950408889634073599E0L;
long double expl(long double x)
{
long double px, xx;
int k;
if (isnan(x))
return x;
if (x > 11356.5234062941439488L) /* x > ln(2^16384 - 0.5) */
return x * 0x1p16383L;
if (x < -11399.4985314888605581L) /* x < ln(2^-16446) */
return -0x1p-16445L/x;
/* Express e**x = e**f 2**k
* = e**(f + k ln(2))
*/
px = floorl(LOG2E * x + 0.5);
k = px;
x -= px * LN2HI;
x -= px * LN2LO;
/* rational approximation of the fractional part:
* e**x = 1 + 2x P(x**2)/(Q(x**2) - x P(x**2))
*/
xx = x * x;
px = x * __polevll(xx, P, 2);
x = px/(__polevll(xx, Q, 3) - px);
x = 1.0 + 2.0 * x;
return scalbnl(x, k);
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
// TODO: broken implementation to make things compile
long double expl(long double x)
{
return exp(x);
}
#endif

201
libc/math/expm1.c
View file

@ -1,201 +0,0 @@
/* origin: FreeBSD /usr/src/lib/msun/src/s_expm1.c */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunPro, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* expm1(x)
* Returns exp(x)-1, the exponential of x minus 1.
*
* Method
* 1. Argument reduction:
* Given x, find r and integer k such that
*
* x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658
*
* Here a correction term c will be computed to compensate
* the error in r when rounded to a floating-point number.
*
* 2. Approximating expm1(r) by a special rational function on
* the interval [0,0.34658]:
* Since
* r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ...
* we define R1(r*r) by
* r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r)
* That is,
* R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r)
* = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r))
* = 1 - r^2/60 + r^4/2520 - r^6/100800 + ...
* We use a special Remez algorithm on [0,0.347] to generate
* a polynomial of degree 5 in r*r to approximate R1. The
* maximum error of this polynomial approximation is bounded
* by 2**-61. In other words,
* R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5
* where Q1 = -1.6666666666666567384E-2,
* Q2 = 3.9682539681370365873E-4,
* Q3 = -9.9206344733435987357E-6,
* Q4 = 2.5051361420808517002E-7,
* Q5 = -6.2843505682382617102E-9;
* z = r*r,
* with error bounded by
* | 5 | -61
* | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2
* | |
*
* expm1(r) = exp(r)-1 is then computed by the following
* specific way which minimize the accumulation rounding error:
* 2 3
* r r [ 3 - (R1 + R1*r/2) ]
* expm1(r) = r + --- + --- * [--------------------]
* 2 2 [ 6 - r*(3 - R1*r/2) ]
*
* To compensate the error in the argument reduction, we use
* expm1(r+c) = expm1(r) + c + expm1(r)*c
* ~ expm1(r) + c + r*c
* Thus c+r*c will be added in as the correction terms for
* expm1(r+c). Now rearrange the term to avoid optimization
* screw up:
* ( 2 2 )
* ({ ( r [ R1 - (3 - R1*r/2) ] ) } r )
* expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- )
* ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 )
* ( )
*
* = r - E
* 3. Scale back to obtain expm1(x):
* From step 1, we have
* expm1(x) = either 2^k*[expm1(r)+1] - 1
* = or 2^k*[expm1(r) + (1-2^-k)]
* 4. Implementation notes:
* (A). To save one multiplication, we scale the coefficient Qi
* to Qi*2^i, and replace z by (x^2)/2.
* (B). To achieve maximum accuracy, we compute expm1(x) by
* (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf)
* (ii) if k=0, return r-E
* (iii) if k=-1, return 0.5*(r-E)-0.5
* (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E)
* else return 1.0+2.0*(r-E);
* (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1)
* (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else
* (vii) return 2^k(1-((E+2^-k)-r))
*
* Special cases:
* expm1(INF) is INF, expm1(NaN) is NaN;
* expm1(-INF) is -1, and
* for finite argument, only expm1(0)=0 is exact.
*
* Accuracy:
* according to an error analysis, the error is always less than
* 1 ulp (unit in the last place).
*
* Misc. info.
* For IEEE double
* if x > 7.09782712893383973096e+02 then expm1(x) overflow
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "libc/math/libm.h"
static const double
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_t y,hi,lo,c,t,e,hxs,hfx,r1,twopk;
union {double f; uint64_t i;} u = {x};
uint32_t hx = u.i>>32 & 0x7fffffff;
int k, sign = u.i>>63;
/* filter out huge and non-finite argument */
if (hx >= 0x4043687A) { /* if |x|>=56*ln2 */
if (isnan(x))
return x;
if (sign)
return -1;
if (x > o_threshold) {
x *= 0x1p1023;
return x;
}
}
/* argument reduction */
if (hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
if (hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
if (!sign) {
hi = x - ln2_hi;
lo = ln2_lo;
k = 1;
} else {
hi = x + ln2_hi;
lo = -ln2_lo;
k = -1;
}
} else {
k = invln2*x + (sign ? -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) { /* |x| < 2**-54, return x */
if (hx < 0x00100000)
FORCE_EVAL((float)x);
return x;
} else
k = 0;
/* x is now in primary range */
hfx = 0.5*x;
hxs = x*hfx;
r1 = 1.0+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);
e = x*(e-c) - c;
e -= hxs;
/* exp(x) ~ 2^k (x_reduced - e + 1) */
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 1.0+2.0*(x-e);
}
u.i = (uint64_t)(0x3ff + k)<<52; /* 2^k */
twopk = u.f;
if (k < 0 || k > 56) { /* suffice to return exp(x)-1 */
y = x - e + 1.0;
if (k == 1024)
y = y*2.0*0x1p1023;
else
y = y*twopk;
return y - 1.0;
}
u.i = (uint64_t)(0x3ff - k)<<52; /* 2^-k */
if (k < 20)
y = (x-e+(1-u.f))*twopk;
else
y = (x-(e+u.f)+1)*twopk;
return y;
}

111
libc/math/expm1f.c
View file

@ -1,111 +0,0 @@
/* 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 "libc/math/libm.h"
static const float
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_t y,hi,lo,c,t,e,hxs,hfx,r1,twopk;
union {float f; uint32_t i;} u = {x};
uint32_t hx = u.i & 0x7fffffff;
int k, sign = u.i >> 31;
/* filter out huge and non-finite argument */
if (hx >= 0x4195b844) { /* if |x|>=27*ln2 */
if (hx > 0x7f800000) /* NaN */
return x;
if (sign)
return -1;
if (x > o_threshold) {
x *= 0x1p127f;
return x;
}
}
/* argument reduction */
if (hx > 0x3eb17218) { /* if |x| > 0.5 ln2 */
if (hx < 0x3F851592) { /* and |x| < 1.5 ln2 */
if (!sign) {
hi = x - ln2_hi;
lo = ln2_lo;
k = 1;
} else {
hi = x + ln2_hi;
lo = -ln2_lo;
k = -1;
}
} else {
k = invln2*x + (sign ? -0.5f : 0.5f);
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 */
if (hx < 0x00800000)
FORCE_EVAL(x*x);
return x;
} else
k = 0;
/* x is now in primary range */
hfx = 0.5f*x;
hxs = x*hfx;
r1 = 1.0f+hxs*(Q1+hxs*Q2);
t = 3.0f - r1*hfx;
e = hxs*((r1-t)/(6.0f - x*t));
if (k == 0) /* c is 0 */
return x - (x*e-hxs);
e = x*(e-c) - c;
e -= hxs;
/* exp(x) ~ 2^k (x_reduced - e + 1) */
if (k == -1)
return 0.5f*(x-e) - 0.5f;
if (k == 1) {
if (x < -0.25f)
return -2.0f*(e-(x+0.5f));
return 1.0f + 2.0f*(x-e);
}
u.i = (0x7f+k)<<23; /* 2^k */
twopk = u.f;
if (k < 0 || k > 56) { /* suffice to return exp(x)-1 */
y = x - e + 1.0f;
if (k == 128)
y = y*2.0f*0x1p127f;
else
y = y*twopk;
return y - 1.0f;
}
u.i = (0x7f-k)<<23; /* 2^-k */
if (k < 23)
y = (x-e+(1-u.f))*twopk;
else
y = (x-(e+u.f)+1)*twopk;
return y;
}

123
libc/math/expm1l.c
View file

@ -1,123 +0,0 @@
/* 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,+maxarg 200,000 1.2e-19 2.5e-20
*/
#include "libc/math/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
/* 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,
/* ln 2^16384 */
maxarg = 1.1356523406294143949492E4L;
long double expm1l(long double x)
{
long double px, qx, xx;
int k;
if (isnan(x))
return x;
if (x > maxarg)
return x*0x1p16383L; /* overflow, unless x==inf */
if (x == 0.0)
return x;
if (x < minarg)
return -1.0;
xx = C1 + C2;
/* Express x = ln 2 (k + remainder), remainder not exceeding 1/2. */
px = floorl(0.5 + x / xx);
k = px;
/* remainder times ln 2 */
x -= px * C1;
x -= px * C2;
/* Approximate exp(remainder ln 2).*/
px = (((( P4 * x + P3) * x + P2) * x + P1) * x + P0) * x;
qx = (((( x + Q4) * x + Q3) * x + Q2) * x + Q1) * x + Q0;
xx = x * x;
qx = x + (0.5 * xx + xx * px / qx);
/* exp(x) = exp(k ln 2) exp(remainder ln 2) = 2^k exp(remainder ln 2).
We have qx = exp(remainder ln 2) - 1, so
exp(x) - 1 = 2^k (qx + 1) - 1 = 2^k qx + 2^k - 1. */
px = scalbnl(1.0, k);
x = px * qx + (px - 1.0);
return x;
}
#elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384
// TODO: broken implementation to make things compile
long double expm1l(long double x)
{
return expm1(x);
}
#endif

10
libc/math/fabs.c
View file

@ -1,10 +0,0 @@
#include "libc/math/math.h"
double fabs(double x) {
union {
double f;
uint64_t i;
} u = {x};
u.i &= -1ULL / 2;
return u.f;
}

8
libc/math/fabsf.c
View file

@ -1,8 +0,0 @@
#include "libc/math/math.h"
float fabsf(float x)
{
union {float f; uint32_t i;} u = {x};
u.i &= 0x7fffffff;
return u.f;
}

15
libc/math/fabsl.c
View file

@ -1,15 +0,0 @@
#include "libc/math/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.i.se &= 0x7fff;
return u.f;
}
#endif

10
libc/math/fdim.c
View file

@ -1,10 +0,0 @@
#include "libc/math/math.h"
double fdim(double x, double y)
{
if (isnan(x))
return x;
if (isnan(y))
return y;
return x > y ? x - y : 0;
}

10
libc/math/fdimf.c
View file

@ -1,10 +0,0 @@
#include "libc/math/math.h"
float fdimf(float x, float y)
{
if (isnan(x))
return x;
if (isnan(y))
return y;
return x > y ? x - y : 0;
}

17
libc/math/fdiml.c
View file

@ -1,17 +0,0 @@
#include "libc/math/math.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

20
libc/math/feclearexcept.S
View file

@ -1,20 +0,0 @@
.global feclearexcept
.type feclearexcept,@function
feclearexcept:
# maintain exceptions in the sse mxcsr, clear x87 exceptions
mov %edi,%ecx
and $0x3f,%ecx
fnstsw %ax
test %eax,%ecx
jz 1f
fnclex
1: stmxcsr -8(%rsp)
and $0x3f,%eax
or %eax,-8(%rsp)
test %ecx,-8(%rsp)
jz 1f
not %ecx
and %ecx,-8(%rsp)
ldmxcsr -8(%rsp)
1: xor %eax,%eax
ret

Some files were not shown because too many files have changed in this diff Show more