nishi/milsko
1
Fork 0
mirror of https://gitea.nishi.boats/pyrite-dev/milsko synced 2026-01-05 00:50:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

add fdlibm

Browse Source 
git-svn-id: http://svn2.nishi.boats/svn/milsko/trunk@557 b9cfdab3-6d41-4d17-bbe4-086880011989
This commit is contained in:
NishiOwO
2025-11-01 15:48:47 +00:00
parent ac87fbdd35
commit 7f523a3d76
90 changed files with 7328 additions and 312 deletions
Download Patch File Download Diff File Expand all files Collapse all files

96
external/fdlibm/e_acos.c vendored Normal file
View File

@@ -0,0 +1,96 @@
/* @(#)e_acos.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_acos(x)
* Method :
* acos(x) = pi/2 - asin(x)
* acos(-x) = pi/2 + asin(x)
* For |x|<=0.5
* acos(x) = pi/2 - (x + x*x^2*R(x^2)) (see asin.c)
* For x>0.5
* acos(x) = pi/2 - (pi/2 - 2asin(sqrt((1-x)/2)))
* = 2asin(sqrt((1-x)/2))
* = 2s + 2s*z*R(z) ...z=(1-x)/2, s=sqrt(z)
* = 2f + (2c + 2s*z*R(z))
* where f=hi part of s, and c = (z-f*f)/(s+f) is the correction term
* for f so that f+c ~ sqrt(z).
* For x<-0.5
* acos(x) = pi - 2asin(sqrt((1-|x|)/2))
* = pi - 0.5*(s+s*z*R(z)), where z=(1-|x|)/2,s=sqrt(z)
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN with invalid signal.
*
* Function needed: sqrt
*/
#include "math.h"
static const double
one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
double __fdlibm_acos(double x) {
double z, p, q, r, w, s, c, df;
int hx, ix;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x3ff00000) { /* |x| >= 1 */
if(((ix - 0x3ff00000) | __LO(x)) == 0) { /* |x|==1 */
if(hx > 0) return 0.0; /* acos(1) = 0 */
else
return pi + 2.0 * pio2_lo; /* acos(-1)= pi */
}
return (x - x) / (x - x); /* acos(|x|>1) is NaN */
}
if(ix < 0x3fe00000) { /* |x| < 0.5 */
if(ix <= 0x3c600000) return pio2_hi + pio2_lo; /*if|x|<2**-57*/
z = x * x;
p = z * (pS0 + z * (pS1 + z * (pS2 + z * (pS3 + z * (pS4 + z * pS5)))));
q = one + z * (qS1 + z * (qS2 + z * (qS3 + z * qS4)));
r = p / q;
return pio2_hi - (x - (pio2_lo - x * r));
} else if(hx < 0) { /* x < -0.5 */
z = (one + x) * 0.5;
p = z * (pS0 + z * (pS1 + z * (pS2 + z * (pS3 + z * (pS4 + z * pS5)))));
q = one + z * (qS1 + z * (qS2 + z * (qS3 + z * qS4)));
s = sqrt(z);
r = p / q;
w = r * s - pio2_lo;
return pi - 2.0 * (s + w);
} else { /* x > 0.5 */
z = (one - x) * 0.5;
s = sqrt(z);
df = s;
__LO(df) = 0;
c = (z - df * df) / (s + df);
p = z * (pS0 + z * (pS1 + z * (pS2 + z * (pS3 + z * (pS4 + z * pS5)))));
q = one + z * (qS1 + z * (qS2 + z * (qS3 + z * qS4)));
r = p / q;
w = r * s + c;
return 2.0 * (df + w);
}
}

55
external/fdlibm/e_acosh.c vendored Normal file
View File

@@ -0,0 +1,55 @@
/* @(#)e_acosh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_acosh(x)
* Method :
* Based on
* acosh(x) = log [ x + sqrt(x*x-1) ]
* we have
* acosh(x) := log(x)+ln2, if x is large; else
* acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else
* acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1.
*
* Special cases:
* acosh(x) is NaN with signal if x<1.
* acosh(NaN) is NaN without signal.
*/
#include "math.h"
static const double
one = 1.0,
ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */
double __fdlibm_acosh(double x) {
double t;
int hx;
hx = __HI(x);
if(hx < 0x3ff00000) { /* x < 1 */
return (x - x) / (x - x);
} else if(hx >= 0x41b00000) { /* x > 2**28 */
if(hx >= 0x7ff00000) { /* x is inf of NaN */
return x + x;
} else
return __fdlibm_log(x) + ln2; /* acosh(hugev)=log(2x) */
} else if(((hx - 0x3ff00000) | __LO(x)) == 0) {
return 0.0; /* acosh(1) = 0 */
} else if(hx > 0x40000000) { /* 2**28 > x > 2 */
t = x * x;
return __fdlibm_log(2.0 * x - one / (x + sqrt(t - one)));
} else { /* 1<x<2 */
t = x - one;
return log1p(t + sqrt(2.0 * t + t * t));
}
}

105
external/fdlibm/e_asin.c vendored Normal file
View File

@@ -0,0 +1,105 @@
/* @(#)e_asin.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_asin(x)
* Method :
* Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ...
* we approximate asin(x) on [0,0.5] by
* asin(x) = x + x*x^2*R(x^2)
* where
* R(x^2) is a rational approximation of (asin(x)-x)/x^3
* and its remez error is bounded by
* |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75)
*
* For x in [0.5,1]
* asin(x) = pi/2-2*asin(sqrt((1-x)/2))
* Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2;
* then for x>0.98
* asin(x) = pi/2 - 2*(s+s*z*R(z))
* = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo)
* For x<=0.98, let pio4_hi = pio2_hi/2, then
* f = hi part of s;
* c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z)
* and
* asin(x) = pi/2 - 2*(s+s*z*R(z))
* = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo)
* = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c))
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN with invalid signal.
*
*/
#include "math.h"
static const double
one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
hugev = 1.000e+300,
pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */
/* coefficient for R(x^2) */
pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
double __fdlibm_asin(double x) {
double t, w, p, q, c, r, s;
int hx, ix;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x3ff00000) { /* |x|>= 1 */
if(((ix - 0x3ff00000) | __LO(x)) == 0)
/* asin(1)=+-pi/2 with inexact */
return x * pio2_hi + x * pio2_lo;
return (x - x) / (x - x); /* asin(|x|>1) is NaN */
} else if(ix < 0x3fe00000) { /* |x|<0.5 */
if(ix < 0x3e400000) { /* if |x| < 2**-27 */
if(hugev + x > one) return x; /* return x with inexact if x!=0*/
} else
t = x * x;
p = t * (pS0 + t * (pS1 + t * (pS2 + t * (pS3 + t * (pS4 + t * pS5)))));
q = one + t * (qS1 + t * (qS2 + t * (qS3 + t * qS4)));
w = p / q;
return x + x * w;
}
/* 1> |x|>= 0.5 */
w = one - fabs(x);
t = w * 0.5;
p = t * (pS0 + t * (pS1 + t * (pS2 + t * (pS3 + t * (pS4 + t * pS5)))));
q = one + t * (qS1 + t * (qS2 + t * (qS3 + t * qS4)));
s = sqrt(t);
if(ix >= 0x3FEF3333) { /* if |x| > 0.975 */
w = p / q;
t = pio2_hi - (2.0 * (s + s * w) - pio2_lo);
} else {
w = s;
__LO(w) = 0;
c = (t - w * w) / (s + w);
r = p / q;
p = 2.0 * s * r - (pio2_lo - 2.0 * c);
q = pio4_hi - 2.0 * w;
t = pio4_hi - (p - q);
}
if(hx > 0) return t;
else
return -t;
}

131
external/fdlibm/e_atan2.c vendored Normal file
View File

@@ -0,0 +1,131 @@
/* @(#)e_atan2.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_atan2(y,x)
* Method :
* 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
* 2. Reduce x to positive by (if x and y are unexceptional):
* ARG (x+iy) = arctan(y/x) ... if x > 0,
* ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
*
* Special cases:
*
* ATAN2((anything), NaN ) is NaN;
* ATAN2(NAN , (anything) ) is NaN;
* ATAN2(+-0, +(anything but NaN)) is +-0 ;
* ATAN2(+-0, -(anything but NaN)) is +-pi ;
* ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2;
* ATAN2(+-(anything but INF and NaN), +INF) is +-0 ;
* ATAN2(+-(anything but INF and NaN), -INF) is +-pi;
* ATAN2(+-INF,+INF ) is +-pi/4 ;
* ATAN2(+-INF,-INF ) is +-3pi/4;
* ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2;
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const double
tinyv = 1.0e-300,
zero = 0.0,
pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */
pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */
pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */
pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */
double __fdlibm_atan2(double y, double x) {
double z;
int k, m, hx, hy, ix, iy;
unsigned lx, ly;
hx = __HI(x);
ix = hx & 0x7fffffff;
lx = __LO(x);
hy = __HI(y);
iy = hy & 0x7fffffff;
ly = __LO(y);
if(((ix | ((lx | -lx) >> 31)) > 0x7ff00000) ||
((iy | ((ly | -ly) >> 31)) > 0x7ff00000)) /* x or y is NaN */
return x + y;
if((hx - 0x3ff00000 | lx) == 0) return atan(y); /* x=1.0 */
m = ((hy >> 31) & 1) | ((hx >> 30) & 2); /* 2*sign(x)+sign(y) */
/* when y = 0 */
if((iy | ly) == 0) {
switch(m) {
case 0:
case 1:
return y; /* atan(+-0,+anything)=+-0 */
case 2:
return pi + tinyv; /* atan(+0,-anything) = pi */
case 3:
return -pi - tinyv; /* atan(-0,-anything) =-pi */
}
}
/* when x = 0 */
if((ix | lx) == 0) return (hy < 0) ? -pi_o_2 - tinyv : pi_o_2 + tinyv;
/* when x is INF */
if(ix == 0x7ff00000) {
if(iy == 0x7ff00000) {
switch(m) {
case 0:
return pi_o_4 + tinyv; /* atan(+INF,+INF) */
case 1:
return -pi_o_4 - tinyv; /* atan(-INF,+INF) */
case 2:
return 3.0 * pi_o_4 + tinyv; /*atan(+INF,-INF)*/
case 3:
return -3.0 * pi_o_4 - tinyv; /*atan(-INF,-INF)*/
}
} else {
switch(m) {
case 0:
return zero; /* atan(+...,+INF) */
case 1:
return -zero; /* atan(-...,+INF) */
case 2:
return pi + tinyv; /* atan(+...,-INF) */
case 3:
return -pi - tinyv; /* atan(-...,-INF) */
}
}
}
/* when y is INF */
if(iy == 0x7ff00000) return (hy < 0) ? -pi_o_2 - tinyv : pi_o_2 + tinyv;
/* compute y/x */
k = (iy - ix) >> 20;
if(k > 60) z = pi_o_2 + 0.5 * pi_lo; /* |y/x| > 2**60 */
else if(hx < 0 && k < -60)
z = 0.0; /* |y|/x < -2**60 */
else
z = atan(fabs(y / x)); /* safe to do y/x */
switch(m) {
case 0:
return z; /* atan(+,+) */
case 1:
__HI(z) ^= 0x80000000;
return z; /* atan(-,+) */
case 2:
return pi - (z - pi_lo); /* atan(+,-) */
default: /* case 3 */
return (z - pi_lo) - pi; /* atan(-,-) */
}
}

60
external/fdlibm/e_atanh.c vendored Normal file
View File

@@ -0,0 +1,60 @@
/* @(#)e_atanh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_atanh(x)
* Method :
* 1.Reduced x to positive by atanh(-x) = -atanh(x)
* 2.For x>=0.5
* 1 2x x
* atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
* 2 1 - x 1 - x
*
* For x<0.5
* atanh(x) = 0.5*log1p(2x+2x*x/(1-x))
*
* Special cases:
* atanh(x) is NaN if |x| > 1 with signal;
* atanh(NaN) is that NaN with no signal;
* atanh(+-1) is +-INF with signal.
*
*/
#include "math.h"
static const double one = 1.0, hugev = 1e300;
static double zero = 0.0;
double __fdlibm_atanh(double x) {
double t;
int hx, ix;
unsigned lx;
hx = __HI(x); /* high word */
lx = __LO(x); /* low word */
ix = hx & 0x7fffffff;
if((ix | ((lx | (-lx)) >> 31)) > 0x3ff00000) /* |x|>1 */
return (x - x) / (x - x);
if(ix == 0x3ff00000)
return x / zero;
if(ix < 0x3e300000 && (hugev + x) > zero) return x; /* x<2**-28 */
__HI(x) = ix; /* x <- |x| */
if(ix < 0x3fe00000) { /* x < 0.5 */
t = x + x;
t = 0.5 * log1p(t + t * x / (one - x));
} else
t = 0.5 * log1p((x + x) / (one - x));
if(hx >= 0) return t;
else
return -t;
}

79
external/fdlibm/e_cosh.c vendored Normal file
View File

@@ -0,0 +1,79 @@
/* @(#)e_cosh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_cosh(x)
* Method :
* mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2
* 1. Replace x by |x| (cosh(x) = cosh(-x)).
* 2.
* [ exp(x) - 1 ]^2
* 0 <= x <= ln2/2 : cosh(x) := 1 + -------------------
* 2*exp(x)
*
* exp(x) + 1/exp(x)
* ln2/2 <= x <= 22 : cosh(x) := -------------------
* 2
* 22 <= x <= lnovft : cosh(x) := exp(x)/2
* lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2)
* ln2ovft < x : cosh(x) := hugev*hugev (overflow)
*
* Special cases:
* cosh(x) is |x| if x is +INF, -INF, or NaN.
* only cosh(0)=1 is exact for finite x.
*/
#include "math.h"
static const double one = 1.0, half = 0.5, hugev = 1.0e300;
double __fdlibm_cosh(double x) {
double t, w;
int ix;
unsigned lx;
/* High word of |x|. */
ix = __HI(x);
ix &= 0x7fffffff;
/* x is INF or NaN */
if(ix >= 0x7ff00000) return x * x;
/* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
if(ix < 0x3fd62e43) {
t = expm1(fabs(x));
w = one + t;
if(ix < 0x3c800000) return w; /* cosh(tinyv) = 1 */
return one + (t * t) / (w + w);
}
/* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */
if(ix < 0x40360000) {
t = __fdlibm_exp(fabs(x));
return half * t + half / t;
}
/* |x| in [22, log(maxdouble)] return half*exp(|x|) */
if(ix < 0x40862E42) return half * __fdlibm_exp(fabs(x));
/* |x| in [log(maxdouble), overflowthresold] */
lx = *((((*(unsigned*)&one) >> 29)) + (unsigned*)&x);
if(ix < 0x408633CE ||
(ix == 0x408633ce) && (lx <= (unsigned)0x8fb9f87d)) {
w = __fdlibm_exp(half * fabs(x));
t = half * w;
return t * w;
}
/* |x| > overflowthresold, cosh(x) overflow */
return hugev * hugev;
}

155
external/fdlibm/e_exp.c vendored Normal file
View File

@@ -0,0 +1,155 @@
/* @(#)e_exp.c 1.6 04/04/22 */
/*
* ====================================================
* Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
*
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_exp(x)
* Returns the exponential of x.
*
* Method
* 1. Argument reduction:
* Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658.
* Given x, find r and integer k such that
*
* x = k*ln2 + r, |r| <= 0.5*ln2.
*
* Here r will be represented as r = hi-lo for better
* accuracy.
*
* 2. Approximation of exp(r) by a special rational function on
* the interval [0,0.34658]:
* Write
* R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ...
* We use a special Remes algorithm on [0,0.34658] to generate
* a polynomial of degree 5 to approximate R. The maximum error
* of this polynomial approximation is bounded by 2**-59. In
* other words,
* R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5
* (where z=r*r, and the values of P1 to P5 are listed below)
* and
* | 5 | -59
* | 2.0+P1*z+...+P5*z - R(z) | <= 2
* | |
* The computation of exp(r) thus becomes
* 2*r
* exp(r) = 1 + -------
* R - r
* r*R1(r)
* = 1 + r + ----------- (for better accuracy)
* 2 - R1(r)
* where
* 2 4 10
* R1(r) = r - (P1*r + P2*r + ... + P5*r ).
*
* 3. Scale back to obtain exp(x):
* From step 1, we have
* exp(x) = 2^k * exp(r)
*
* Special cases:
* exp(INF) is INF, exp(NaN) is NaN;
* exp(-INF) is 0, and
* for finite argument, only exp(0)=1 is exact.
*
* Accuracy:
* according to an error analysis, the error is always less than
* 1 ulp (unit in the last place).
*
* Misc. info.
* For IEEE double
* if x > 7.09782712893383973096e+02 then exp(x) overflow
* if x < -7.45133219101941108420e+02 then exp(x) underflow
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const double
one = 1.0,
halF[2] = {
0.5,
-0.5,
},
hugev = 1.0e+300, twom1000 = 9.33263618503218878990e-302, /* 2**-1000=0x01700000,0*/
o_threshold = 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
u_threshold = -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */
ln2HI[2] = {
6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */
-6.93147180369123816490e-01,
}, /* 0xbfe62e42, 0xfee00000 */
ln2LO[2] = {
1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */
-1.90821492927058770002e-10,
}, /* 0xbdea39ef, 0x35793c76 */
invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */
P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */
double __fdlibm_exp(double x) /* default IEEE double exp */
{
double y, hi, lo, c, t;
int k, xsb;
unsigned hx;
hx = __HI(x); /* high word of x */
xsb = (hx >> 31) & 1; /* sign bit of x */
hx &= 0x7fffffff; /* high word of |x| */
/* filter out non-finite argument */
if(hx >= 0x40862E42) { /* if |x|>=709.78... */
if(hx >= 0x7ff00000) {
if(((hx & 0xfffff) | __LO(x)) != 0)
return x + x; /* NaN */
else
return (xsb == 0) ? x : 0.0; /* exp(+-inf)={inf,0} */
}
if(x > o_threshold) return hugev * hugev; /* overflow */
if(x < u_threshold) return twom1000 * twom1000; /* underflow */
}
/* argument reduction */
if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
hi = x - ln2HI[xsb];
lo = ln2LO[xsb];
k = 1 - xsb - xsb;
} else {
k = (int)(invln2 * x + halF[xsb]);
t = k;
hi = x - t * ln2HI[0]; /* t*ln2HI is exact here */
lo = t * ln2LO[0];
}
x = hi - lo;
} else if(hx < 0x3e300000) { /* when |x|<2**-28 */
if(hugev + x > one) return one + x; /* trigger inexact */
} else
k = 0;
/* x is now in primary range */
t = x * x;
c = x - t * (P1 + t * (P2 + t * (P3 + t * (P4 + t * P5))));
if(k == 0) return one - ((x * c) / (c - 2.0) - x);
else
y = one - ((lo - (x * c) / (2.0 - c)) - hi);
if(k >= -1021) {
__HI(y) += (k << 20); /* add k to y's exponent */
return y;
} else {
__HI(y) += ((k + 1000) << 20); /* add k to y's exponent */
return y * twom1000;
}
}

148
external/fdlibm/e_fmod.c vendored Normal file
View File

@@ -0,0 +1,148 @@
/* @(#)e_fmod.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __fdlibm_fmod(x,y)
* Return x mod y in exact arithmetic
* Method: shift and subtract
*/
#include "math.h"
static const double one = 1.0, Zero[] = {
0.0,
-0.0,
};
double __fdlibm_fmod(double x, double y) {
int n, hx, hy, hz, ix, iy, sx, i;
unsigned lx, ly, lz;
hx = __HI(x); /* high word of x */
lx = __LO(x); /* low word of x */
hy = __HI(y); /* high word of y */
ly = __LO(y); /* low word of y */
sx = hx & 0x80000000; /* sign of x */
hx ^= sx; /* |x| */
hy &= 0x7fffffff; /* |y| */
/* purge off exception values */
if((hy | ly) == 0 || (hx >= 0x7ff00000) || /* y=0,or x not finite */
((hy | ((ly | -ly) >> 31)) > 0x7ff00000)) /* or y is NaN */
return (x * y) / (x * y);
if(hx <= hy) {
if((hx < hy) || (lx < ly)) return x; /* |x|<|y| return x */
if(lx == ly)
return Zero[(unsigned)sx >> 31]; /* |x|=|y| return x*0*/
}
/* determine ix = ilogb(x) */
if(hx < 0x00100000) { /* subnormal x */
if(hx == 0) {
for(ix = -1043, i = lx; i > 0; i <<= 1) ix -= 1;
} else {
for(ix = -1022, i = (hx << 11); i > 0; i <<= 1) ix -= 1;
}
} else
ix = (hx >> 20) - 1023;
/* determine iy = ilogb(y) */
if(hy < 0x00100000) { /* subnormal y */
if(hy == 0) {
for(iy = -1043, i = ly; i > 0; i <<= 1) iy -= 1;
} else {
for(iy = -1022, i = (hy << 11); i > 0; i <<= 1) iy -= 1;
}
} else
iy = (hy >> 20) - 1023;
/* set up {hx,lx}, {hy,ly} and align y to x */
if(ix >= -1022)
hx = 0x00100000 | (0x000fffff & hx);
else { /* subnormal x, shift x to normal */
n = -1022 - ix;
if(n <= 31) {
hx = (hx << n) | (lx >> (32 - n));
lx <<= n;
} else {
hx = lx << (n - 32);
lx = 0;
}
}
if(iy >= -1022)
hy = 0x00100000 | (0x000fffff & hy);
else { /* subnormal y, shift y to normal */
n = -1022 - iy;
if(n <= 31) {
hy = (hy << n) | (ly >> (32 - n));
ly <<= n;
} else {
hy = ly << (n - 32);
ly = 0;
}
}
/* fix point fmod */
n = ix - iy;
while(n--) {
hz = hx - hy;
lz = lx - ly;
if(lx < ly) hz -= 1;
if(hz < 0) {
hx = hx + hx + (lx >> 31);
lx = lx + lx;
} else {
if((hz | lz) == 0) /* return sign(x)*0 */
return Zero[(unsigned)sx >> 31];
hx = hz + hz + (lz >> 31);
lx = lz + lz;
}
}
hz = hx - hy;
lz = lx - ly;
if(lx < ly) hz -= 1;
if(hz >= 0) {
hx = hz;
lx = lz;
}
/* convert back to floating value and restore the sign */
if((hx | lx) == 0) /* return sign(x)*0 */
return Zero[(unsigned)sx >> 31];
while(hx < 0x00100000) { /* normalize x */
hx = hx + hx + (lx >> 31);
lx = lx + lx;
iy -= 1;
}
if(iy >= -1022) { /* normalize output */
hx = ((hx - 0x00100000) | ((iy + 1023) << 20));
__HI(x) = hx | sx;
__LO(x) = lx;
} else { /* subnormal output */
n = -1022 - iy;
if(n <= 20) {
lx = (lx >> n) | ((unsigned)hx << (32 - n));
hx >>= n;
} else if(n <= 31) {
lx = (hx << (32 - n)) | (lx >> n);
hx = sx;
} else {
lx = hx >> (n - 32);
hx = sx;
}
__HI(x) = hx | sx;
__LO(x) = lx;
x *= one; /* create necessary signal */
}
return x; /* exact output */
}

27
external/fdlibm/e_gamma.c vendored Normal file
View File

@@ -0,0 +1,27 @@
/* @(#)e_gamma.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_gamma(x)
* Return the logarithm of the Gamma function of x.
*
* Method: call __fdlibm_gamma_r
*/
#include "math.h"
extern int signgam;
double __fdlibm_gamma(double x) {
return __fdlibm_gamma_r(x, &signgam);
}

26
external/fdlibm/e_gamma_r.c vendored Normal file
View File

@@ -0,0 +1,26 @@
/* @(#)e_gamma_r.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_gamma_r(x, signgamp)
* Reentrant version of the logarithm of the Gamma function
* with user provide pointer for the sign of Gamma(x).
*
* Method: See __fdlibm_lgamma_r
*/
#include "math.h"
double __fdlibm_gamma_r(double x, int* signgamp) {
return __fdlibm_lgamma_r(x, signgamp);
}

123
external/fdlibm/e_hypot.c vendored Normal file
View File

@@ -0,0 +1,123 @@
/* @(#)e_hypot.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __math.hypot(x,y)
*
* Method :
* If (assume round-to-nearest) z=x*x+y*y
* has error less than sqrt(2)/2 ulp, than
* sqrt(z) has error less than 1 ulp (exercise).
*
* So, compute sqrt(x*x+y*y) with some care as
* follows to get the error below 1 ulp:
*
* Assume x>y>0;
* (if possible, set rounding to round-to-nearest)
* 1. if x > 2y use
* x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y
* where x1 = x with lower 32 bits cleared, x2 = x-x1; else
* 2. if x <= 2y use
* t1*y1+((x-y)*(x-y)+(t1*y2+t2*y))
* where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1,
* y1= y with lower 32 bits chopped, y2 = y-y1.
*
* NOTE: scaling may be necessary if some argument is too
* large or too tinyv
*
* Special cases:
* hypot(x,y) is INF if x or y is +INF or -INF; else
* hypot(x,y) is NAN if x or y is NAN.
*
* Accuracy:
* hypot(x,y) returns sqrt(x^2+y^2) with error less
* than 1 ulps (units in the last place)
*/
#include "math.h"
double __fdlibm_hypot(double x, double y) {
double a = x, b = y, t1, t2, y1, y2, w;
int j, k, ha, hb;
ha = __HI(x) & 0x7fffffff; /* high word of x */
hb = __HI(y) & 0x7fffffff; /* high word of y */
if(hb > ha) {
a = y;
b = x;
j = ha;
ha = hb;
hb = j;
} else {
a = x;
b = y;
}
__HI(a) = ha; /* a <- |a| */
__HI(b) = hb; /* b <- |b| */
if((ha - hb) > 0x3c00000) {
return a + b;
} /* x/y > 2**60 */
k = 0;
if(ha > 0x5f300000) { /* a>2**500 */
if(ha >= 0x7ff00000) { /* Inf or NaN */
w = a + b; /* for sNaN */
if(((ha & 0xfffff) | __LO(a)) == 0) w = a;
if(((hb ^ 0x7ff00000) | __LO(b)) == 0) w = b;
return w;
}
/* scale a and b by 2**-600 */
ha -= 0x25800000;
hb -= 0x25800000;
k += 600;
__HI(a) = ha;
__HI(b) = hb;
}
if(hb < 0x20b00000) { /* b < 2**-500 */
if(hb <= 0x000fffff) { /* subnormal b or 0 */
if((hb | (__LO(b))) == 0) return a;
t1 = 0;
__HI(t1) = 0x7fd00000; /* t1=2^1022 */
b *= t1;
a *= t1;
k -= 1022;
} else { /* scale a and b by 2^600 */
ha += 0x25800000; /* a *= 2^600 */
hb += 0x25800000; /* b *= 2^600 */
k -= 600;
__HI(a) = ha;
__HI(b) = hb;
}
}
/* medium size a and b */
w = a - b;
if(w > b) {
t1 = 0;
__HI(t1) = ha;
t2 = a - t1;
w = sqrt(t1 * t1 - (b * (-b) - t2 * (a + t1)));
} else {
a = a + a;
y1 = 0;
__HI(y1) = hb;
y2 = b - y1;
t1 = 0;
__HI(t1) = ha + 0x00100000;
t2 = a - t1;
w = sqrt(t1 * y1 - (w * (-w) - (t1 * y2 + t2 * b)));
}
if(k != 0) {
t1 = 1.0;
__HI(t1) += (k << 20);
return t1 * w;
} else
return w;
}

400
external/fdlibm/e_j0.c vendored Normal file
View File

@@ -0,0 +1,400 @@
/* @(#)e_j0.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_j0(x), __fdlibm_y0(x)
* Bessel function of the first and second kinds of order zero.
* Method -- j0(x):
* 1. For tinyv x, we use j0(x) = 1 - x^2/4 + x^4/64 - ...
* 2. Reduce x to |x| since j0(x)=j0(-x), and
* for x in (0,2)
* j0(x) = 1-z/4+ z^2*R0/S0, where z = x*x;
* (precision: |j0-1+z/4-z^2R0/S0 |<2**-63.67 )
* for x in (2,inf)
* j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0))
* where x0 = x-pi/4. It is better to compute sin(x0),cos(x0)
* as follow:
* cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
* = 1/sqrt(2) * (cos(x) + sin(x))
* sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4)
* = 1/sqrt(2) * (sin(x) - cos(x))
* (To avoid cancellation, use
* sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
* to compute the worse one.)
*
* 3 Special cases
* j0(nan)= nan
* j0(0) = 1
* j0(inf) = 0
*
* Method -- y0(x):
* 1. For x<2.
* Since
* y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...)
* therefore y0(x)-2/pi*j0(x)*ln(x) is an even function.
* We use the following function to approximate y0,
* y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2
* where
* U(z) = u00 + u01*z + ... + u06*z^6
* V(z) = 1 + v01*z + ... + v04*z^4
* with absolute approximation error bounded by 2**-72.
* Note: For tinyv x, U/V = u0 and j0(x)~1, hence
* y0(tinyv) = u0 + (2/pi)*ln(tinyv), (choose tinyv<2**-27)
* 2. For x>=2.
* y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0))
* where x0 = x-pi/4. It is better to compute sin(x0),cos(x0)
* by the method mentioned above.
* 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0.
*/
#include "math.h"
static double pzero(double), qzero(double);
static const double
hugev = 1e300,
one = 1.0,
invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
/* R0/S0 on [0, 2.00] */
R02 = 1.56249999999999947958e-02, /* 0x3F8FFFFF, 0xFFFFFFFD */
R03 = -1.89979294238854721751e-04, /* 0xBF28E6A5, 0xB61AC6E9 */
R04 = 1.82954049532700665670e-06, /* 0x3EBEB1D1, 0x0C503919 */
R05 = -4.61832688532103189199e-09, /* 0xBE33D5E7, 0x73D63FCE */
S01 = 1.56191029464890010492e-02, /* 0x3F8FFCE8, 0x82C8C2A4 */
S02 = 1.16926784663337450260e-04, /* 0x3F1EA6D2, 0xDD57DBF4 */
S03 = 5.13546550207318111446e-07, /* 0x3EA13B54, 0xCE84D5A9 */
S04 = 1.16614003333790000205e-09; /* 0x3E1408BC, 0xF4745D8F */
static double zero = 0.0;
double __fdlibm_j0(double x) {
double z, s, c, ss, cc, r, u, v;
int hx, ix;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x7ff00000) return one / (x * x);
x = fabs(x);
if(ix >= 0x40000000) { /* |x| >= 2.0 */
s = sin(x);
c = cos(x);
ss = s - c;
cc = s + c;
if(ix < 0x7fe00000) { /* make sure x+x not overflow */
z = -cos(x + x);
if((s * c) < zero) cc = z / ss;
else
ss = z / cc;
}
/*
* j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
* y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
*/
if(ix > 0x48000000) z = (invsqrtpi * cc) / sqrt(x);
else {
u = pzero(x);
v = qzero(x);
z = invsqrtpi * (u * cc - v * ss) / sqrt(x);
}
return z;
}
if(ix < 0x3f200000) { /* |x| < 2**-13 */
if(hugev + x > one) { /* raise inexact if x != 0 */
if(ix < 0x3e400000) return one; /* |x|<2**-27 */
else
return one - 0.25 * x * x;
}
}
z = x * x;
r = z * (R02 + z * (R03 + z * (R04 + z * R05)));
s = one + z * (S01 + z * (S02 + z * (S03 + z * S04)));
if(ix < 0x3FF00000) { /* |x| < 1.00 */
return one + z * (-0.25 + (r / s));
} else {
u = 0.5 * x;
return ((one + u) * (one - u) + z * (r / s));
}
}
static const double
u00 = -7.38042951086872317523e-02, /* 0xBFB2E4D6, 0x99CBD01F */
u01 = 1.76666452509181115538e-01, /* 0x3FC69D01, 0x9DE9E3FC */
u02 = -1.38185671945596898896e-02, /* 0xBF8C4CE8, 0xB16CFA97 */
u03 = 3.47453432093683650238e-04, /* 0x3F36C54D, 0x20B29B6B */
u04 = -3.81407053724364161125e-06, /* 0xBECFFEA7, 0x73D25CAD */
u05 = 1.95590137035022920206e-08, /* 0x3E550057, 0x3B4EABD4 */
u06 = -3.98205194132103398453e-11, /* 0xBDC5E43D, 0x693FB3C8 */
v01 = 1.27304834834123699328e-02, /* 0x3F8A1270, 0x91C9C71A */
v02 = 7.60068627350353253702e-05, /* 0x3F13ECBB, 0xF578C6C1 */
v03 = 2.59150851840457805467e-07, /* 0x3E91642D, 0x7FF202FD */
v04 = 4.41110311332675467403e-10; /* 0x3DFE5018, 0x3BD6D9EF */
double __fdlibm_y0(double x) {
double z, s, c, ss, cc, u, v;
int hx, ix, lx;
hx = __HI(x);
ix = 0x7fffffff & hx;
lx = __LO(x);
/* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */
if(ix >= 0x7ff00000) return one / (x + x * x);
if((ix | lx) == 0) return -one / zero;
if(hx < 0) return zero / zero;
if(ix >= 0x40000000) { /* |x| >= 2.0 */
/* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0))
* where x0 = x-pi/4
* Better formula:
* cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
* = 1/sqrt(2) * (sin(x) + cos(x))
* sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
* = 1/sqrt(2) * (sin(x) - cos(x))
* To avoid cancellation, use
* sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
* to compute the worse one.
*/
s = sin(x);
c = cos(x);
ss = s - c;
cc = s + c;
/*
* j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
* y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
*/
if(ix < 0x7fe00000) { /* make sure x+x not overflow */
z = -cos(x + x);
if((s * c) < zero) cc = z / ss;
else
ss = z / cc;
}
if(ix > 0x48000000) z = (invsqrtpi * ss) / sqrt(x);
else {
u = pzero(x);
v = qzero(x);
z = invsqrtpi * (u * ss + v * cc) / sqrt(x);
}
return z;
}
if(ix <= 0x3e400000) { /* x < 2**-27 */
return (u00 + tpi * __fdlibm_log(x));
}
z = x * x;
u = u00 + z * (u01 + z * (u02 + z * (u03 + z * (u04 + z * (u05 + z * u06)))));
v = one + z * (v01 + z * (v02 + z * (v03 + z * v04)));
return (u / v + tpi * (__fdlibm_j0(x) * __fdlibm_log(x)));
}
/* The asymptotic expansions of pzero is
* 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x.
* For x >= 2, We approximate pzero by
* pzero(x) = 1 + (R/S)
* where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10
* S = 1 + pS0*s^2 + ... + pS4*s^10
* and
* | pzero(x)-1-R/S | <= 2 ** ( -60.26)
*/
static const double pR8[6] = {
/* for x in [inf, 8]=1/[0,0.125] */
0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
-7.03124999999900357484e-02, /* 0xBFB1FFFF, 0xFFFFFD32 */
-8.08167041275349795626e+00, /* 0xC02029D0, 0xB44FA779 */
-2.57063105679704847262e+02, /* 0xC0701102, 0x7B19E863 */
-2.48521641009428822144e+03, /* 0xC0A36A6E, 0xCD4DCAFC */
-5.25304380490729545272e+03, /* 0xC0B4850B, 0x36CC643D */
};
static const double pS8[5] = {
1.16534364619668181717e+02, /* 0x405D2233, 0x07A96751 */
3.83374475364121826715e+03, /* 0x40ADF37D, 0x50596938 */
4.05978572648472545552e+04, /* 0x40E3D2BB, 0x6EB6B05F */
1.16752972564375915681e+05, /* 0x40FC810F, 0x8F9FA9BD */
4.76277284146730962675e+04, /* 0x40E74177, 0x4F2C49DC */
};
static const double pR5[6] = {
/* for x in [8,4.5454]=1/[0.125,0.22001] */
-1.14125464691894502584e-11, /* 0xBDA918B1, 0x47E495CC */
-7.03124940873599280078e-02, /* 0xBFB1FFFF, 0xE69AFBC6 */
-4.15961064470587782438e+00, /* 0xC010A370, 0xF90C6BBF */
-6.76747652265167261021e+01, /* 0xC050EB2F, 0x5A7D1783 */
-3.31231299649172967747e+02, /* 0xC074B3B3, 0x6742CC63 */
-3.46433388365604912451e+02, /* 0xC075A6EF, 0x28A38BD7 */
};
static const double pS5[5] = {
6.07539382692300335975e+01, /* 0x404E6081, 0x0C98C5DE */
1.05125230595704579173e+03, /* 0x40906D02, 0x5C7E2864 */
5.97897094333855784498e+03, /* 0x40B75AF8, 0x8FBE1D60 */
9.62544514357774460223e+03, /* 0x40C2CCB8, 0xFA76FA38 */
2.40605815922939109441e+03, /* 0x40A2CC1D, 0xC70BE864 */
};
static const double pR3[6] = {
/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
-2.54704601771951915620e-09, /* 0xBE25E103, 0x6FE1AA86 */
-7.03119616381481654654e-02, /* 0xBFB1FFF6, 0xF7C0E24B */
-2.40903221549529611423e+00, /* 0xC00345B2, 0xAEA48074 */
-2.19659774734883086467e+01, /* 0xC035F74A, 0x4CB94E14 */
-5.80791704701737572236e+01, /* 0xC04D0A22, 0x420A1A45 */
-3.14479470594888503854e+01, /* 0xC03F72AC, 0xA892D80F */
};
static const double pS3[5] = {
3.58560338055209726349e+01, /* 0x4041ED92, 0x84077DD3 */
3.61513983050303863820e+02, /* 0x40769839, 0x464A7C0E */
1.19360783792111533330e+03, /* 0x4092A66E, 0x6D1061D6 */
1.12799679856907414432e+03, /* 0x40919FFC, 0xB8C39B7E */
1.73580930813335754692e+02, /* 0x4065B296, 0xFC379081 */
};
static const double pR2[6] = {
/* for x in [2.8570,2]=1/[0.3499,0.5] */
-8.87534333032526411254e-08, /* 0xBE77D316, 0xE927026D */
-7.03030995483624743247e-02, /* 0xBFB1FF62, 0x495E1E42 */
-1.45073846780952986357e+00, /* 0xBFF73639, 0x8A24A843 */
-7.63569613823527770791e+00, /* 0xC01E8AF3, 0xEDAFA7F3 */
-1.11931668860356747786e+01, /* 0xC02662E6, 0xC5246303 */
-3.23364579351335335033e+00, /* 0xC009DE81, 0xAF8FE70F */
};
static const double pS2[5] = {
2.22202997532088808441e+01, /* 0x40363865, 0x908B5959 */
1.36206794218215208048e+02, /* 0x4061069E, 0x0EE8878F */
2.70470278658083486789e+02, /* 0x4070E786, 0x42EA079B */
1.53875394208320329881e+02, /* 0x40633C03, 0x3AB6FAFF */
1.46576176948256193810e+01, /* 0x402D50B3, 0x44391809 */
};
static double pzero(double x) {
const double *p, *q;
double z, r, s;
int ix;
ix = 0x7fffffff & __HI(x);
if(ix >= 0x40200000) {
p = pR8;
q = pS8;
} else if(ix >= 0x40122E8B) {
p = pR5;
q = pS5;
} else if(ix >= 0x4006DB6D) {
p = pR3;
q = pS3;
} else if(ix >= 0x40000000) {
p = pR2;
q = pS2;
}
z = one / (x * x);
r = p[0] + z * (p[1] + z * (p[2] + z * (p[3] + z * (p[4] + z * p[5]))));
s = one + z * (q[0] + z * (q[1] + z * (q[2] + z * (q[3] + z * q[4]))));
return one + r / s;
}
/* For x >= 8, the asymptotic expansions of qzero is
* -1/8 s + 75/1024 s^3 - ..., where s = 1/x.
* We approximate pzero by
* qzero(x) = s*(-1.25 + (R/S))
* where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10
* S = 1 + qS0*s^2 + ... + qS5*s^12
* and
* | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22)
*/
static const double qR8[6] = {
/* for x in [inf, 8]=1/[0,0.125] */
0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
7.32421874999935051953e-02, /* 0x3FB2BFFF, 0xFFFFFE2C */
1.17682064682252693899e+01, /* 0x40278952, 0x5BB334D6 */
5.57673380256401856059e+02, /* 0x40816D63, 0x15301825 */
8.85919720756468632317e+03, /* 0x40C14D99, 0x3E18F46D */
3.70146267776887834771e+04, /* 0x40E212D4, 0x0E901566 */
};
static const double qS8[6] = {
1.63776026895689824414e+02, /* 0x406478D5, 0x365B39BC */
8.09834494656449805916e+03, /* 0x40BFA258, 0x4E6B0563 */
1.42538291419120476348e+05, /* 0x41016652, 0x54D38C3F */
8.03309257119514397345e+05, /* 0x412883DA, 0x83A52B43 */
8.40501579819060512818e+05, /* 0x4129A66B, 0x28DE0B3D */
-3.43899293537866615225e+05, /* 0xC114FD6D, 0x2C9530C5 */
};
static const double qR5[6] = {
/* for x in [8,4.5454]=1/[0.125,0.22001] */
1.84085963594515531381e-11, /* 0x3DB43D8F, 0x29CC8CD9 */
7.32421766612684765896e-02, /* 0x3FB2BFFF, 0xD172B04C */
5.83563508962056953777e+00, /* 0x401757B0, 0xB9953DD3 */
1.35111577286449829671e+02, /* 0x4060E392, 0x0A8788E9 */
1.02724376596164097464e+03, /* 0x40900CF9, 0x9DC8C481 */
1.98997785864605384631e+03, /* 0x409F17E9, 0x53C6E3A6 */
};
static const double qS5[6] = {
8.27766102236537761883e+01, /* 0x4054B1B3, 0xFB5E1543 */
2.07781416421392987104e+03, /* 0x40A03BA0, 0xDA21C0CE */
1.88472887785718085070e+04, /* 0x40D267D2, 0x7B591E6D */
5.67511122894947329769e+04, /* 0x40EBB5E3, 0x97E02372 */
3.59767538425114471465e+04, /* 0x40E19118, 0x1F7A54A0 */
-5.35434275601944773371e+03, /* 0xC0B4EA57, 0xBEDBC609 */
};
static const double qR3[6] = {
/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
4.37741014089738620906e-09, /* 0x3E32CD03, 0x6ADECB82 */
7.32411180042911447163e-02, /* 0x3FB2BFEE, 0x0E8D0842 */
3.34423137516170720929e+00, /* 0x400AC0FC, 0x61149CF5 */
4.26218440745412650017e+01, /* 0x40454F98, 0x962DAEDD */
1.70808091340565596283e+02, /* 0x406559DB, 0xE25EFD1F */
1.66733948696651168575e+02, /* 0x4064D77C, 0x81FA21E0 */
};
static const double qS3[6] = {
4.87588729724587182091e+01, /* 0x40486122, 0xBFE343A6 */
7.09689221056606015736e+02, /* 0x40862D83, 0x86544EB3 */
3.70414822620111362994e+03, /* 0x40ACF04B, 0xE44DFC63 */
6.46042516752568917582e+03, /* 0x40B93C6C, 0xD7C76A28 */
2.51633368920368957333e+03, /* 0x40A3A8AA, 0xD94FB1C0 */
-1.49247451836156386662e+02, /* 0xC062A7EB, 0x201CF40F */
};
static const double qR2[6] = {
/* for x in [2.8570,2]=1/[0.3499,0.5] */
1.50444444886983272379e-07, /* 0x3E84313B, 0x54F76BDB */
7.32234265963079278272e-02, /* 0x3FB2BEC5, 0x3E883E34 */
1.99819174093815998816e+00, /* 0x3FFFF897, 0xE727779C */
1.44956029347885735348e+01, /* 0x402CFDBF, 0xAAF96FE5 */
3.16662317504781540833e+01, /* 0x403FAA8E, 0x29FBDC4A */
1.62527075710929267416e+01, /* 0x403040B1, 0x71814BB4 */
};
static const double qS2[6] = {
3.03655848355219184498e+01, /* 0x403E5D96, 0xF7C07AED */
2.69348118608049844624e+02, /* 0x4070D591, 0xE4D14B40 */
8.44783757595320139444e+02, /* 0x408A6645, 0x22B3BF22 */
8.82935845112488550512e+02, /* 0x408B977C, 0x9C5CC214 */
2.12666388511798828631e+02, /* 0x406A9553, 0x0E001365 */
-5.31095493882666946917e+00, /* 0xC0153E6A, 0xF8B32931 */
};
static double qzero(double x) {
const double *p, *q;
double s, r, z;
int ix;
ix = 0x7fffffff & __HI(x);
if(ix >= 0x40200000) {
p = qR8;
q = qS8;
} else if(ix >= 0x40122E8B) {
p = qR5;
q = qS5;
} else if(ix >= 0x4006DB6D) {
p = qR3;
q = qS3;
} else if(ix >= 0x40000000) {
p = qR2;
q = qS2;
}
z = one / (x * x);
r = p[0] + z * (p[1] + z * (p[2] + z * (p[3] + z * (p[4] + z * p[5]))));
s = one + z * (q[0] + z * (q[1] + z * (q[2] + z * (q[3] + z * (q[4] + z * q[5])))));
return (-.125 + r / s) / x;
}

393
external/fdlibm/e_j1.c vendored Normal file
View File

@@ -0,0 +1,393 @@
/* @(#)e_j1.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_j1(x), __fdlibm_y1(x)
* Bessel function of the first and second kinds of order zero.
* Method -- j1(x):
* 1. For tinyv x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ...
* 2. Reduce x to |x| since j1(x)=-j1(-x), and
* for x in (0,2)
* j1(x) = x/2 + x*z*R0/S0, where z = x*x;
* (precision: |j1/x - 1/2 - R0/S0 |<2**-61.51 )
* for x in (2,inf)
* j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1))
* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1))
* where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1)
* as follow:
* cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
* = 1/sqrt(2) * (sin(x) - cos(x))
* sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
* = -1/sqrt(2) * (sin(x) + cos(x))
* (To avoid cancellation, use
* sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
* to compute the worse one.)
*
* 3 Special cases
* j1(nan)= nan
* j1(0) = 0
* j1(inf) = 0
*
* Method -- y1(x):
* 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN
* 2. For x<2.
* Since
* y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...)
* therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function.
* We use the following function to approximate y1,
* y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2
* where for x in [0,2] (abs err less than 2**-65.89)
* U(z) = U0[0] + U0[1]*z + ... + U0[4]*z^4
* V(z) = 1 + v0[0]*z + ... + v0[4]*z^5
* Note: For tinyv x, 1/x dominate y1 and hence
* y1(tinyv) = -2/pi/tinyv, (choose tinyv<2**-54)
* 3. For x>=2.
* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1))
* where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1)
* by method mentioned above.
*/
#include "math.h"
static double pone(double), qone(double);
static const double
hugev = 1e300,
one = 1.0,
invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
/* R0/S0 on [0,2] */
r00 = -6.25000000000000000000e-02, /* 0xBFB00000, 0x00000000 */
r01 = 1.40705666955189706048e-03, /* 0x3F570D9F, 0x98472C61 */
r02 = -1.59955631084035597520e-05, /* 0xBEF0C5C6, 0xBA169668 */
r03 = 4.96727999609584448412e-08, /* 0x3E6AAAFA, 0x46CA0BD9 */
s01 = 1.91537599538363460805e-02, /* 0x3F939D0B, 0x12637E53 */
s02 = 1.85946785588630915560e-04, /* 0x3F285F56, 0xB9CDF664 */
s03 = 1.17718464042623683263e-06, /* 0x3EB3BFF8, 0x333F8498 */
s04 = 5.04636257076217042715e-09, /* 0x3E35AC88, 0xC97DFF2C */
s05 = 1.23542274426137913908e-11; /* 0x3DAB2ACF, 0xCFB97ED8 */
static double zero = 0.0;
double __fdlibm_j1(double x) {
double z, s, c, ss, cc, r, u, v, y;
int hx, ix;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x7ff00000) return one / x;
y = fabs(x);
if(ix >= 0x40000000) { /* |x| >= 2.0 */
s = sin(y);
c = cos(y);
ss = -s - c;
cc = s - c;
if(ix < 0x7fe00000) { /* make sure y+y not overflow */
z = cos(y + y);
if((s * c) > zero) cc = z / ss;
else
ss = z / cc;
}
/*
* j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x)
* y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x)
*/
if(ix > 0x48000000) z = (invsqrtpi * cc) / sqrt(y);
else {
u = pone(y);
v = qone(y);
z = invsqrtpi * (u * cc - v * ss) / sqrt(y);
}
if(hx < 0) return -z;
else
return z;
}
if(ix < 0x3e400000) { /* |x|<2**-27 */
if(hugev + x > one) return 0.5 * x; /* inexact if x!=0 necessary */
}
z = x * x;
r = z * (r00 + z * (r01 + z * (r02 + z * r03)));
s = one + z * (s01 + z * (s02 + z * (s03 + z * (s04 + z * s05))));
r *= x;
return (x * 0.5 + r / s);
}
static const double U0[5] = {
-1.96057090646238940668e-01, /* 0xBFC91866, 0x143CBC8A */
5.04438716639811282616e-02, /* 0x3FA9D3C7, 0x76292CD1 */
-1.91256895875763547298e-03, /* 0xBF5F55E5, 0x4844F50F */
2.35252600561610495928e-05, /* 0x3EF8AB03, 0x8FA6B88E */
-9.19099158039878874504e-08, /* 0xBE78AC00, 0x569105B8 */
};
static const double V0[5] = {
1.99167318236649903973e-02, /* 0x3F94650D, 0x3F4DA9F0 */
2.02552581025135171496e-04, /* 0x3F2A8C89, 0x6C257764 */
1.35608801097516229404e-06, /* 0x3EB6C05A, 0x894E8CA6 */
6.22741452364621501295e-09, /* 0x3E3ABF1D, 0x5BA69A86 */
1.66559246207992079114e-11, /* 0x3DB25039, 0xDACA772A */
};
double __fdlibm_y1(double x) {
double z, s, c, ss, cc, u, v;
int hx, ix, lx;
hx = __HI(x);
ix = 0x7fffffff & hx;
lx = __LO(x);
/* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */
if(ix >= 0x7ff00000) return one / (x + x * x);
if((ix | lx) == 0) return -one / zero;
if(hx < 0) return zero / zero;
if(ix >= 0x40000000) { /* |x| >= 2.0 */
s = sin(x);
c = cos(x);
ss = -s - c;
cc = s - c;
if(ix < 0x7fe00000) { /* make sure x+x not overflow */
z = cos(x + x);
if((s * c) > zero) cc = z / ss;
else
ss = z / cc;
}
/* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0))
* where x0 = x-3pi/4
* Better formula:
* cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
* = 1/sqrt(2) * (sin(x) - cos(x))
* sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
* = -1/sqrt(2) * (cos(x) + sin(x))
* To avoid cancellation, use
* sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
* to compute the worse one.
*/
if(ix > 0x48000000) z = (invsqrtpi * ss) / sqrt(x);
else {
u = pone(x);
v = qone(x);
z = invsqrtpi * (u * ss + v * cc) / sqrt(x);
}
return z;
}
if(ix <= 0x3c900000) { /* x < 2**-54 */
return (-tpi / x);
}
z = x * x;
u = U0[0] + z * (U0[1] + z * (U0[2] + z * (U0[3] + z * U0[4])));
v = one + z * (V0[0] + z * (V0[1] + z * (V0[2] + z * (V0[3] + z * V0[4]))));
return (x * (u / v) + tpi * (__fdlibm_j1(x) * __fdlibm_log(x) - one / x));
}
/* For x >= 8, the asymptotic expansions of pone is
* 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x.
* We approximate pone by
* pone(x) = 1 + (R/S)
* where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10
* S = 1 + ps0*s^2 + ... + ps4*s^10
* and
* | pone(x)-1-R/S | <= 2 ** ( -60.06)
*/
static const double pr8[6] = {
/* for x in [inf, 8]=1/[0,0.125] */
0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
1.17187499999988647970e-01, /* 0x3FBDFFFF, 0xFFFFFCCE */
1.32394806593073575129e+01, /* 0x402A7A9D, 0x357F7FCE */
4.12051854307378562225e+02, /* 0x4079C0D4, 0x652EA590 */
3.87474538913960532227e+03, /* 0x40AE457D, 0xA3A532CC */
7.91447954031891731574e+03, /* 0x40BEEA7A, 0xC32782DD */
};
static const double ps8[5] = {
1.14207370375678408436e+02, /* 0x405C8D45, 0x8E656CAC */
3.65093083420853463394e+03, /* 0x40AC85DC, 0x964D274F */
3.69562060269033463555e+04, /* 0x40E20B86, 0x97C5BB7F */
9.76027935934950801311e+04, /* 0x40F7D42C, 0xB28F17BB */
3.08042720627888811578e+04, /* 0x40DE1511, 0x697A0B2D */
};
static const double pr5[6] = {
/* for x in [8,4.5454]=1/[0.125,0.22001] */
1.31990519556243522749e-11, /* 0x3DAD0667, 0xDAE1CA7D */
1.17187493190614097638e-01, /* 0x3FBDFFFF, 0xE2C10043 */
6.80275127868432871736e+00, /* 0x401B3604, 0x6E6315E3 */
1.08308182990189109773e+02, /* 0x405B13B9, 0x452602ED */
5.17636139533199752805e+02, /* 0x40802D16, 0xD052D649 */
5.28715201363337541807e+02, /* 0x408085B8, 0xBB7E0CB7 */
};
static const double ps5[5] = {
5.92805987221131331921e+01, /* 0x404DA3EA, 0xA8AF633D */
9.91401418733614377743e+02, /* 0x408EFB36, 0x1B066701 */
5.35326695291487976647e+03, /* 0x40B4E944, 0x5706B6FB */
7.84469031749551231769e+03, /* 0x40BEA4B0, 0xB8A5BB15 */
1.50404688810361062679e+03, /* 0x40978030, 0x036F5E51 */
};
static const double pr3[6] = {
3.02503916137373618024e-09, /* 0x3E29FC21, 0xA7AD9EDD */
1.17186865567253592491e-01, /* 0x3FBDFFF5, 0x5B21D17B */
3.93297750033315640650e+00, /* 0x400F76BC, 0xE85EAD8A */
3.51194035591636932736e+01, /* 0x40418F48, 0x9DA6D129 */
9.10550110750781271918e+01, /* 0x4056C385, 0x4D2C1837 */
4.85590685197364919645e+01, /* 0x4048478F, 0x8EA83EE5 */
};
static const double ps3[5] = {
3.47913095001251519989e+01, /* 0x40416549, 0xA134069C */
3.36762458747825746741e+02, /* 0x40750C33, 0x07F1A75F */
1.04687139975775130551e+03, /* 0x40905B7C, 0x5037D523 */
8.90811346398256432622e+02, /* 0x408BD67D, 0xA32E31E9 */
1.03787932439639277504e+02, /* 0x4059F26D, 0x7C2EED53 */
};
static const double pr2[6] = {
/* for x in [2.8570,2]=1/[0.3499,0.5] */
1.07710830106873743082e-07, /* 0x3E7CE9D4, 0xF65544F4 */
1.17176219462683348094e-01, /* 0x3FBDFF42, 0xBE760D83 */
2.36851496667608785174e+00, /* 0x4002F2B7, 0xF98FAEC0 */
1.22426109148261232917e+01, /* 0x40287C37, 0x7F71A964 */
1.76939711271687727390e+01, /* 0x4031B1A8, 0x177F8EE2 */
5.07352312588818499250e+00, /* 0x40144B49, 0xA574C1FE */
};
static const double ps2[5] = {
2.14364859363821409488e+01, /* 0x40356FBD, 0x8AD5ECDC */
1.25290227168402751090e+02, /* 0x405F5293, 0x14F92CD5 */
2.32276469057162813669e+02, /* 0x406D08D8, 0xD5A2DBD9 */
1.17679373287147100768e+02, /* 0x405D6B7A, 0xDA1884A9 */
8.36463893371618283368e+00, /* 0x4020BAB1, 0xF44E5192 */
};
static double pone(double x) {
const double *p, *q;
double z, r, s;
int ix;
ix = 0x7fffffff & __HI(x);
if(ix >= 0x40200000) {
p = pr8;
q = ps8;
} else if(ix >= 0x40122E8B) {
p = pr5;
q = ps5;
} else if(ix >= 0x4006DB6D) {
p = pr3;
q = ps3;
} else if(ix >= 0x40000000) {
p = pr2;
q = ps2;
}
z = one / (x * x);
r = p[0] + z * (p[1] + z * (p[2] + z * (p[3] + z * (p[4] + z * p[5]))));
s = one + z * (q[0] + z * (q[1] + z * (q[2] + z * (q[3] + z * q[4]))));
return one + r / s;
}
/* For x >= 8, the asymptotic expansions of qone is
* 3/8 s - 105/1024 s^3 - ..., where s = 1/x.
* We approximate pone by
* qone(x) = s*(0.375 + (R/S))
* where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10
* S = 1 + qs1*s^2 + ... + qs6*s^12
* and
* | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13)
*/
static const double qr8[6] = {
/* for x in [inf, 8]=1/[0,0.125] */
0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
-1.02539062499992714161e-01, /* 0xBFBA3FFF, 0xFFFFFDF3 */
-1.62717534544589987888e+01, /* 0xC0304591, 0xA26779F7 */
-7.59601722513950107896e+02, /* 0xC087BCD0, 0x53E4B576 */
-1.18498066702429587167e+04, /* 0xC0C724E7, 0x40F87415 */
-4.84385124285750353010e+04, /* 0xC0E7A6D0, 0x65D09C6A */
};
static const double qs8[6] = {
1.61395369700722909556e+02, /* 0x40642CA6, 0xDE5BCDE5 */
7.82538599923348465381e+03, /* 0x40BE9162, 0xD0D88419 */
1.33875336287249578163e+05, /* 0x4100579A, 0xB0B75E98 */
7.19657723683240939863e+05, /* 0x4125F653, 0x72869C19 */
6.66601232617776375264e+05, /* 0x412457D2, 0x7719AD5C */
-2.94490264303834643215e+05, /* 0xC111F969, 0x0EA5AA18 */
};
static const double qr5[6] = {
/* for x in [8,4.5454]=1/[0.125,0.22001] */
-2.08979931141764104297e-11, /* 0xBDB6FA43, 0x1AA1A098 */
-1.02539050241375426231e-01, /* 0xBFBA3FFF, 0xCB597FEF */
-8.05644828123936029840e+00, /* 0xC0201CE6, 0xCA03AD4B */
-1.83669607474888380239e+02, /* 0xC066F56D, 0x6CA7B9B0 */
-1.37319376065508163265e+03, /* 0xC09574C6, 0x6931734F */
-2.61244440453215656817e+03, /* 0xC0A468E3, 0x88FDA79D */
};
static const double qs5[6] = {
8.12765501384335777857e+01, /* 0x405451B2, 0xFF5A11B2 */
1.99179873460485964642e+03, /* 0x409F1F31, 0xE77BF839 */
1.74684851924908907677e+04, /* 0x40D10F1F, 0x0D64CE29 */
4.98514270910352279316e+04, /* 0x40E8576D, 0xAABAD197 */
2.79480751638918118260e+04, /* 0x40DB4B04, 0xCF7C364B */
-4.71918354795128470869e+03, /* 0xC0B26F2E, 0xFCFFA004 */
};
static const double qr3[6] = {
-5.07831226461766561369e-09, /* 0xBE35CFA9, 0xD38FC84F */
-1.02537829820837089745e-01, /* 0xBFBA3FEB, 0x51AEED54 */
-4.61011581139473403113e+00, /* 0xC01270C2, 0x3302D9FF */
-5.78472216562783643212e+01, /* 0xC04CEC71, 0xC25D16DA */
-2.28244540737631695038e+02, /* 0xC06C87D3, 0x4718D55F */
-2.19210128478909325622e+02, /* 0xC06B66B9, 0x5F5C1BF6 */
};
static const double qs3[6] = {
4.76651550323729509273e+01, /* 0x4047D523, 0xCCD367E4 */
6.73865112676699709482e+02, /* 0x40850EEB, 0xC031EE3E */
3.38015286679526343505e+03, /* 0x40AA684E, 0x448E7C9A */
5.54772909720722782367e+03, /* 0x40B5ABBA, 0xA61D54A6 */
1.90311919338810798763e+03, /* 0x409DBC7A, 0x0DD4DF4B */
-1.35201191444307340817e+02, /* 0xC060E670, 0x290A311F */
};
static const double qr2[6] = {
/* for x in [2.8570,2]=1/[0.3499,0.5] */
-1.78381727510958865572e-07, /* 0xBE87F126, 0x44C626D2 */
-1.02517042607985553460e-01, /* 0xBFBA3E8E, 0x9148B010 */
-2.75220568278187460720e+00, /* 0xC0060484, 0x69BB4EDA */
-1.96636162643703720221e+01, /* 0xC033A9E2, 0xC168907F */
-4.23253133372830490089e+01, /* 0xC04529A3, 0xDE104AAA */
-2.13719211703704061733e+01, /* 0xC0355F36, 0x39CF6E52 */
};
static const double qs2[6] = {
2.95333629060523854548e+01, /* 0x403D888A, 0x78AE64FF */
2.52981549982190529136e+02, /* 0x406F9F68, 0xDB821CBA */
7.57502834868645436472e+02, /* 0x4087AC05, 0xCE49A0F7 */
7.39393205320467245656e+02, /* 0x40871B25, 0x48D4C029 */
1.55949003336666123687e+02, /* 0x40637E5E, 0x3C3ED8D4 */
-4.95949898822628210127e+00, /* 0xC013D686, 0xE71BE86B */
};
static double qone(double x) {
const double *p, *q;
double s, r, z;
int ix;
ix = 0x7fffffff & __HI(x);
if(ix >= 0x40200000) {
p = qr8;
q = qs8;
} else if(ix >= 0x40122E8B) {
p = qr5;
q = qs5;
} else if(ix >= 0x4006DB6D) {
p = qr3;
q = qs3;
} else if(ix >= 0x40000000) {
p = qr2;
q = qs2;
}
z = one / (x * x);
r = p[0] + z * (p[1] + z * (p[2] + z * (p[3] + z * (p[4] + z * p[5]))));
s = one + z * (q[0] + z * (q[1] + z * (q[2] + z * (q[3] + z * (q[4] + z * q[5])))));
return (.375 + r / s) / x;
}

283
external/fdlibm/e_jn.c vendored Normal file
View File

@@ -0,0 +1,283 @@
/* @(#)e_jn.c 1.4 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __fdlibm_jn(n, x), __fdlibm_yn(n, x)
* floating point Bessel's function of the 1st and 2nd kind
* of order n
*
* Special cases:
* y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal;
* y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal.
* Note 2. About jn(n,x), yn(n,x)
* For n=0, j0(x) is called,
* for n=1, j1(x) is called,
* for n<x, forward recursion us used starting
* from values of j0(x) and j1(x).
* for n>x, a continued fraction approximation to
* j(n,x)/j(n-1,x) is evaluated and then backward
* recursion is used starting from a supposed value
* for j(n,x). The resulting value of j(0,x) is
* compared with the actual value to correct the
* supposed value of j(n,x).
*
* yn(n,x) is similar in all respects, except
* that forward recursion is used for all
* values of n>1.
*
*/
#include "math.h"
static const double
invsqrtpi = 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
one = 1.00000000000000000000e+00; /* 0x3FF00000, 0x00000000 */
static double zero = 0.00000000000000000000e+00;
double __fdlibm_jn(int n, double x) {
int i, hx, ix, lx, sgn;
double a, b, temp, di;
double z, w;
/* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x)
* Thus, J(-n,x) = J(n,-x)
*/
hx = __HI(x);
ix = 0x7fffffff & hx;
lx = __LO(x);
/* if J(n,NaN) is NaN */
if((ix | ((unsigned)(lx | -lx)) >> 31) > 0x7ff00000) return x + x;
if(n < 0) {
n = -n;
x = -x;
hx ^= 0x80000000;
}
if(n == 0) return (__fdlibm_j0(x));
if(n == 1) return (__fdlibm_j1(x));
sgn = (n & 1) & (hx >> 31); /* even n -- 0, odd n -- sign(x) */
x = fabs(x);
if((ix | lx) == 0 || ix >= 0x7ff00000) /* if x is 0 or inf */
b = zero;
else if((double)n <= x) {
/* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */
if(ix >= 0x52D00000) { /* x > 2**302 */
/* (x >> n**2)
* Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi)
* Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi)
* Let s=sin(x), c=cos(x),
* xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then
*
* n sin(xn)*sqt2 cos(xn)*sqt2
* ----------------------------------
* 0 s-c c+s
* 1 -s-c -c+s
* 2 -s+c -c-s
* 3 s+c c-s
*/
switch(n & 3) {
case 0:
temp = cos(x) + sin(x);
break;
case 1:
temp = -cos(x) + sin(x);
break;
case 2:
temp = -cos(x) - sin(x);
break;
case 3:
temp = cos(x) - sin(x);
break;
}
b = invsqrtpi * temp / sqrt(x);
} else {
a = __fdlibm_j0(x);
b = __fdlibm_j1(x);
for(i = 1; i < n; i++) {
temp = b;
b = b * ((double)(i + i) / x) - a; /* avoid underflow */
a = temp;
}
}
} else {
if(ix < 0x3e100000) { /* x < 2**-29 */
/* x is tinyv, return the first Taylor expansion of J(n,x)
* J(n,x) = 1/n!*(x/2)^n - ...
*/
if(n > 33) /* underflow */
b = zero;
else {
temp = x * 0.5;
b = temp;
for(a = one, i = 2; i <= n; i++) {
a *= (double)i; /* a = n! */
b *= temp; /* b = (x/2)^n */
}
b = b / a;
}
} else {
/* use backward recurrence */
/* x x^2 x^2
* J(n,x)/J(n-1,x) = ---- ------ ------ .....
* 2n - 2(n+1) - 2(n+2)
*
* 1 1 1
* (for large x) = ---- ------ ------ .....
* 2n 2(n+1) 2(n+2)
* -- - ------ - ------ -
* x x x
*
* Let w = 2n/x and h=2/x, then the above quotient
* is equal to the continued fraction:
* 1
* = -----------------------
* 1
* w - -----------------
* 1
* w+h - ---------
* w+2h - ...
*
* To determine how many terms needed, let
* Q(0) = w, Q(1) = w(w+h) - 1,
* Q(k) = (w+k*h)*Q(k-1) - Q(k-2),
* When Q(k) > 1e4 good for single
* When Q(k) > 1e9 good for double
* When Q(k) > 1e17 good for quadruple
*/
/* determine k */
double t, v;
double q0, q1, h, tmp;
int k, m;
w = (n + n) / (double)x;
h = 2.0 / (double)x;
q0 = w;
z = w + h;
q1 = w * z - 1.0;
k = 1;
while(q1 < 1.0e9) {
k += 1;
z += h;
tmp = z * q1 - q0;
q0 = q1;
q1 = tmp;
}
m = n + n;
for(t = zero, i = 2 * (n + k); i >= m; i -= 2) t = one / (i / x - t);
a = t;
b = one;
/* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n)
* Hence, if n*(log(2n/x)) > ...
* single 8.8722839355e+01
* double 7.09782712893383973096e+02
* long double 1.1356523406294143949491931077970765006170e+04
* then recurrent value may overflow and the result is
* likely underflow to zero
*/
tmp = n;
v = two / x;
tmp = tmp * __fdlibm_log(fabs(v * tmp));
if(tmp < 7.09782712893383973096e+02) {
for(i = n - 1, di = (double)(i + i); i > 0; i--) {
temp = b;
b *= di;
b = b / x - a;
a = temp;
di -= two;
}
} else {
for(i = n - 1, di = (double)(i + i); i > 0; i--) {
temp = b;
b *= di;
b = b / x - a;
a = temp;
di -= two;
/* scale b to avoid spurious overflow */
if(b > 1e100) {
a /= b;
t /= b;
b = one;
}
}
}
b = (t * __fdlibm_j0(x) / b);
}
}
if(sgn == 1) return -b;
else
return b;
}
double __fdlibm_yn(int n, double x) {
int i, hx, ix, lx;
int sign;
double a, b, temp;
hx = __HI(x);
ix = 0x7fffffff & hx;
lx = __LO(x);
/* if Y(n,NaN) is NaN */
if((ix | ((unsigned)(lx | -lx)) >> 31) > 0x7ff00000) return x + x;
if((ix | lx) == 0) return -one / zero;
if(hx < 0) return zero / zero;
sign = 1;
if(n < 0) {
n = -n;
sign = 1 - ((n & 1) << 1);
}
if(n == 0) return (__fdlibm_y0(x));
if(n == 1) return (sign * __fdlibm_y1(x));
if(ix == 0x7ff00000) return zero;
if(ix >= 0x52D00000) { /* x > 2**302 */
/* (x >> n**2)
* Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi)
* Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi)
* Let s=sin(x), c=cos(x),
* xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then
*
* n sin(xn)*sqt2 cos(xn)*sqt2
* ----------------------------------
* 0 s-c c+s
* 1 -s-c -c+s
* 2 -s+c -c-s
* 3 s+c c-s
*/
switch(n & 3) {
case 0:
temp = sin(x) - cos(x);
break;
case 1:
temp = -sin(x) - cos(x);
break;
case 2:
temp = -sin(x) + cos(x);
break;
case 3:
temp = sin(x) + cos(x);
break;
}
b = invsqrtpi * temp / sqrt(x);
} else {
a = __fdlibm_y0(x);
b = __fdlibm_y1(x);
/* quit if b is -inf */
for(i = 1; i < n && (__HI(b) != 0xfff00000); i++) {
temp = b;
b = ((double)(i + i) / x) * b - a;
a = temp;
}
}
if(sign > 0) return b;
else
return -b;
}

27
external/fdlibm/e_lgamma.c vendored Normal file
View File

@@ -0,0 +1,27 @@
/* @(#)e_lgamma.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_lgamma(x)
* Return the logarithm of the Gamma function of x.
*
* Method: call __fdlibm_lgamma_r
*/
#include "math.h"
extern int signgam;
double __fdlibm_lgamma(double x) {
return __fdlibm_lgamma_r(x, &signgam);
}

322
external/fdlibm/e_lgamma_r.c vendored Normal file
View File

@@ -0,0 +1,322 @@
/* @(#)e_lgamma_r.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_lgamma_r(x, signgamp)
* Reentrant version of the logarithm of the Gamma function
* with user provide pointer for the sign of Gamma(x).
*
* Method:
* 1. Argument Reduction for 0 < x <= 8
* Since gamma(1+s)=s*gamma(s), for x in [0,8], we may
* reduce x to a number in [1.5,2.5] by
* lgamma(1+s) = log(s) + lgamma(s)
* for example,
* lgamma(7.3) = log(6.3) + lgamma(6.3)
* = log(6.3*5.3) + lgamma(5.3)
* = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3)
* 2. Polynomial approximation of lgamma around its
* minimun ymin=1.461632144968362245 to maintain monotonicity.
* On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use
* Let z = x-ymin;
* lgamma(x) = -1.214862905358496078218 + z^2*poly(z)
* where
* poly(z) is a 14 degree polynomial.
* 2. Rational approximation in the primary interval [2,3]
* We use the following approximation:
* s = x-2.0;
* lgamma(x) = 0.5*s + s*P(s)/Q(s)
* with accuracy
* |P/Q - (lgamma(x)-0.5s)| < 2**-61.71
* Our algorithms are based on the following observation
*
* zeta(2)-1 2 zeta(3)-1 3
* lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ...
* 2 3
*
* where Euler = 0.5771... is the Euler constant, which is very
* close to 0.5.
*
* 3. For x>=8, we have
* lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+....
* (better formula:
* lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...)
* Let z = 1/x, then we approximation
* f(z) = lgamma(x) - (x-0.5)(log(x)-1)
* by
* 3 5 11
* w = w0 + w1*z + w2*z + w3*z + ... + w6*z
* where
* |w - f(z)| < 2**-58.74
*
* 4. For negative x, since (G is gamma function)
* -x*G(-x)*G(x) = pi/sin(pi*x),
* we have
* G(x) = pi/(sin(pi*x)*(-x)*G(-x))
* since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0
* Hence, for x<0, signgam = sign(sin(pi*x)) and
* lgamma(x) = log(|Gamma(x)|)
* = log(pi/(|x*sin(pi*x)|)) - lgamma(-x);
* Note: one should avoid compute pi*(-x) directly in the
* computation of sin(pi*(-x)).
*
* 5. Special Cases
* lgamma(2+s) ~ s*(1-Euler) for tinyv s
* lgamma(1)=lgamma(2)=0
* lgamma(x) ~ -log(x) for tinyv x
* lgamma(0) = lgamma(inf) = inf
* lgamma(-integer) = +-inf
*
*/
#include "math.h"
static const double
two52 = 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
a0 = 7.72156649015328655494e-02, /* 0x3FB3C467, 0xE37DB0C8 */
a1 = 3.22467033424113591611e-01, /* 0x3FD4A34C, 0xC4A60FAD */
a2 = 6.73523010531292681824e-02, /* 0x3FB13E00, 0x1A5562A7 */
a3 = 2.05808084325167332806e-02, /* 0x3F951322, 0xAC92547B */
a4 = 7.38555086081402883957e-03, /* 0x3F7E404F, 0xB68FEFE8 */
a5 = 2.89051383673415629091e-03, /* 0x3F67ADD8, 0xCCB7926B */
a6 = 1.19270763183362067845e-03, /* 0x3F538A94, 0x116F3F5D */
a7 = 5.10069792153511336608e-04, /* 0x3F40B6C6, 0x89B99C00 */
a8 = 2.20862790713908385557e-04, /* 0x3F2CF2EC, 0xED10E54D */
a9 = 1.08011567247583939954e-04, /* 0x3F1C5088, 0x987DFB07 */
a10 = 2.52144565451257326939e-05, /* 0x3EFA7074, 0x428CFA52 */
a11 = 4.48640949618915160150e-05, /* 0x3F07858E, 0x90A45837 */
tc = 1.46163214496836224576e+00, /* 0x3FF762D8, 0x6356BE3F */
tf = -1.21486290535849611461e-01, /* 0xBFBF19B9, 0xBCC38A42 */
/* tt = -(tail of tf) */
tt = -3.63867699703950536541e-18, /* 0xBC50C7CA, 0xA48A971F */
t0 = 4.83836122723810047042e-01, /* 0x3FDEF72B, 0xC8EE38A2 */
t1 = -1.47587722994593911752e-01, /* 0xBFC2E427, 0x8DC6C509 */
t2 = 6.46249402391333854778e-02, /* 0x3FB08B42, 0x94D5419B */
t3 = -3.27885410759859649565e-02, /* 0xBFA0C9A8, 0xDF35B713 */
t4 = 1.79706750811820387126e-02, /* 0x3F9266E7, 0x970AF9EC */
t5 = -1.03142241298341437450e-02, /* 0xBF851F9F, 0xBA91EC6A */
t6 = 6.10053870246291332635e-03, /* 0x3F78FCE0, 0xE370E344 */
t7 = -3.68452016781138256760e-03, /* 0xBF6E2EFF, 0xB3E914D7 */
t8 = 2.25964780900612472250e-03, /* 0x3F6282D3, 0x2E15C915 */
t9 = -1.40346469989232843813e-03, /* 0xBF56FE8E, 0xBF2D1AF1 */
t10 = 8.81081882437654011382e-04, /* 0x3F4CDF0C, 0xEF61A8E9 */
t11 = -5.38595305356740546715e-04, /* 0xBF41A610, 0x9C73E0EC */
t12 = 3.15632070903625950361e-04, /* 0x3F34AF6D, 0x6C0EBBF7 */
t13 = -3.12754168375120860518e-04, /* 0xBF347F24, 0xECC38C38 */
t14 = 3.35529192635519073543e-04, /* 0x3F35FD3E, 0xE8C2D3F4 */
u0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */
u1 = 6.32827064025093366517e-01, /* 0x3FE4401E, 0x8B005DFF */
u2 = 1.45492250137234768737e+00, /* 0x3FF7475C, 0xD119BD6F */
u3 = 9.77717527963372745603e-01, /* 0x3FEF4976, 0x44EA8450 */
u4 = 2.28963728064692451092e-01, /* 0x3FCD4EAE, 0xF6010924 */
u5 = 1.33810918536787660377e-02, /* 0x3F8B678B, 0xBF2BAB09 */
v1 = 2.45597793713041134822e+00, /* 0x4003A5D7, 0xC2BD619C */
v2 = 2.12848976379893395361e+00, /* 0x40010725, 0xA42B18F5 */
v3 = 7.69285150456672783825e-01, /* 0x3FE89DFB, 0xE45050AF */
v4 = 1.04222645593369134254e-01, /* 0x3FBAAE55, 0xD6537C88 */
v5 = 3.21709242282423911810e-03, /* 0x3F6A5ABB, 0x57D0CF61 */
s0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */
s1 = 2.14982415960608852501e-01, /* 0x3FCB848B, 0x36E20878 */
s2 = 3.25778796408930981787e-01, /* 0x3FD4D98F, 0x4F139F59 */
s3 = 1.46350472652464452805e-01, /* 0x3FC2BB9C, 0xBEE5F2F7 */
s4 = 2.66422703033638609560e-02, /* 0x3F9B481C, 0x7E939961 */
s5 = 1.84028451407337715652e-03, /* 0x3F5E26B6, 0x7368F239 */
s6 = 3.19475326584100867617e-05, /* 0x3F00BFEC, 0xDD17E945 */
r1 = 1.39200533467621045958e+00, /* 0x3FF645A7, 0x62C4AB74 */
r2 = 7.21935547567138069525e-01, /* 0x3FE71A18, 0x93D3DCDC */
r3 = 1.71933865632803078993e-01, /* 0x3FC601ED, 0xCCFBDF27 */
r4 = 1.86459191715652901344e-02, /* 0x3F9317EA, 0x742ED475 */
r5 = 7.77942496381893596434e-04, /* 0x3F497DDA, 0xCA41A95B */
r6 = 7.32668430744625636189e-06, /* 0x3EDEBAF7, 0xA5B38140 */
w0 = 4.18938533204672725052e-01, /* 0x3FDACFE3, 0x90C97D69 */
w1 = 8.33333333333329678849e-02, /* 0x3FB55555, 0x5555553B */
w2 = -2.77777777728775536470e-03, /* 0xBF66C16C, 0x16B02E5C */
w3 = 7.93650558643019558500e-04, /* 0x3F4A019F, 0x98CF38B6 */
w4 = -5.95187557450339963135e-04, /* 0xBF4380CB, 0x8C0FE741 */
w5 = 8.36339918996282139126e-04, /* 0x3F4B67BA, 0x4CDAD5D1 */
w6 = -1.63092934096575273989e-03; /* 0xBF5AB89D, 0x0B9E43E4 */
static double zero = 0.00000000000000000000e+00;
static double sin_pi(double x) {
double y, z;
int n, ix;
ix = 0x7fffffff & __HI(x);
if(ix < 0x3fd00000) return __fdlibm_kernel_sin(pi * x, zero, 0);
y = -x; /* x is assume negative */
/*
* argument reduction, make sure inexact flag not raised if input
* is an integer
*/
z = floor(y);
if(z != y) { /* inexact anyway */
y *= 0.5;
y = 2.0 * (y - floor(y)); /* y = |x| mod 2.0 */
n = (int)(y * 4.0);
} else {
if(ix >= 0x43400000) {
y = zero;
n = 0; /* y must be even */
} else {
if(ix < 0x43300000) z = y + two52; /* exact */
n = __LO(z) & 1; /* lower word of z */
y = n;
n <<= 2;
}
}
switch(n) {
case 0:
y = __fdlibm_kernel_sin(pi * y, zero, 0);
break;
case 1:
case 2:
y = __fdlibm_kernel_cos(pi * (0.5 - y), zero);
break;
case 3:
case 4:
y = __fdlibm_kernel_sin(pi * (one - y), zero, 0);
break;
case 5:
case 6:
y = -__fdlibm_kernel_cos(pi * (y - 1.5), zero);
break;
default:
y = __fdlibm_kernel_sin(pi * (y - 2.0), zero, 0);
break;
}
return -y;
}
double __fdlibm_lgamma_r(double x, int* signgamp) {
double t, y, z, nadj, p, p1, p2, p3, q, r, w;
int i, hx, lx, ix;
hx = __HI(x);
lx = __LO(x);
/* purge off +-inf, NaN, +-0, and negative arguments */
*signgamp = 1;
ix = hx & 0x7fffffff;
if(ix >= 0x7ff00000) return x * x;
if((ix | lx) == 0) return one / zero;
if(ix < 0x3b900000) { /* |x|<2**-70, return -log(|x|) */
if(hx < 0) {
*signgamp = -1;
return -__fdlibm_log(-x);
} else
return -__fdlibm_log(x);
}
if(hx < 0) {
if(ix >= 0x43300000) /* |x|>=2**52, must be -integer */
return one / zero;
t = sin_pi(x);
if(t == zero) return one / zero; /* -integer */
nadj = __fdlibm_log(pi / fabs(t * x));
if(t < zero) *signgamp = -1;
x = -x;
}
/* purge off 1 and 2 */
if((((ix - 0x3ff00000) | lx) == 0) || (((ix - 0x40000000) | lx) == 0)) r = 0;
/* for x < 2.0 */
else if(ix < 0x40000000) {
if(ix <= 0x3feccccc) { /* lgamma(x) = lgamma(x+1)-log(x) */
r = -__fdlibm_log(x);
if(ix >= 0x3FE76944) {
y = one - x;
i = 0;
} else if(ix >= 0x3FCDA661) {
y = x - (tc - one);
i = 1;
} else {
y = x;
i = 2;
}
} else {
r = zero;
if(ix >= 0x3FFBB4C3) {
y = 2.0 - x;
i = 0;
} /* [1.7316,2] */
else if(ix >= 0x3FF3B4C4) {
y = x - tc;
i = 1;
} /* [1.23,1.73] */
else {
y = x - one;
i = 2;
}
}
switch(i) {
case 0:
z = y * y;
p1 = a0 + z * (a2 + z * (a4 + z * (a6 + z * (a8 + z * a10))));
p2 = z * (a1 + z * (a3 + z * (a5 + z * (a7 + z * (a9 + z * a11)))));
p = y * p1 + p2;
r += (p - 0.5 * y);
break;
case 1:
z = y * y;
w = z * y;
p1 = t0 + w * (t3 + w * (t6 + w * (t9 + w * t12))); /* parallel comp */
p2 = t1 + w * (t4 + w * (t7 + w * (t10 + w * t13)));
p3 = t2 + w * (t5 + w * (t8 + w * (t11 + w * t14)));
p = z * p1 - (tt - w * (p2 + y * p3));
r += (tf + p);
break;
case 2:
p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * u5)))));
p2 = one + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * v5))));
r += (-0.5 * y + p1 / p2);
}
} else if(ix < 0x40200000) { /* x < 8.0 */
i = (int)x;
t = zero;
y = x - (double)i;
p = y * (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6))))));
q = one + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * r6)))));
r = half * y + p / q;
z = one; /* lgamma(1+s) = log(s) + lgamma(s) */
switch(i) {
case 7:
z *= (y + 6.0); /* FALLTHRU */
case 6:
z *= (y + 5.0); /* FALLTHRU */
case 5:
z *= (y + 4.0); /* FALLTHRU */
case 4:
z *= (y + 3.0); /* FALLTHRU */
case 3:
z *= (y + 2.0); /* FALLTHRU */
r += __fdlibm_log(z);
break;
}
/* 8.0 <= x < 2**58 */
} else if(ix < 0x43900000) {
t = __fdlibm_log(x);
z = one / x;
y = z * z;
w = w0 + z * (w1 + y * (w2 + y * (w3 + y * (w4 + y * (w5 + y * w6)))));
r = (x - half) * (t - one) + w;
} else
/* 2**58 <= x <= inf */
r = x * (__fdlibm_log(x) - one);
if(hx < 0) r = nadj - r;
return r;
}

139
external/fdlibm/e_log.c vendored Normal file
View File

@@ -0,0 +1,139 @@
/* @(#)e_log.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_log(x)
* Return the logrithm of x
*
* Method :
* 1. Argument Reduction: find k and f such that
* x = 2^k * (1+f),
* where sqrt(2)/2 < 1+f < sqrt(2) .
*
* 2. Approximation of log(1+f).
* Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
* = 2s + 2/3 s**3 + 2/5 s**5 + .....,
* = 2s + s*R
* We use a special Reme algorithm on [0,0.1716] to generate
* a polynomial of degree 14 to approximate R The maximum error
* of this polynomial approximation is bounded by 2**-58.45. In
* other words,
* 2 4 6 8 10 12 14
* R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s
* (the values of Lg1 to Lg7 are listed in the program)
* and
* | 2 14 | -58.45
* | Lg1*s +...+Lg7*s - R(z) | <= 2
* | |
* Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
* In order to guarantee error in log below 1ulp, we compute log
* by
* log(1+f) = f - s*(f - R) (if f is not too large)
* log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy)
*
* 3. Finally, log(x) = k*ln2 + log(1+f).
* = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
* Here ln2 is split into two floating point number:
* ln2_hi + ln2_lo,
* where n*ln2_hi is always exact for |n| < 2000.
*
* Special cases:
* log(x) is NaN with signal if x < 0 (including -INF) ;
* log(+INF) is +INF; log(0) is -INF with signal;
* log(NaN) is that NaN with no signal.
*
* Accuracy:
* according to an error analysis, the error is always less than
* 1 ulp (unit in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const double
ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
static double zero = 0.0;
double __fdlibm_log(double x) {
double hfsq, f, s, z, R, w, t1, t2, dk;
int k, hx, i, j;
unsigned lx;
hx = __HI(x); /* high word of x */
lx = __LO(x); /* low word of x */
k = 0;
if(hx < 0x00100000) { /* x < 2**-1022 */
if(((hx & 0x7fffffff) | lx) == 0)
return -two54 / zero; /* log(+-0)=-inf */
if(hx < 0) return (x - x) / zero; /* log(-#) = NaN */
k -= 54;
x *= two54; /* subnormal number, scale up x */
hx = __HI(x); /* high word of x */
}
if(hx >= 0x7ff00000) return x + x;
k += (hx >> 20) - 1023;
hx &= 0x000fffff;
i = (hx + 0x95f64) & 0x100000;
__HI(x) = hx | (i ^ 0x3ff00000); /* normalize x or x/2 */
k += (i >> 20);
f = x - 1.0;
if((0x000fffff & (2 + hx)) < 3) { /* |f| < 2**-20 */
if(f == zero)
if(k == 0) return zero;
else {
dk = (double)k;
return dk * ln2_hi + dk * ln2_lo;
}
R = f * f * (0.5 - 0.33333333333333333 * f);
if(k == 0) return f - R;
else {
dk = (double)k;
return dk * ln2_hi - ((R - dk * ln2_lo) - f);
}
}
s = f / (2.0 + f);
dk = (double)k;
z = s * s;
i = hx - 0x6147a;
w = z * z;
j = 0x6b851 - hx;
t1 = w * (Lg2 + w * (Lg4 + w * Lg6));
t2 = z * (Lg1 + w * (Lg3 + w * (Lg5 + w * Lg7)));
i |= j;
R = t2 + t1;
if(i > 0) {
hfsq = 0.5 * f * f;
if(k == 0) return f - (hfsq - s * (hfsq + R));
else
return dk * ln2_hi - ((hfsq - (s * (hfsq + R) + dk * ln2_lo)) - f);
} else {
if(k == 0) return f - s * (f - R);
else
return dk * ln2_hi - ((s * (f - R) - dk * ln2_lo) - f);
}
}

82
external/fdlibm/e_log10.c vendored Normal file
View File

@@ -0,0 +1,82 @@
/* @(#)e_log10.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_log10(x)
* Return the base 10 logarithm of x
*
* Method :
* Let log10_2hi = leading 40 bits of log10(2) and
* log10_2lo = log10(2) - log10_2hi,
* ivln10 = 1/log(10) rounded.
* Then
* n = ilogb(x),
* if(n<0) n = n+1;
* x = scalbn(x,-n);
* log10(x) := n*log10_2hi + (n*log10_2lo + ivln10*log(x))
*
* Note 1:
* To guarantee log10(10**n)=n, where 10**n is normal, the rounding
* mode must set to Round-to-Nearest.
* Note 2:
* [1/log(10)] rounded to 53 bits has error .198 ulps;
* log10 is monotonic at all binary break points.
*
* Special cases:
* log10(x) is NaN with signal if x < 0;
* log10(+INF) is +INF with no signal; log10(0) is -INF with signal;
* log10(NaN) is that NaN with no signal;
* log10(10**N) = N for N=0,1,...,22.
*
* Constants:
* The hexadecimal values are the intended ones for the following constants.
* The decimal values may be used, provided that the compiler will convert
* from decimal to binary accurately enough to produce the hexadecimal values
* shown.
*/
#include "math.h"
static const double
two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
ivln10 = 4.34294481903251816668e-01, /* 0x3FDBCB7B, 0x1526E50E */
log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */
log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */
static double zero = 0.0;
double __fdlibm_log10(double x) {
double y, z;
int i, k, hx;
unsigned lx;
hx = __HI(x); /* high word of x */
lx = __LO(x); /* low word of x */
k = 0;
if(hx < 0x00100000) { /* x < 2**-1022 */
if(((hx & 0x7fffffff) | lx) == 0)
return -two54 / zero; /* log(+-0)=-inf */
if(hx < 0) return (x - x) / zero; /* log(-#) = NaN */
k -= 54;
x *= two54; /* subnormal number, scale up x */
hx = __HI(x); /* high word of x */
}
if(hx >= 0x7ff00000) return x + x;
k += (hx >> 20) - 1023;
i = ((unsigned)k & 0x80000000) >> 31;
hx = (hx & 0x000fffff) | ((0x3ff - i) << 20);
y = (double)(k + i);
__HI(x) = hx;
z = y * log10_2lo + ivln10 * __fdlibm_log(x);
return z + y * log10_2hi;
}

314
external/fdlibm/e_pow.c vendored Normal file
View File

@@ -0,0 +1,314 @@
/*
* ====================================================
* Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
*
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_pow(x,y) return x**y
*
* n
* Method: Let x = 2 * (1+f)
* 1. Compute and return log2(x) in two pieces:
* log2(x) = w1 + w2,
* where w1 has 53-24 = 29 bit trailing zeros.
* 2. Perform y*log2(x) = n+y' by simulating muti-precision
* arithmetic, where |y'|<=0.5.
* 3. Return x**y = 2**n*exp(y'*log2)
*
* Special cases:
* 1. (anything) ** 0 is 1
* 2. (anything) ** 1 is itself
* 3. (anything) ** NAN is NAN
* 4. NAN ** (anything except 0) is NAN
* 5. +-(|x| > 1) ** +INF is +INF
* 6. +-(|x| > 1) ** -INF is +0
* 7. +-(|x| < 1) ** +INF is +0
* 8. +-(|x| < 1) ** -INF is +INF
* 9. +-1 ** +-INF is NAN
* 10. +0 ** (+anything except 0, NAN) is +0
* 11. -0 ** (+anything except 0, NAN, odd integer) is +0
* 12. +0 ** (-anything except 0, NAN) is +INF
* 13. -0 ** (-anything except 0, NAN, odd integer) is +INF
* 14. -0 ** (odd integer) = -( +0 ** (odd integer) )
* 15. +INF ** (+anything except 0,NAN) is +INF
* 16. +INF ** (-anything except 0,NAN) is +0
* 17. -INF ** (anything) = -0 ** (-anything)
* 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer)
* 19. (-anything except 0 and inf) ** (non-integer) is NAN
*
* Accuracy:
* pow(x,y) returns x**y nearly rounded. In particular
* pow(integer,integer)
* always returns the correct integer provided it is
* representable.
*
* Constants :
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const double
bp[] = {
1.0,
1.5,
},
dp_h[] = {
0.0,
5.84962487220764160156e-01,
}, /* 0x3FE2B803, 0x40000000 */
dp_l[] = {
0.0,
1.35003920212974897128e-08,
}, /* 0x3E4CFDEB, 0x43CFD006 */
zero = 0.0, one = 1.0, two = 2.0, two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */
hugev = 1.0e300, tinyv = 1.0e-300,
/* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */
L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */
L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */
L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */
L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */
L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */
P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */
lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */
lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */
ovt = 8.0085662595372944372e-0017, /* -(1024-log2(ovfl+.5ulp)) */
cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */
cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */
cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/
ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */
ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/
ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/
double __fdlibm_pow(double x, double y) {
double z, ax, z_h, z_l, p_h, p_l;
double y1, t1, t2, r, s, t, u, v, w;
int i0, i1, i, j, k, yisint, n;
int hx, hy, ix, iy;
unsigned lx, ly;
i0 = ((*(int*)&one) >> 29) ^ 1;
i1 = 1 - i0;
hx = __HI(x);
lx = __LO(x);
hy = __HI(y);
ly = __LO(y);
ix = hx & 0x7fffffff;
iy = hy & 0x7fffffff;
/* y==zero: x**0 = 1 */
if((iy | ly) == 0) return one;
/* +-NaN return x+y */
if(ix > 0x7ff00000 || ((ix == 0x7ff00000) && (lx != 0)) ||
iy > 0x7ff00000 || ((iy == 0x7ff00000) && (ly != 0)))
return x + y;
/* determine if y is an odd int when x < 0
* yisint = 0 ... y is not an integer
* yisint = 1 ... y is an odd int
* yisint = 2 ... y is an even int
*/
yisint = 0;
if(hx < 0) {
if(iy >= 0x43400000) yisint = 2; /* even integer y */
else if(iy >= 0x3ff00000) {
k = (iy >> 20) - 0x3ff; /* exponent */
if(k > 20) {
j = ly >> (52 - k);
if((j << (52 - k)) == ly) yisint = 2 - (j & 1);
} else if(ly == 0) {
j = iy >> (20 - k);
if((j << (20 - k)) == iy) yisint = 2 - (j & 1);
}
}
}
/* special value of y */
if(ly == 0) {
if(iy == 0x7ff00000) { /* y is +-inf */
if(((ix - 0x3ff00000) | lx) == 0)
return y - y; /* inf**+-1 is NaN */
else if(ix >= 0x3ff00000) /* (|x|>1)**+-inf = inf,0 */
return (hy >= 0) ? y : zero;
else /* (|x|<1)**-,+inf = inf,0 */
return (hy < 0) ? -y : zero;
}
if(iy == 0x3ff00000) { /* y is +-1 */
if(hy < 0) return one / x;
else
return x;
}
if(hy == 0x40000000) return x * x; /* y is 2 */
if(hy == 0x3fe00000) { /* y is 0.5 */
if(hx >= 0) /* x >= +0 */
return sqrt(x);
}
}
ax = fabs(x);
/* special value of x */
if(lx == 0) {
if(ix == 0x7ff00000 || ix == 0 || ix == 0x3ff00000) {
z = ax; /*x is +-0,+-inf,+-1*/
if(hy < 0) z = one / z; /* z = (1/|x|) */
if(hx < 0) {
if(((ix - 0x3ff00000) | yisint) == 0) {
z = (z - z) / (z - z); /* (-1)**non-int is NaN */
} else if(yisint == 1)
z = -z; /* (x<0)**odd = -(|x|**odd) */
}
return z;
}
}
n = (hx >> 31) + 1;
/* (x<0)**(non-int) is NaN */
if((n | yisint) == 0) return (x - x) / (x - x);
s = one; /* s (sign of result -ve**odd) = -1 else = 1 */
if((n | (yisint - 1)) == 0) s = -one; /* (-ve)**(odd int) */
/* |y| is hugev */
if(iy > 0x41e00000) { /* if |y| > 2**31 */
if(iy > 0x43f00000) { /* if |y| > 2**64, must o/uflow */
if(ix <= 0x3fefffff) return (hy < 0) ? hugev * hugev : tinyv * tinyv;
if(ix >= 0x3ff00000) return (hy > 0) ? hugev * hugev : tinyv * tinyv;
}
/* over/underflow if x is not close to one */
if(ix < 0x3fefffff) return (hy < 0) ? s * hugev * hugev : s * tinyv * tinyv;
if(ix > 0x3ff00000) return (hy > 0) ? s * hugev * hugev : s * tinyv * tinyv;
/* now |1-x| is tinyv <= 2**-20, suffice to compute
log(x) by x-x^2/2+x^3/3-x^4/4 */
t = ax - one; /* t has 20 trailing zeros */
w = (t * t) * (0.5 - t * (0.3333333333333333333333 - t * 0.25));
u = ivln2_h * t; /* ivln2_h has 21 sig. bits */
v = t * ivln2_l - w * ivln2;
t1 = u + v;
__LO(t1) = 0;
t2 = v - (t1 - u);
} else {
double ss, s2, s_h, s_l, t_h, t_l;
n = 0;
/* take care subnormal number */
if(ix < 0x00100000) {
ax *= two53;
n -= 53;
ix = __HI(ax);
}
n += ((ix) >> 20) - 0x3ff;
j = ix & 0x000fffff;
/* determine interval */
ix = j | 0x3ff00000; /* normalize ix */
if(j <= 0x3988E) k = 0; /* |x|<sqrt(3/2) */
else if(j < 0xBB67A)
k = 1; /* |x|<sqrt(3) */
else {
k = 0;
n += 1;
ix -= 0x00100000;
}
__HI(ax) = ix;
/* compute ss = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
v = one / (ax + bp[k]);
ss = u * v;
s_h = ss;
__LO(s_h) = 0;
/* t_h=ax+bp[k] High */
t_h = zero;
__HI(t_h) = ((ix >> 1) | 0x20000000) + 0x00080000 + (k << 18);
t_l = ax - (t_h - bp[k]);
s_l = v * ((u - s_h * t_h) - s_h * t_l);
/* compute log(ax) */
s2 = ss * ss;
r = s2 * s2 * (L1 + s2 * (L2 + s2 * (L3 + s2 * (L4 + s2 * (L5 + s2 * L6)))));
r += s_l * (s_h + ss);
s2 = s_h * s_h;
t_h = 3.0 + s2 + r;
__LO(t_h) = 0;
t_l = r - ((t_h - 3.0) - s2);
/* u+v = ss*(1+...) */
u = s_h * t_h;
v = s_l * t_h + t_l * ss;
/* 2/(3log2)*(ss+...) */
p_h = u + v;
__LO(p_h) = 0;
p_l = v - (p_h - u);
z_h = cp_h * p_h; /* cp_h+cp_l = 2/(3*log2) */
z_l = cp_l * p_h + p_l * cp + dp_l[k];
/* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */
t = (double)n;
t1 = (((z_h + z_l) + dp_h[k]) + t);
__LO(t1) = 0;
t2 = z_l - (((t1 - t) - dp_h[k]) - z_h);
}
/* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
y1 = y;
__LO(y1) = 0;
p_l = (y - y1) * t1 + y * t2;
p_h = y1 * t1;
z = p_l + p_h;
j = __HI(z);
i = __LO(z);
if(j >= 0x40900000) { /* z >= 1024 */
if(((j - 0x40900000) | i) != 0) /* if z > 1024 */
return s * hugev * hugev; /* overflow */
else {
if(p_l + ovt > z - p_h) return s * hugev * hugev; /* overflow */
}
} else if((j & 0x7fffffff) >= 0x4090cc00) { /* z <= -1075 */
if(((j - 0xc090cc00) | i) != 0) /* z < -1075 */
return s * tinyv * tinyv; /* underflow */
else {
if(p_l <= z - p_h) return s * tinyv * tinyv; /* underflow */
}
}
/*
* compute 2**(p_h+p_l)
*/
i = j & 0x7fffffff;
k = (i >> 20) - 0x3ff;
n = 0;
if(i > 0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */
n = j + (0x00100000 >> (k + 1));
k = ((n & 0x7fffffff) >> 20) - 0x3ff; /* new k for n */
t = zero;
__HI(t) = (n & ~(0x000fffff >> k));
n = ((n & 0x000fffff) | 0x00100000) >> (20 - k);
if(j < 0) n = -n;
p_h -= t;
}
t = p_l + p_h;
__LO(t) = 0;
u = t * lg2_h;
v = (p_l - (t - p_h)) * lg2 + t * lg2_l;
z = u + v;
w = v - (z - u);
t = z * z;
t1 = z - t * (P1 + t * (P2 + t * (P3 + t * (P4 + t * P5))));
r = (z * t1) / (t1 - two) - (w + z * w);
z = one - (r - z);
j = __HI(z);
j += (n << 20);
if((j >> 20) <= 0) z = scalbn(z, n); /* subnormal output */
else
__HI(z) += (n << 20);
return s * z;
}

251
external/fdlibm/e_rem_pio2.c vendored Normal file
View File

@@ -0,0 +1,251 @@
/* @(#)e_rem_pio2.c 1.4 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* __fdlibm_rem_pio2(x,y)
*
* return the remainder of x rem pi/2 in y[0]+y[1]
* use __fdlibm_rem_pio2()
*/
#include "math.h"
/*
* Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi
*/
static const int two_over_pi[] = {
0xA2F983,
0x6E4E44,
0x1529FC,
0x2757D1,
0xF534DD,
0xC0DB62,
0x95993C,
0x439041,
0xFE5163,
0xABDEBB,
0xC561B7,
0x246E3A,
0x424DD2,
0xE00649,
0x2EEA09,
0xD1921C,
0xFE1DEB,
0x1CB129,
0xA73EE8,
0x8235F5,
0x2EBB44,
0x84E99C,
0x7026B4,
0x5F7E41,
0x3991D6,
0x398353,
0x39F49C,
0x845F8B,
0xBDF928,
0x3B1FF8,
0x97FFDE,
0x05980F,
0xEF2F11,
0x8B5A0A,
0x6D1F6D,
0x367ECF,
0x27CB09,
0xB74F46,
0x3F669E,
0x5FEA2D,
0x7527BA,
0xC7EBE5,
0xF17B3D,
0x0739F7,
0x8A5292,
0xEA6BFB,
0x5FB11F,
0x8D5D08,
0x560330,
0x46FC7B,
0x6BABF0,
0xCFBC20,
0x9AF436,
0x1DA9E3,
0x91615E,
0xE61B08,
0x659985,
0x5F14A0,
0x68408D,
0xFFD880,
0x4D7327,
0x310606,
0x1556CA,
0x73A8C9,
0x60E27B,
0xC08C6B,
};
static const int npio2_hw[] = {
0x3FF921FB,
0x400921FB,
0x4012D97C,
0x401921FB,
0x401F6A7A,
0x4022D97C,
0x4025FDBB,
0x402921FB,
0x402C463A,
0x402F6A7A,
0x4031475C,
0x4032D97C,
0x40346B9C,
0x4035FDBB,
0x40378FDB,
0x403921FB,
0x403AB41B,
0x403C463A,
0x403DD85A,
0x403F6A7A,
0x40407E4C,
0x4041475C,
0x4042106C,
0x4042D97C,
0x4043A28C,
0x40446B9C,
0x404534AC,
0x4045FDBB,
0x4046C6CB,
0x40478FDB,
0x404858EB,
0x404921FB,
};
/*
* invpio2: 53 bits of 2/pi
* pio2_1: first 33 bit of pi/2
* pio2_1t: pi/2 - pio2_1
* pio2_2: second 33 bit of pi/2
* pio2_2t: pi/2 - (pio2_1+pio2_2)
* pio2_3: third 33 bit of pi/2
* pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
*/
static const double
zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
pio2_1 = 1.57079632673412561417e+00, /* 0x3FF921FB, 0x54400000 */
pio2_1t = 6.07710050650619224932e-11, /* 0x3DD0B461, 0x1A626331 */
pio2_2 = 6.07710050630396597660e-11, /* 0x3DD0B461, 0x1A600000 */
pio2_2t = 2.02226624879595063154e-21, /* 0x3BA3198A, 0x2E037073 */
pio2_3 = 2.02226624871116645580e-21, /* 0x3BA3198A, 0x2E000000 */
pio2_3t = 8.47842766036889956997e-32; /* 0x397B839A, 0x252049C1 */
int __fdlibm_rem_pio2(double x, double* y) {
double z, w, t, r, fn;
double tx[3];
int e0, i, j, nx, n, ix, hx;
hx = __HI(x); /* high word of x */
ix = hx & 0x7fffffff;
if(ix <= 0x3fe921fb) /* |x| ~<= pi/4 , no need for reduction */
{
y[0] = x;
y[1] = 0;
return 0;
}
if(ix < 0x4002d97c) { /* |x| < 3pi/4, special case with n=+-1 */
if(hx > 0) {
z = x - pio2_1;
if(ix != 0x3ff921fb) { /* 33+53 bit pi is good enough */
y[0] = z - pio2_1t;
y[1] = (z - y[0]) - pio2_1t;
} else { /* near pi/2, use 33+33+53 bit pi */
z -= pio2_2;
y[0] = z - pio2_2t;
y[1] = (z - y[0]) - pio2_2t;
}
return 1;
} else { /* negative x */
z = x + pio2_1;
if(ix != 0x3ff921fb) { /* 33+53 bit pi is good enough */
y[0] = z + pio2_1t;
y[1] = (z - y[0]) + pio2_1t;
} else { /* near pi/2, use 33+33+53 bit pi */
z += pio2_2;
y[0] = z + pio2_2t;
y[1] = (z - y[0]) + pio2_2t;
}
return -1;
}
}
if(ix <= 0x413921fb) { /* |x| ~<= 2^19*(pi/2), medium size */
t = fabs(x);
n = (int)(t * invpio2 + half);
fn = (double)n;
r = t - fn * pio2_1;
w = fn * pio2_1t; /* 1st round good to 85 bit */
if(n < 32 && ix != npio2_hw[n - 1]) {
y[0] = r - w; /* quick check no cancellation */
} else {
j = ix >> 20;
y[0] = r - w;
i = j - (((__HI(y[0])) >> 20) & 0x7ff);
if(i > 16) { /* 2nd iteration needed, good to 118 */
t = r;
w = fn * pio2_2;
r = t - w;
w = fn * pio2_2t - ((t - r) - w);
y[0] = r - w;
i = j - (((__HI(y[0])) >> 20) & 0x7ff);
if(i > 49) { /* 3rd iteration need, 151 bits acc */
t = r; /* will cover all possible cases */
w = fn * pio2_3;
r = t - w;
w = fn * pio2_3t - ((t - r) - w);
y[0] = r - w;
}
}
}
y[1] = (r - y[0]) - w;
if(hx < 0) {
y[0] = -y[0];
y[1] = -y[1];
return -n;
} else
return n;
}
/*
* all other (large) arguments
*/
if(ix >= 0x7ff00000) { /* x is inf or NaN */
y[0] = y[1] = x - x;
return 0;
}
/* set z = scalbn(|x|,ilogb(x)-23) */
__LO(z) = __LO(x);
e0 = (ix >> 20) - 1046; /* e0 = ilogb(z)-23; */
__HI(z) = ix - (e0 << 20);
for(i = 0; i < 2; i++) {
tx[i] = (double)((int)(z));
z = (z - tx[i]) * two24;
}
tx[2] = z;
nx = 3;
while(tx[nx - 1] == zero) nx--; /* skip zero term */
n = __fdlibm_kernel_rem_pio2(tx, y, e0, nx, 2, two_over_pi);
if(hx < 0) {
y[0] = -y[0];
y[1] = -y[1];
return -n;
}
return n;
}

65
external/fdlibm/e_remainder.c vendored Normal file
View File

@@ -0,0 +1,65 @@
/* @(#)e_remainder.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_remainder(x,p)
* Return :
* returns x REM p = x - [x/p]*p as if in infinite
* precise arithmetic, where [x/p] is the (infinite bit)
* integer nearest x/p (in half way case choose the even one).
* Method :
* Based on fmod() return x-[x/p]chopped*p exactlp.
*/
#include "math.h"
static const double zero = 0.0;
double __fdlibm_remainder(double x, double p) {
int hx, hp;
unsigned sx, lx, lp;
double p_half;
hx = __HI(x); /* high word of x */
lx = __LO(x); /* low word of x */
hp = __HI(p); /* high word of p */
lp = __LO(p); /* low word of p */
sx = hx & 0x80000000;
hp &= 0x7fffffff;
hx &= 0x7fffffff;
/* purge off exception values */
if((hp | lp) == 0) return (x * p) / (x * p); /* p = 0 */
if((hx >= 0x7ff00000) || /* x not finite */
((hp >= 0x7ff00000) && /* p is NaN */
(((hp - 0x7ff00000) | lp) != 0)))
return (x * p) / (x * p);
if(hp <= 0x7fdfffff) x = __fdlibm_fmod(x, p + p); /* now x < 2p */
if(((hx - hp) | (lx - lp)) == 0) return zero * x;
x = fabs(x);
p = fabs(p);
if(hp < 0x00200000) {
if(x + x > p) {
x -= p;
if(x + x >= p) x -= p;
}
} else {
p_half = 0.5 * p;
if(x > p_half) {
x -= p;
if(x >= p_half) x -= p;
}
}
__HI(x) ^= sx;
return x;
}

42
external/fdlibm/e_scalb.c vendored Normal file
View File

@@ -0,0 +1,42 @@
/* @(#)e_scalb.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __fdlibm_scalb(x, fn) is provide for
* passing various standard test suite. One
* should use scalbn() instead.
*/
#include "math.h"
#ifdef _SCALB_INT
double __fdlibm_scalb(double x, int fn)
#else
double __fdlibm_scalb(double x, double fn)
#endif
{
#ifdef _SCALB_INT
return scalbn(x, fn);
#else
if(isnan(x) || isnan(fn)) return x * fn;
if(!finite(fn)) {
if(fn > 0.0) return x * fn;
else
return x / (-fn);
}
if(rint(fn) != fn) return (fn - fn) / (fn - fn);
if(fn > 65000.0) return scalbn(x, 65000);
if(-fn > 65000.0) return scalbn(x, -65000);
return scalbn(x, (int)fn);
#endif
}

72
external/fdlibm/e_sinh.c vendored Normal file
View File

@@ -0,0 +1,72 @@
/* @(#)e_sinh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_sinh(x)
* Method :
* mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2
* 1. Replace x by |x| (sinh(-x) = -sinh(x)).
* 2.
* E + E/(E+1)
* 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x)
* 2
*
* 22 <= x <= lnovft : sinh(x) := exp(x)/2
* lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2)
* ln2ovft < x : sinh(x) := x*shugev (overflow)
*
* Special cases:
* sinh(x) is |x| if x is +INF, -INF, or NaN.
* only sinh(0)=0 is exact for finite x.
*/
#include "math.h"
static const double one = 1.0, shugev = 1.0e307;
double __fdlibm_sinh(double x) {
double t, w, h;
int ix, jx;
unsigned lx;
/* High word of |x|. */
jx = __HI(x);
ix = jx & 0x7fffffff;
/* x is INF or NaN */
if(ix >= 0x7ff00000) return x + x;
h = 0.5;
if(jx < 0) h = -h;
/* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */
if(ix < 0x40360000) { /* |x|<22 */
if(ix < 0x3e300000) /* |x|<2**-28 */
if(shugev + x > one) return x; /* sinh(tinyv) = tinyv with inexact */
t = expm1(fabs(x));
if(ix < 0x3ff00000) return h * (2.0 * t - t * t / (t + one));
return h * (t + t / (t + one));
}
/* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */
if(ix < 0x40862E42) return h * __fdlibm_exp(fabs(x));
/* |x| in [log(maxdouble), overflowthresold] */
lx = *((((*(unsigned*)&one) >> 29)) + (unsigned*)&x);
if(ix < 0x408633CE || (ix == 0x408633ce) && (lx <= (unsigned)0x8fb9f87d)) {
w = __fdlibm_exp(0.5 * fabs(x));
t = h * w;
return t * w;
}
/* |x| > overflowthresold, sinh(x) overflow */
return x * shugev;
}

442
external/fdlibm/e_sqrt.c vendored Normal file
View File

@@ -0,0 +1,442 @@
/* @(#)e_sqrt.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_sqrt(x)
* Return correctly rounded sqrt.
* ------------------------------------------
* | Use the hardware sqrt if you have one |
* ------------------------------------------
* Method:
* Bit by bit method using integer arithmetic. (Slow, but portable)
* 1. Normalization
* Scale x to y in [1,4) with even powers of 2:
* find an integer k such that 1 <= (y=x*2^(2k)) < 4, then
* sqrt(x) = 2^k * sqrt(y)
* 2. Bit by bit computation
* Let q = sqrt(y) truncated to i bit after binary point (q = 1),
* i 0
* i+1 2
* s = 2*q , and y = 2 * ( y - q ). (1)
* i i i i
*
* To compute q from q , one checks whether
* i+1 i
*
* -(i+1) 2
* (q + 2 ) <= y. (2)
* i
* -(i+1)
* If (2) is false, then q = q ; otherwise q = q + 2 .
* i+1 i i+1 i
*
* With some algebric manipulation, it is not difficult to see
* that (2) is equivalent to
* -(i+1)
* s + 2 <= y (3)
* i i
*
* The advantage of (3) is that s and y can be computed by
* i i
* the following recurrence formula:
* if (3) is false
*
* s = s , y = y ; (4)
* i+1 i i+1 i
*
* otherwise,
* -i -(i+1)
* s = s + 2 , y = y - s - 2 (5)
* i+1 i i+1 i i
*
* One may easily use induction to prove (4) and (5).
* Note. Since the left hand side of (3) contain only i+2 bits,
* it does not necessary to do a full (53-bit) comparison
* in (3).
* 3. Final rounding
* After generating the 53 bits result, we compute one more bit.
* Together with the remainder, we can decide whether the
* result is exact, bigger than 1/2ulp, or less than 1/2ulp
* (it will never equal to 1/2ulp).
* The rounding mode can be detected by checking whether
* hugev + tinyv is equal to hugev, and whether hugev - tinyv is
* equal to hugev for some floating point number "hugev" and "tinyv".
*
* Special cases:
* sqrt(+-0) = +-0 ... exact
* sqrt(inf) = inf
* sqrt(-ve) = NaN ... with invalid signal
* sqrt(NaN) = NaN ... with invalid signal for signaling NaN
*
* Other methods : see the appended file at the end of the program below.
*---------------
*/
#include "math.h"
static const double one = 1.0, tinyv = 1.0e-300;
double __fdlibm_sqrt(double x) {
double z;
int sign = (int)0x80000000;
unsigned r, t1, s1, ix1, q1;
int ix0, s0, q, m, t, i;
ix0 = __HI(x); /* high word of x */
ix1 = __LO(x); /* low word of x */
/* take care of Inf and NaN */
if((ix0 & 0x7ff00000) == 0x7ff00000) {
return x * x + x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf
sqrt(-inf)=sNaN */
}
/* take care of zero */
if(ix0 <= 0) {
if(((ix0 & (~sign)) | ix1) == 0) return x; /* sqrt(+-0) = +-0 */
else if(ix0 < 0)
return (x - x) / (x - x); /* sqrt(-ve) = sNaN */
}
/* normalize x */
m = (ix0 >> 20);
if(m == 0) { /* subnormal x */
while(ix0 == 0) {
m -= 21;
ix0 |= (ix1 >> 11);
ix1 <<= 21;
}
for(i = 0; (ix0 & 0x00100000) == 0; i++) ix0 <<= 1;
m -= i - 1;
ix0 |= (ix1 >> (32 - i));
ix1 <<= i;
}
m -= 1023; /* unbias exponent */
ix0 = (ix0 & 0x000fffff) | 0x00100000;
if(m & 1) { /* odd m, double x to make it even */
ix0 += ix0 + ((ix1 & sign) >> 31);
ix1 += ix1;
}
m >>= 1; /* m = [m/2] */
/* generate sqrt(x) bit by bit */
ix0 += ix0 + ((ix1 & sign) >> 31);
ix1 += ix1;
q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */
r = 0x00200000; /* r = moving bit from right to left */
while(r != 0) {
t = s0 + r;
if(t <= ix0) {
s0 = t + r;
ix0 -= t;
q += r;
}
ix0 += ix0 + ((ix1 & sign) >> 31);
ix1 += ix1;
r >>= 1;
}
r = sign;
while(r != 0) {
t1 = s1 + r;
t = s0;
if((t < ix0) || ((t == ix0) && (t1 <= ix1))) {
s1 = t1 + r;
if(((t1 & sign) == sign) && (s1 & sign) == 0) s0 += 1;
ix0 -= t;
if(ix1 < t1) ix0 -= 1;
ix1 -= t1;
q1 += r;
}
ix0 += ix0 + ((ix1 & sign) >> 31);
ix1 += ix1;
r >>= 1;
}
/* use floating add to find out rounding direction */
if((ix0 | ix1) != 0) {
z = one - tinyv; /* trigger inexact flag */
if(z >= one) {
z = one + tinyv;
if(q1 == (unsigned)0xffffffff) {
q1 = 0;
q += 1;
} else if(z > one) {
if(q1 == (unsigned)0xfffffffe) q += 1;
q1 += 2;
} else
q1 += (q1 & 1);
}
}
ix0 = (q >> 1) + 0x3fe00000;
ix1 = q1 >> 1;
if((q & 1) == 1) ix1 |= sign;
ix0 += (m << 20);
__HI(z) = ix0;
__LO(z) = ix1;
return z;
}
/*
Other methods (use floating-point arithmetic)
-------------
(This is a copy of a drafted paper by Prof W. Kahan
and K.C. Ng, written in May, 1986)
Two algorithms are given here to implement sqrt(x)
(IEEE double precision arithmetic) in software.
Both supply sqrt(x) correctly rounded. The first algorithm (in
Section A) uses newton iterations and involves four divisions.
The second one uses reciproot iterations to avoid division, but
requires more multiplications. Both algorithms need the ability
to chop results of arithmetic operations instead of round them,
and the INEXACT flag to indicate when an arithmetic operation
is executed exactly with no roundoff error, all part of the
standard (IEEE 754-1985). The ability to perform shift, add,
subtract and logical AND operations upon 32-bit words is needed
too, though not part of the standard.
A. sqrt(x) by Newton Iteration
(1) Initial approximation
Let x0 and x1 be the leading and the trailing 32-bit words of
a floating point number x (in IEEE double format) respectively
1 11 52 ...widths
------------------------------------------------------
x: |s| e | f |
------------------------------------------------------
msb lsb msb lsb ...order
------------------------ ------------------------
x0: |s| e | f1 | x1: | f2 |
------------------------ ------------------------
By performing shifts and subtracts on x0 and x1 (both regarded
as integers), we obtain an 8-bit approximation of sqrt(x) as
follows.
k := (x0>>1) + 0x1ff80000;
y0 := k - T1[31&(k>>15)]. ... y ~ sqrt(x) to 8 bits
Here k is a 32-bit integer and T1[] is an integer array containing
correction terms. Now magically the floating value of y (y's
leading 32-bit word is y0, the value of its trailing word is 0)
approximates sqrt(x) to almost 8-bit.
Value of T1:
static int T1[32]= {
0, 1024, 3062, 5746, 9193, 13348, 18162, 23592,
29598, 36145, 43202, 50740, 58733, 67158, 75992, 85215,
83599, 71378, 60428, 50647, 41945, 34246, 27478, 21581,
16499, 12183, 8588, 5674, 3403, 1742, 661, 130,};
(2) Iterative refinement
Apply Heron's rule three times to y, we have y approximates
sqrt(x) to within 1 ulp (Unit in the Last Place):
y := (y+x/y)/2 ... almost 17 sig. bits
y := (y+x/y)/2 ... almost 35 sig. bits
y := y-(y-x/y)/2 ... within 1 ulp
Remark 1.
Another way to improve y to within 1 ulp is:
y := (y+x/y) ... almost 17 sig. bits to 2*sqrt(x)
y := y - 0x00100006 ... almost 18 sig. bits to sqrt(x)
2
(x-y )*y
y := y + 2* ---------- ...within 1 ulp
2
3y + x
This formula has one division fewer than the one above; however,
it requires more multiplications and additions. Also x must be
scaled in advance to avoid spurious overflow in evaluating the
expression 3y*y+x. Hence it is not recommended uless division
is slow. If division is very slow, then one should use the
reciproot algorithm given in section B.
(3) Final adjustment
By twiddling y's last bit it is possible to force y to be
correctly rounded according to the prevailing rounding mode
as follows. Let r and i be copies of the rounding mode and
inexact flag before entering the square root program. Also we
use the expression y+-ulp for the next representable floating
numbers (up and down) of y. Note that y+-ulp = either fixed
point y+-1, or multiply y by nextafter(1,+-inf) in chopped
mode.
I := FALSE; ... reset INEXACT flag I
R := RZ; ... set rounding mode to round-toward-zero
z := x/y; ... chopped quotient, possibly inexact
If(not I) then { ... if the quotient is exact
if(z=y) {
I := i; ... restore inexact flag
R := r; ... restore rounded mode
return sqrt(x):=y.
} else {
z := z - ulp; ... special rounding
}
}
i := TRUE; ... sqrt(x) is inexact
If (r=RN) then z=z+ulp ... rounded-to-nearest
If (r=RP) then { ... round-toward-+inf
y = y+ulp; z=z+ulp;
}
y := y+z; ... chopped sum
y0:=y0-0x00100000; ... y := y/2 is correctly rounded.
I := i; ... restore inexact flag
R := r; ... restore rounded mode
return sqrt(x):=y.
(4) Special cases
Square root of +inf, +-0, or NaN is itself;
Square root of a negative number is NaN with invalid signal.
B. sqrt(x) by Reciproot Iteration
(1) Initial approximation
Let x0 and x1 be the leading and the trailing 32-bit words of
a floating point number x (in IEEE double format) respectively
(see section A). By performing shifs and subtracts on x0 and y0,
we obtain a 7.8-bit approximation of 1/sqrt(x) as follows.
k := 0x5fe80000 - (x0>>1);
y0:= k - T2[63&(k>>14)]. ... y ~ 1/sqrt(x) to 7.8 bits
Here k is a 32-bit integer and T2[] is an integer array
containing correction terms. Now magically the floating
value of y (y's leading 32-bit word is y0, the value of
its trailing word y1 is set to zero) approximates 1/sqrt(x)
to almost 7.8-bit.
Value of T2:
static int T2[64]= {
0x1500, 0x2ef8, 0x4d67, 0x6b02, 0x87be, 0xa395, 0xbe7a, 0xd866,
0xf14a, 0x1091b,0x11fcd,0x13552,0x14999,0x15c98,0x16e34,0x17e5f,
0x18d03,0x19a01,0x1a545,0x1ae8a,0x1b5c4,0x1bb01,0x1bfde,0x1c28d,
0x1c2de,0x1c0db,0x1ba73,0x1b11c,0x1a4b5,0x1953d,0x18266,0x16be0,
0x1683e,0x179d8,0x18a4d,0x19992,0x1a789,0x1b445,0x1bf61,0x1c989,
0x1d16d,0x1d77b,0x1dddf,0x1e2ad,0x1e5bf,0x1e6e8,0x1e654,0x1e3cd,
0x1df2a,0x1d635,0x1cb16,0x1be2c,0x1ae4e,0x19bde,0x1868e,0x16e2e,
0x1527f,0x1334a,0x11051,0xe951, 0xbe01, 0x8e0d, 0x5924, 0x1edd,};
(2) Iterative refinement
Apply Reciproot iteration three times to y and multiply the
result by x to get an approximation z that matches sqrt(x)
to about 1 ulp. To be exact, we will have
-1ulp < sqrt(x)-z<1.0625ulp.
... set rounding mode to Round-to-nearest
y := y*(1.5-0.5*x*y*y) ... almost 15 sig. bits to 1/sqrt(x)
y := y*((1.5-2^-30)+0.5*x*y*y)... about 29 sig. bits to 1/sqrt(x)
... special arrangement for better accuracy
z := x*y ... 29 bits to sqrt(x), with z*y<1
z := z + 0.5*z*(1-z*y) ... about 1 ulp to sqrt(x)
Remark 2. The constant 1.5-2^-30 is chosen to bias the error so that
(a) the term z*y in the final iteration is always less than 1;
(b) the error in the final result is biased upward so that
-1 ulp < sqrt(x) - z < 1.0625 ulp
instead of |sqrt(x)-z|<1.03125ulp.
(3) Final adjustment
By twiddling y's last bit it is possible to force y to be
correctly rounded according to the prevailing rounding mode
as follows. Let r and i be copies of the rounding mode and
inexact flag before entering the square root program. Also we
use the expression y+-ulp for the next representable floating
numbers (up and down) of y. Note that y+-ulp = either fixed
point y+-1, or multiply y by nextafter(1,+-inf) in chopped
mode.
R := RZ; ... set rounding mode to round-toward-zero
switch(r) {
case RN: ... round-to-nearest
if(x<= z*(z-ulp)...chopped) z = z - ulp; else
if(x<= z*(z+ulp)...chopped) z = z; else z = z+ulp;
break;
case RZ:case RM: ... round-to-zero or round-to--inf
R:=RP; ... reset rounding mod to round-to-+inf
if(x<z*z ... rounded up) z = z - ulp; else
if(x>=(z+ulp)*(z+ulp) ...rounded up) z = z+ulp;
break;
case RP: ... round-to-+inf
if(x>(z+ulp)*(z+ulp)...chopped) z = z+2*ulp; else
if(x>z*z ...chopped) z = z+ulp;
break;
}
Remark 3. The above comparisons can be done in fixed point. For
example, to compare x and w=z*z chopped, it suffices to compare
x1 and w1 (the trailing parts of x and w), regarding them as
two's complement integers.
...Is z an exact square root?
To determine whether z is an exact square root of x, let z1 be the
trailing part of z, and also let x0 and x1 be the leading and
trailing parts of x.
If ((z1&0x03ffffff)!=0) ... not exact if trailing 26 bits of z!=0
I := 1; ... Raise Inexact flag: z is not exact
else {
j := 1 - [(x0>>20)&1] ... j = logb(x) mod 2
k := z1 >> 26; ... get z's 25-th and 26-th
fraction bits
I := i or (k&j) or ((k&(j+j+1))!=(x1&3));
}
R:= r ... restore rounded mode
return sqrt(x):=z.
If multiplication is cheaper then the foregoing red tape, the
Inexact flag can be evaluated by
I := i;
I := (z*z!=x) or I.
Note that z*z can overwrite I; this value must be sensed if it is
True.
Remark 4. If z*z = x exactly, then bit 25 to bit 0 of z1 must be
zero.
--------------------
z1: | f2 |
--------------------
bit 31 bit 0
Further more, bit 27 and 26 of z1, bit 0 and 1 of x1, and the odd
or even of logb(x) have the following relations:
-------------------------------------------------
bit 27,26 of z1 bit 1,0 of x1 logb(x)
-------------------------------------------------
00 00 odd and even
01 01 even
10 10 odd
10 00 even
11 01 even
-------------------------------------------------
(4) Special cases (see (4) of Section A).
*/

82
external/fdlibm/k_cos.c vendored Normal file
View File

@@ -0,0 +1,82 @@
/* @(#)k_cos.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __fdlibm_kernel_cos( x, y )
* kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164
* Input x is assumed to be bounded by ~pi/4 in magnitude.
* Input y is the tail of x.
*
* Algorithm
* 1. Since cos(-x) = cos(x), we need only to consider positive x.
* 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0.
* 3. cos(x) is approximated by a polynomial of degree 14 on
* [0,pi/4]
* 4 14
* cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x
* where the remez error is
*
* | 2 4 6 8 10 12 14 | -58
* |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2
* | |
*
* 4 6 8 10 12 14
* 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then
* cos(x) = 1 - x*x/2 + r
* since cos(x+y) ~ cos(x) - sin(x)*y
* ~ cos(x) - x*y,
* a correction term is necessary in cos(x) and hence
* cos(x+y) = 1 - (x*x/2 - (r - x*y))
* For better accuracy when x > 0.3, let qx = |x|/4 with
* the last 32 bits mask off, and if x > 0.78125, let qx = 0.28125.
* Then
* cos(x+y) = (1-qx) - ((x*x/2-qx) - (r-x*y)).
* Note that 1-qx and (x*x/2-qx) is EXACT here, and the
* magnitude of the latter is at least a quarter of x*x/2,
* thus, reducing the rounding error in the subtraction.
*/
#include "math.h"
static const double
one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */
C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */
C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */
C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */
C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */
C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */
double __fdlibm_kernel_cos(double x, double y) {
double a, hz, z, r, qx;
int ix;
ix = __HI(x) & 0x7fffffff; /* ix = |x|'s high word*/
if(ix < 0x3e400000) { /* if x < 2**27 */
if(((int)x) == 0) return one; /* generate inexact */
}
z = x * x;
r = z * (C1 + z * (C2 + z * (C3 + z * (C4 + z * (C5 + z * C6)))));
if(ix < 0x3FD33333) /* if |x| < 0.3 */
return one - (0.5 * z - (z * r - x * y));
else {
if(ix > 0x3fe90000) { /* x > 0.78125 */
qx = 0.28125;
} else {
__HI(qx) = ix - 0x00200000; /* x/4 */
__LO(qx) = 0;
}
hz = 0.5 * z - qx;
a = one - qx;
return a - (hz - (z * r - x * y));
}
}

318
external/fdlibm/k_rem_pio2.c vendored Normal file
View File

@@ -0,0 +1,318 @@
/* @(#)k_rem_pio2.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* __fdlibm_kernel_rem_pio2(x,y,e0,nx,prec,ipio2)
* double x[],y[]; int e0,nx,prec; int ipio2[];
*
* __fdlibm_kernel_rem_pio2 return the last three digits of N with
* y = x - N*pi/2
* so that |y| < pi/2.
*
* The method is to compute the integer (mod 8) and fraction parts of
* (2/pi)*x without doing the full multiplication. In general we
* skip the part of the product that are known to be a hugev integer (
* more accurately, = 0 mod 8 ). Thus the number of operations are
* independent of the exponent of the input.
*
* (2/pi) is represented by an array of 24-bit integers in ipio2[].
*
* Input parameters:
* x[] The input value (must be positive) is broken into nx
* pieces of 24-bit integers in double precision format.
* x[i] will be the i-th 24 bit of x. The scaled exponent
* of x[0] is given in input parameter e0 (i.e., x[0]*2^e0
* match x's up to 24 bits.
*
* Example of breaking a double positive z into x[0]+x[1]+x[2]:
* e0 = ilogb(z)-23
* z = scalbn(z,-e0)
* for i = 0,1,2
* x[i] = floor(z)
* z = (z-x[i])*2**24
*
*
* y[] ouput result in an array of double precision numbers.
* The dimension of y[] is:
* 24-bit precision 1
* 53-bit precision 2
* 64-bit precision 2
* 113-bit precision 3
* The actual value is the sum of them. Thus for 113-bit
* precison, one may have to do something like:
*
* long double t,w,r_head, r_tail;
* t = (long double)y[2] + (long double)y[1];
* w = (long double)y[0];
* r_head = t+w;
* r_tail = w - (r_head - t);
*
* e0 The exponent of x[0]
*
* nx dimension of x[]
*
* prec an integer indicating the precision:
* 0 24 bits (single)
* 1 53 bits (double)
* 2 64 bits (extended)
* 3 113 bits (quad)
*
* ipio2[]
* integer array, contains the (24*i)-th to (24*i+23)-th
* bit of 2/pi after binary point. The corresponding
* floating value is
*
* ipio2[i] * 2^(-24(i+1)).
*
* External function:
* double scalbn(), floor();
*
*
* Here is the description of some local variables:
*
* jk jk+1 is the initial number of terms of ipio2[] needed
* in the computation. The recommended value is 2,3,4,
* 6 for single, double, extended,and quad.
*
* jz local integer variable indicating the number of
* terms of ipio2[] used.
*
* jx nx - 1
*
* jv index for pointing to the suitable ipio2[] for the
* computation. In general, we want
* ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8
* is an integer. Thus
* e0-3-24*jv >= 0 or (e0-3)/24 >= jv
* Hence jv = max(0,(e0-3)/24).
*
* jp jp+1 is the number of terms in PIo2[] needed, jp = jk.
*
* q[] double array with integral value, representing the
* 24-bits chunk of the product of x and 2/pi.
*
* q0 the corresponding exponent of q[0]. Note that the
* exponent for q[i] would be q0-24*i.
*
* PIo2[] double precision array, obtained by cutting pi/2
* into 24 bits chunks.
*
* f[] ipio2[] in floating point
*
* iq[] integer array by breaking up q[] in 24-bits chunk.
*
* fq[] final product of x*(2/pi) in fq[0],..,fq[jk]
*
* ih integer. If >0 it indicates q[] is >= 0.5, hence
* it also indicates the *sign* of the result.
*
*/
/*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const int init_jk[] = {2, 3, 4, 6}; /* initial value for jk */
static const double PIo2[] = {
1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */
7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */
5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */
3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */
1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */
1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */
2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */
2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */
};
static const double
zero = 0.0,
one = 1.0,
two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */
int __fdlibm_kernel_rem_pio2(double* x, double* y, int e0, int nx, int prec, const int* ipio2) {
int jz, jx, jv, jp, jk, carry, n, iq[20], i, j, k, m, q0, ih;
double z, fw, f[20], fq[20], q[20];
/* initialize jk*/
jk = init_jk[prec];
jp = jk;
/* determine jx,jv,q0, note that 3>q0 */
jx = nx - 1;
jv = (e0 - 3) / 24;
if(jv < 0) jv = 0;
q0 = e0 - 24 * (jv + 1);
/* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
j = jv - jx;
m = jx + jk;
for(i = 0; i <= m; i++, j++) f[i] = (j < 0) ? zero : (double)ipio2[j];
/* compute q[0],q[1],...q[jk] */
for(i = 0; i <= jk; i++) {
for(j = 0, fw = 0.0; j <= jx; j++) fw += x[j] * f[jx + i - j];
q[i] = fw;
}
jz = jk;
recompute:
/* distill q[] into iq[] reversingly */
for(i = 0, j = jz, z = q[jz]; j > 0; i++, j--) {
fw = (double)((int)(twon24 * z));
iq[i] = (int)(z - two24 * fw);
z = q[j - 1] + fw;
}
/* compute n */
z = scalbn(z, q0); /* actual value of z */
z -= 8.0 * floor(z * 0.125); /* trim off integer >= 8 */
n = (int)z;
z -= (double)n;
ih = 0;
if(q0 > 0) { /* need iq[jz-1] to determine n */
i = (iq[jz - 1] >> (24 - q0));
n += i;
iq[jz - 1] -= i << (24 - q0);
ih = iq[jz - 1] >> (23 - q0);
} else if(q0 == 0)
ih = iq[jz - 1] >> 23;
else if(z >= 0.5)
ih = 2;
if(ih > 0) { /* q > 0.5 */
n += 1;
carry = 0;
for(i = 0; i < jz; i++) { /* compute 1-q */
j = iq[i];
if(carry == 0) {
if(j != 0) {
carry = 1;
iq[i] = 0x1000000 - j;
}
} else
iq[i] = 0xffffff - j;
}
if(q0 > 0) { /* rare case: chance is 1 in 12 */
switch(q0) {
case 1:
iq[jz - 1] &= 0x7fffff;
break;
case 2:
iq[jz - 1] &= 0x3fffff;
break;
}
}
if(ih == 2) {
z = one - z;
if(carry != 0) z -= scalbn(one, q0);
}
}
/* check if recomputation is needed */
if(z == zero) {
j = 0;
for(i = jz - 1; i >= jk; i--) j |= iq[i];
if(j == 0) { /* need recomputation */
for(k = 1; iq[jk - k] == 0; k++); /* k = no. of terms needed */
for(i = jz + 1; i <= jz + k; i++) { /* add q[jz+1] to q[jz+k] */
f[jx + i] = (double)ipio2[jv + i];
for(j = 0, fw = 0.0; j <= jx; j++) fw += x[j] * f[jx + i - j];
q[i] = fw;
}
jz += k;
goto recompute;
}
}
/* chop off zero terms */
if(z == 0.0) {
jz -= 1;
q0 -= 24;
while(iq[jz] == 0) {
jz--;
q0 -= 24;
}
} else { /* break z into 24-bit if necessary */
z = scalbn(z, -q0);
if(z >= two24) {
fw = (double)((int)(twon24 * z));
iq[jz] = (int)(z - two24 * fw);
jz += 1;
q0 += 24;
iq[jz] = (int)fw;
} else
iq[jz] = (int)z;
}
/* convert integer "bit" chunk to floating-point value */
fw = scalbn(one, q0);
for(i = jz; i >= 0; i--) {
q[i] = fw * (double)iq[i];
fw *= twon24;
}
/* compute PIo2[0,...,jp]*q[jz,...,0] */
for(i = jz; i >= 0; i--) {
for(fw = 0.0, k = 0; k <= jp && k <= jz - i; k++) fw += PIo2[k] * q[i + k];
fq[jz - i] = fw;
}
/* compress fq[] into y[] */
switch(prec) {
case 0:
fw = 0.0;
for(i = jz; i >= 0; i--) fw += fq[i];
y[0] = (ih == 0) ? fw : -fw;
break;
case 1:
case 2:
fw = 0.0;
for(i = jz; i >= 0; i--) fw += fq[i];
y[0] = (ih == 0) ? fw : -fw;
fw = fq[0] - fw;
for(i = 1; i <= jz; i++) fw += fq[i];
y[1] = (ih == 0) ? fw : -fw;
break;
case 3: /* painful */
for(i = jz; i > 0; i--) {
fw = fq[i - 1] + fq[i];
fq[i] += fq[i - 1] - fw;
fq[i - 1] = fw;
}
for(i = jz; i > 1; i--) {
fw = fq[i - 1] + fq[i];
fq[i] += fq[i - 1] - fw;
fq[i - 1] = fw;
}
for(fw = 0.0, i = jz; i >= 2; i--) fw += fq[i];
if(ih == 0) {
y[0] = fq[0];
y[1] = fq[1];
y[2] = fw;
} else {
y[0] = -fq[0];
y[1] = -fq[1];
y[2] = -fw;
}
}
return n & 7;
}

67
external/fdlibm/k_sin.c vendored Normal file
View File

@@ -0,0 +1,67 @@
/* @(#)k_sin.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* __fdlibm_kernel_sin( x, y, iy)
* kernel sin function on [-pi/4, pi/4], pi/4 ~ 0.7854
* Input x is assumed to be bounded by ~pi/4 in magnitude.
* Input y is the tail of x.
* Input iy indicates whether y is 0. (if iy=0, y assume to be 0).
*
* Algorithm
* 1. Since sin(-x) = -sin(x), we need only to consider positive x.
* 2. if x < 2^-27 (hx<0x3e400000 0), return x with inexact if x!=0.
* 3. sin(x) is approximated by a polynomial of degree 13 on
* [0,pi/4]
* 3 13
* sin(x) ~ x + S1*x + ... + S6*x
* where
*
* |sin(x) 2 4 6 8 10 12 | -58
* |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2
* | x |
*
* 4. sin(x+y) = sin(x) + sin'(x')*y
* ~ sin(x) + (1-x*x/2)*y
* For better accuracy, let
* 3 2 2 2 2
* r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6))))
* then 3 2
* sin(x) = x + (S1*x + (x *(r-y/2)+y))
*/
#include "math.h"
static const double
half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */
S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */
S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */
S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */
S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */
S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */
double __fdlibm_kernel_sin(double x, double y, int iy) {
double z, r, v;
int ix;
ix = __HI(x) & 0x7fffffff; /* high word of x */
if(ix < 0x3e400000) /* |x| < 2**-27 */
{
if((int)x == 0) return x;
} /* generate inexact */
z = x * x;
v = z * x;
r = S2 + z * (S3 + z * (S4 + z * (S5 + z * S6)));
if(iy == 0) return x + v * (S1 + z * r);
else
return x - ((z * (half * y - v * r) - y) - v * S1);
}

146
external/fdlibm/k_tan.c vendored Normal file
View File

@@ -0,0 +1,146 @@
/*
* ====================================================
* 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.
* ====================================================
*/
/* INDENT OFF */
/* __fdlibm_kernel_tan( x, y, k )
* kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854
* Input x is assumed to be bounded by ~pi/4 in magnitude.
* Input y is the tail of x.
* Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned.
*
* Algorithm
* 1. Since tan(-x) = -tan(x), we need only to consider positive x.
* 2. if x < 2^-28 (hx<0x3e300000 0), return x with inexact if x!=0.
* 3. tan(x) is approximated by a odd polynomial of degree 27 on
* [0,0.67434]
* 3 27
* tan(x) ~ x + T1*x + ... + T13*x
* where
*
* |tan(x) 2 4 26 | -59.2
* |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2
* | x |
*
* Note: tan(x+y) = tan(x) + tan'(x)*y
* ~ tan(x) + (1+x*x)*y
* Therefore, for better accuracy in computing tan(x+y), let
* 3 2 2 2 2
* r = x *(T2+x *(T3+x *(...+x *(T12+x *T13))))
* then
* 3 2
* tan(x+y) = x + (T1*x + (x *(r+y)+y))
*
* 4. For x in [0.67434,pi/4], let y = pi/4 - x, then
* tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y))
* = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y)))
*/
#include "math.h"
static const double xxx[] = {
3.33333333333334091986e-01, /* 3FD55555, 55555563 */
1.33333333333201242699e-01, /* 3FC11111, 1110FE7A */
5.39682539762260521377e-02, /* 3FABA1BA, 1BB341FE */
2.18694882948595424599e-02, /* 3F9664F4, 8406D637 */
8.86323982359930005737e-03, /* 3F8226E3, E96E8493 */
3.59207910759131235356e-03, /* 3F6D6D22, C9560328 */
1.45620945432529025516e-03, /* 3F57DBC8, FEE08315 */
5.88041240820264096874e-04, /* 3F4344D8, F2F26501 */
2.46463134818469906812e-04, /* 3F3026F7, 1A8D1068 */
7.81794442939557092300e-05, /* 3F147E88, A03792A6 */
7.14072491382608190305e-05, /* 3F12B80F, 32F0A7E9 */
-1.85586374855275456654e-05, /* BEF375CB, DB605373 */
2.59073051863633712884e-05, /* 3EFB2A70, 74BF7AD4 */
/* one */ 1.00000000000000000000e+00, /* 3FF00000, 00000000 */
/* pio4 */ 7.85398163397448278999e-01, /* 3FE921FB, 54442D18 */
/* pio4lo */ 3.06161699786838301793e-17 /* 3C81A626, 33145C07 */
};
#define one xxx[13]
#define pio4 xxx[14]
#define pio4lo xxx[15]
#define T xxx
/* INDENT ON */
double
__fdlibm_kernel_tan(double x, double y, int iy) {
double z, r, v, w, s;
int ix, hx;
hx = __HI(x); /* high word of x */
ix = hx & 0x7fffffff; /* high word of |x| */
if(ix < 0x3e300000) { /* x < 2**-28 */
if((int)x == 0) { /* generate inexact */
if(((ix | __LO(x)) | (iy + 1)) == 0)
return one / fabs(x);
else {
if(iy == 1)
return x;
else { /* compute -1 / (x+y) carefully */
double a, t;
z = w = x + y;
__LO(z) = 0;
v = y - (z - x);
t = a = -one / w;
__LO(t) = 0;
s = one + t * z;
return t + a * (s + t * v);
}
}
}
}
if(ix >= 0x3FE59428) { /* |x| >= 0.6744 */
if(hx < 0) {
x = -x;
y = -y;
}
z = pio4 - x;
w = pio4lo - y;
x = z + w;
y = 0.0;
}
z = x * x;
w = z * z;
/*
* Break x^5*(T[1]+x^2*T[2]+...) into
* x^5(T[1]+x^4*T[3]+...+x^20*T[11]) +
* x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12]))
*/
r = T[1] + w * (T[3] + w * (T[5] + w * (T[7] + w * (T[9] +
w * T[11]))));
v = z * (T[2] + w * (T[4] + w * (T[6] + w * (T[8] + w * (T[10] +
w * T[12])))));
s = z * x;
r = y + z * (s * (r + v) + y);
r += T[0] * s;
w = x + r;
if(ix >= 0x3FE59428) {
v = (double)iy;
return (double)(1 - ((hx >> 30) & 2)) *
(v - 2.0 * (x - (w * w / (w + v) - r)));
}
if(iy == 1)
return w;
else {
/*
* if allow error up to 2 ulp, simply return
* -1.0 / (x+r) here
*/
/* compute -1.0 / (x+r) accurately */
double a, t;
z = w;
__LO(z) = 0;
v = r - (z - x); /* z+v = r+x */
t = a = -1.0 / w; /* a = -1.0/w */
__LO(t) = 0;
s = 1.0 + t * z;
return t + a * (s + t * v);
}
}

245
external/fdlibm/math.h vendored Normal file
View File

@@ -0,0 +1,245 @@
/* @(#)fdlibm.h 1.5 04/04/22 */
/*
* ====================================================
* Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
*
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
#ifndef _MATH_H_
#define _MATH_H_
/* Sometimes it's necessary to define __LITTLE_ENDIAN explicitly
but these catch some common cases. */
#if defined(__WATCOMC__) || defined(_MSC_VER) || defined(i386) || defined(i486) || defined(intel) || defined(x86) || defined(i86pc) || defined(__alpha) || defined(__osf__) || __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
#define __LITTLE_ENDIAN
#endif
#ifdef __LITTLE_ENDIAN
#define __HI(x) *(1 + (int*)&x)
#define __LO(x) *(int*)&x
#define __HIp(x) *(1 + (int*)x)
#define __LOp(x) *(int*)x
#else
#define __HI(x) *(int*)&x
#define __LO(x) *(1 + (int*)&x)
#define __HIp(x) *(int*)x
#define __LOp(x) *(1 + (int*)x)
#endif
#define signgam fdlibm_signgam
#define acos fdlibm_acos
#define asin fdlibm_asin
#define atan fdlibm_atan
#define atan2 fdlibm_atan2
#define cos fdlibm_cos
#define sin fdlibm_sin
#define tan fdlibm_tan
#define cosh fdlibm_cosh
#define sinh fdlibm_sinh
#define tanh fdlibm_tanh
#define exp fdlibm_exp
#define frexp fdlibm_frexp
#define ldexp fdlibm_ldexp
#define log fdlibm_log
#define log10 fdlibm_log10
#define modf fdlibm_modf
#define pow fdlibm_pow
#define sqrt fdlibm_sqrt
#define ceil fdlibm_ceil
#define fabs fdlibm_fabs
#define floor fdlibm_floor
#define fmod fdlibm_fmod
#define erf fdlibm_erf
#define erfc fdlibm_erfc
#define gamma fdlibm_gamma
#define hypot fdlibm_hypot
#define isnan fdlibm_isnan
#define finite fdlibm_finite
#define j0 fdlibm_j0
#define j1 fdlibm_j1
#define jn fdlibm_jn
#define lgamma fdlibm_lgamma
#define y0 fdlibm_y0
#define y1 fdlibm_y1
#define yn fdlibm_yn
#define acosh fdlibm_acosh
#define asinh fdlibm_asinh
#define atanh fdlibm_atanh
#define cbrt fdlibm_cbrt
#define logb fdlibm_logb
#define nextafter fdlibm_nextafter
#define remainder fdlibm_remainder
#define scalb fdlibm_scalb
#define significand fdlibm_significand
#define copysign fdlibm_copysign
#define ilogb fdlibm_ilogb
#define rint fdlibm_rint
#define scalbn fdlibm_scalbn
#define expm1 fdlibm_expm1
#define log1p fdlibm_log1p
/*
* ANSI/POSIX
*/
extern int signgam;
#define MAXFLOAT ((float)3.40282346638528860e+38)
#define HUGE MAXFLOAT
/*
* set X_TLOSS = pi*2**52, which is possibly defined in <values.h>
* (one may replace the following line by "#include <values.h>")
*/
#define X_TLOSS 1.41484755040568800000e+16
#define DOMAIN 1
#define SING 2
#define OVERFLOW 3
#define UNDERFLOW 4
#define TLOSS 5
#define PLOSS 6
/*
* ANSI/POSIX
*/
extern double acos(double);
extern double asin(double);
extern double atan(double);
extern double atan2(double, double);
extern double cos(double);
extern double sin(double);
extern double tan(double);
extern double cosh(double);
extern double sinh(double);
extern double tanh(double);
extern double exp(double);
extern double frexp(double, int*);
extern double ldexp(double, int);
extern double log(double);
extern double log10(double);
extern double modf(double, double*);
extern double pow(double, double);
extern double sqrt(double);
extern double ceil(double);
extern double fabs(double);
extern double floor(double);
extern double fmod(double, double);
extern double erf(double);
extern double erfc(double);
extern double gamma(double);
extern double hypot(double, double);
extern int isnan(double);
extern int finite(double);
extern double j0(double);
extern double j1(double);
extern double jn(int, double);
extern double lgamma(double);
extern double y0(double);
extern double y1(double);
extern double yn(int, double);
extern double acosh(double);
extern double asinh(double);
extern double atanh(double);
extern double cbrt(double);
extern double logb(double);
extern double nextafter(double, double);
extern double remainder(double, double);
extern double scalb(double, double);
/*
* IEEE Test Vector
*/
extern double significand(double);
/*
* Functions callable from C, intended to support IEEE arithmetic.
*/
extern double copysign(double, double);
extern int ilogb(double);
extern double rint(double);
extern double scalbn(double, int);
/*
* BSD math library entry points
*/
extern double expm1(double);
extern double log1p(double);
/*
* Reentrant version of gamma & lgamma; passes signgam back by reference
* as the second argument; user must allocate space for signgam.
*/
#ifdef _REENTRANT
#define gamma_r fdlibm_gamma_r
#define lgamma_r fdlibm_lgamma_r
extern double gamma_r(double, int*);
extern double lgamma_r(double, int*);
#endif /* _REENTRANT */
/* ieee style elementary functions */
extern double __fdlibm_sqrt(double);
extern double __fdlibm_acos(double);
extern double __fdlibm_acosh(double);
extern double __fdlibm_log(double);
extern double __fdlibm_atanh(double);
extern double __fdlibm_asin(double);
extern double __fdlibm_atan2(double, double);
extern double __fdlibm_exp(double);
extern double __fdlibm_cosh(double);
extern double __fdlibm_fmod(double, double);
extern double __fdlibm_pow(double, double);
extern double __fdlibm_lgamma_r(double, int*);
extern double __fdlibm_gamma_r(double, int*);
extern double __fdlibm_lgamma(double);
extern double __fdlibm_gamma(double);
extern double __fdlibm_log10(double);
extern double __fdlibm_sinh(double);
extern double __fdlibm_hypot(double, double);
extern double __fdlibm_j0(double);
extern double __fdlibm_j1(double);
extern double __fdlibm_y0(double);
extern double __fdlibm_y1(double);
extern double __fdlibm_jn(int, double);
extern double __fdlibm_yn(int, double);
extern double __fdlibm_remainder(double, double);
extern int __fdlibm_rem_pio2(double, double*);
#ifdef _SCALB_INT
extern double __fdlibm_scalb(double, int);
#else
extern double __fdlibm_scalb(double, double);
#endif
/* fdlibm kernel function */
extern double __fdlibm_kernel_sin(double, double, int);
extern double __fdlibm_kernel_cos(double, double);
extern double __fdlibm_kernel_tan(double, double, int);
extern int __fdlibm_kernel_rem_pio2(double*, double*, int, int, int, const int*);
#endif

53
external/fdlibm/s_asinh.c vendored Normal file
View File

@@ -0,0 +1,53 @@
/* @(#)s_asinh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* asinh(x)
* Method :
* Based on
* asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ]
* we have
* asinh(x) := x if 1+x*x=1,
* := sign(x)*(log(x)+ln2)) for large |x|, else
* := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else
* := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2)))
*/
#include "math.h"
static const double
one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
hugev = 1.00000000000000000000e+300;
double asinh(double x) {
double t, w;
int hx, ix;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x7ff00000) return x + x; /* x is inf or NaN */
if(ix < 0x3e300000) { /* |x|<2**-28 */
if(hugev + x > one) return x; /* return x inexact except 0 */
}
if(ix > 0x41b00000) { /* |x| > 2**28 */
w = __fdlibm_log(fabs(x)) + ln2;
} else if(ix > 0x40000000) { /* 2**28 > |x| > 2.0 */
t = fabs(x);
w = __fdlibm_log(2.0 * t + one / (sqrt(x * x + one) + t));
} else { /* 2.0 > |x| > 2**-28 */
t = x * x;
w = log1p(fabs(x) + t / (one + sqrt(one + t)));
}
if(hx > 0) return w;
else
return -w;
}

119
external/fdlibm/s_atan.c vendored Normal file
View File

@@ -0,0 +1,119 @@
/* @(#)s_atan.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* atan(x)
* Method
* 1. Reduce x to positive by atan(x) = -atan(-x).
* 2. According to the integer k=4t+0.25 chopped, t=x, the argument
* is further reduced to one of the following intervals and the
* arctangent of t is evaluated by the corresponding formula:
*
* [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
* [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) )
* [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) )
* [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) )
* [39/16,INF] atan(x) = atan(INF) + atan( -1/t )
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const double atanhi[] = {
4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */
7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */
9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */
1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */
};
static const double atanlo[] = {
2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */
3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */
1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */
6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */
};
static const double aT[] = {
3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */
-1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */
1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */
-1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */
9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */
-7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */
6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */
-5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */
4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */
-3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */
1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */
};
static const double
one = 1.0,
hugev = 1.0e300;
double atan(double x) {
double w, s1, s2, z;
int ix, hx, id;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x44100000) { /* if |x| >= 2^66 */
if(ix > 0x7ff00000 ||
(ix == 0x7ff00000 && (__LO(x) != 0)))
return x + x; /* NaN */
if(hx > 0) return atanhi[3] + atanlo[3];
else
return -atanhi[3] - atanlo[3];
}
if(ix < 0x3fdc0000) { /* |x| < 0.4375 */
if(ix < 0x3e200000) { /* |x| < 2^-29 */
if(hugev + x > one) return x; /* raise inexact */
}
id = -1;
} else {
x = fabs(x);
if(ix < 0x3ff30000) { /* |x| < 1.1875 */
if(ix < 0x3fe60000) { /* 7/16 <=|x|<11/16 */
id = 0;
x = (2.0 * x - one) / (2.0 + x);
} else { /* 11/16<=|x|< 19/16 */
id = 1;
x = (x - one) / (x + one);
}
} else {
if(ix < 0x40038000) { /* |x| < 2.4375 */
id = 2;
x = (x - 1.5) / (one + 1.5 * x);
} else { /* 2.4375 <= |x| < 2^66 */
id = 3;
x = -1.0 / x;
}
}
}
/* end of argument reduction */
z = x * x;
w = z * z;
/* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */
s1 = z * (aT[0] + w * (aT[2] + w * (aT[4] + w * (aT[6] + w * (aT[8] + w * aT[10])))));
s2 = w * (aT[1] + w * (aT[3] + w * (aT[5] + w * (aT[7] + w * aT[9]))));
if(id < 0) return x - x * (s1 + s2);
else {
z = atanhi[id] - ((x * (s1 + s2) - atanlo[id]) - x);
return (hx < 0) ? -z : z;
}
}

72
external/fdlibm/s_cbrt.c vendored Normal file
View File

@@ -0,0 +1,72 @@
/* @(#)s_cbrt.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
#include "math.h"
/* cbrt(x)
* Return cube root of x
*/
static const unsigned
B1 = 715094163, /* B1 = (682-0.03306235651)*2**20 */
B2 = 696219795; /* B2 = (664-0.03306235651)*2**20 */
static const double
C = 5.42857142857142815906e-01, /* 19/35 = 0x3FE15F15, 0xF15F15F1 */
D = -7.05306122448979611050e-01, /* -864/1225 = 0xBFE691DE, 0x2532C834 */
E = 1.41428571428571436819e+00, /* 99/70 = 0x3FF6A0EA, 0x0EA0EA0F */
F = 1.60714285714285720630e+00, /* 45/28 = 0x3FF9B6DB, 0x6DB6DB6E */
G = 3.57142857142857150787e-01; /* 5/14 = 0x3FD6DB6D, 0xB6DB6DB7 */
double cbrt(double x) {
int hx;
double r, s, t = 0.0, w;
unsigned sign;
hx = __HI(x); /* high word of x */
sign = hx & 0x80000000; /* sign= sign(x) */
hx ^= sign;
if(hx >= 0x7ff00000) return (x + x); /* cbrt(NaN,INF) is itself */
if((hx | __LO(x)) == 0)
return (x); /* cbrt(0) is itself */
__HI(x) = hx; /* x <- |x| */
/* rough cbrt to 5 bits */
if(hx < 0x00100000) /* subnormal number */
{
__HI(t) = 0x43500000; /* set t= 2**54 */
t *= x;
__HI(t) = __HI(t) / 3 + B2;
} else
__HI(t) = hx / 3 + B1;
/* new cbrt to 23 bits, may be implemented in single precision */
r = t * t / x;
s = C + r * t;
t *= G + F / (s + E + D / s);
/* chopped to 20 bits and make it larger than cbrt(x) */
__LO(t) = 0;
__HI(t) += 0x00000001;
/* one step newton iteration to 53 bits with error less than 0.667 ulps */
s = t * t; /* t*t is exact */
r = x / s;
w = t + t;
r = (r - t) / (w + r); /* r-s is exact */
t = t + t * r;
/* retore the sign bit */
__HI(t) |= sign;
return (t);
}

75
external/fdlibm/s_ceil.c vendored Normal file
View File

@@ -0,0 +1,75 @@
/* @(#)s_ceil.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* ceil(x)
* Return x rounded toward -inf to integral value
* Method:
* Bit twiddling.
* Exception:
* Inexact flag raised if x not equal to ceil(x).
*/
#include "math.h"
static const double hugev = 1.0e300;
double ceil(double x) {
int i0, i1, j0;
unsigned i, j;
i0 = __HI(x);
i1 = __LO(x);
j0 = ((i0 >> 20) & 0x7ff) - 0x3ff;
if(j0 < 20) {
if(j0 < 0) { /* raise inexact if x != 0 */
if(hugev + x > 0.0) { /* return 0*sign(x) if |x|<1 */
if(i0 < 0) {
i0 = 0x80000000;
i1 = 0;
} else if((i0 | i1) != 0) {
i0 = 0x3ff00000;
i1 = 0;
}
}
} else {
i = (0x000fffff) >> j0;
if(((i0 & i) | i1) == 0) return x; /* x is integral */
if(hugev + x > 0.0) { /* raise inexact flag */
if(i0 > 0) i0 += (0x00100000) >> j0;
i0 &= (~i);
i1 = 0;
}
}
} else if(j0 > 51) {
if(j0 == 0x400) return x + x; /* inf or NaN */
else
return x; /* x is integral */
} else {
i = ((unsigned)(0xffffffff)) >> (j0 - 20);
if((i1 & i) == 0) return x; /* x is integral */
if(hugev + x > 0.0) { /* raise inexact flag */
if(i0 > 0) {
if(j0 == 20) i0 += 1;
else {
j = i1 + (1 << (52 - j0));
if(j < i1) i0 += 1; /* got a carry */
i1 = j;
}
}
i1 &= (~i);
}
}
__HI(x) = i0;
__LO(x) = i1;
return x;
}

25
external/fdlibm/s_copysign.c vendored Normal file
View File

@@ -0,0 +1,25 @@
/* @(#)s_copysign.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* copysign(double x, double y)
* copysign(x,y) returns a value with the magnitude of x and
* with the sign bit of y.
*/
#include "math.h"
double copysign(double x, double y) {
__HI(x) = (__HI(x) & 0x7fffffff) | (__HI(y) & 0x80000000);
return x;
}

76
external/fdlibm/s_cos.c vendored Normal file
View File

@@ -0,0 +1,76 @@
/* @(#)s_cos.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* cos(x)
* Return cosine function of x.
*
* kernel function:
* __fdlibm_kernel_sin ... sine function on [-pi/4,pi/4]
* __fdlibm_kernel_cos ... cosine function on [-pi/4,pi/4]
* __fdlibm_kernel_rem_pio2 ... argument reduction routine
*
* Method.
* Let S,C and T denote the sin, cos and tan respectively on
* [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
* in [-pi/4 , +pi/4], and let n = k mod 4.
* We have
*
* n sin(x) cos(x) tan(x)
* ----------------------------------------------------------
* 0 S C T
* 1 C -S -1/T
* 2 -S -C T
* 3 -C S -1/T
* ----------------------------------------------------------
*
* Special cases:
* Let trig be any of sin, cos, or tan.
* trig(+-INF) is NaN, with signals;
* trig(NaN) is that NaN;
*
* Accuracy:
* TRIG(x) returns trig(x) nearly rounded
*/
#include "math.h"
double cos(double x) {
double y[2], z = 0.0;
int n, ix;
/* High word of x. */
ix = __HI(x);
/* |x| ~< pi/4 */
ix &= 0x7fffffff;
if(ix <= 0x3fe921fb) return __fdlibm_kernel_cos(x, z);
/* cos(Inf or NaN) is NaN */
else if(ix >= 0x7ff00000)
return x - x;
/* argument reduction needed */
else {
n = __fdlibm_rem_pio2(x, y);
switch(n & 3) {
case 0:
return __fdlibm_kernel_cos(y[0], y[1]);
case 1:
return -__fdlibm_kernel_sin(y[0], y[1], 1);
case 2:
return -__fdlibm_kernel_cos(y[0], y[1]);
default:
return __fdlibm_kernel_sin(y[0], y[1], 1);
}
}
}

297
external/fdlibm/s_erf.c vendored Normal file
View File

@@ -0,0 +1,297 @@
/* @(#)s_erf.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* 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 - tinyv (if x <= -6)
* erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6, else
* erf(x) = sign(x)*(1.0 - tinyv)
* 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 - tinyv) (raise inexact)
* erfc(x) = tinyv*tinyv (raise underflow) if x > 0
* = 2 - tinyv if x<0
*
* 7. Special case:
* erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
* erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
* erfc/erf(NaN) is NaN
*/
#include "math.h"
static const double
tinyv = 1e-300,
half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
/* c = (float)0.84506291151 */
erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */
/*
* Coefficients for approximation to erf on [0,0.84375]
*/
efx = 1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */
efx8 = 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */
pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */
pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */
pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */
pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */
pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */
qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */
qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */
qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */
qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */
qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */
/*
* Coefficients for approximation to erf in [0.84375,1.25]
*/
pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */
pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */
pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */
pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */
pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */
pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */
pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */
qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */
qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */
qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */
qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */
qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */
qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */
/*
* Coefficients for approximation to erfc in [1.25,1/0.35]
*/
ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */
ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */
ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */
ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */
ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */
ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */
ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */
ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */
sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */
sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */
sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */
sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */
sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */
sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */
sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */
sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */
/*
* Coefficients for approximation to erfc in [1/.35,28]
*/
rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */
rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */
rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */
rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */
rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */
rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */
rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */
sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */
sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */
sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */
sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */
sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */
sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */
sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */
double erf(double x) {
int hx, ix, i;
double R, S, P, Q, s, y, z, r;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x7ff00000) { /* erf(nan)=nan */
i = ((unsigned)hx >> 31) << 1;
return (double)(1 - i) + one / x; /* erf(+-inf)=+-1 */
}
if(ix < 0x3feb0000) { /* |x|<0.84375 */
if(ix < 0x3e300000) { /* |x|<2**-28 */
if(ix < 0x00800000)
return 0.125 * (8.0 * x + efx8 * x); /*avoid underflow */
return x + efx * x;
}
z = x * x;
r = pp0 + z * (pp1 + z * (pp2 + z * (pp3 + z * pp4)));
s = one + z * (qq1 + z * (qq2 + z * (qq3 + z * (qq4 + z * qq5))));
y = r / s;
return x + x * y;
}
if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
s = fabs(x) - one;
P = pa0 + s * (pa1 + s * (pa2 + s * (pa3 + s * (pa4 + s * (pa5 + s * pa6)))));
Q = one + s * (qa1 + s * (qa2 + s * (qa3 + s * (qa4 + s * (qa5 + s * qa6)))));
if(hx >= 0) return erx + P / Q;
else
return -erx - P / Q;
}
if(ix >= 0x40180000) { /* inf>|x|>=6 */
if(hx >= 0) return one - tinyv;
else
return tinyv - one;
}
x = fabs(x);
s = one / (x * x);
if(ix < 0x4006DB6E) { /* |x| < 1/0.35 */
R = ra0 + s * (ra1 + s * (ra2 + s * (ra3 + s * (ra4 + s * (ra5 + s * (ra6 + s * ra7))))));
S = one + s * (sa1 + s * (sa2 + s * (sa3 + s * (sa4 + s * (sa5 + s * (sa6 + s * (sa7 + s * sa8)))))));
} else { /* |x| >= 1/0.35 */
R = rb0 + s * (rb1 + s * (rb2 + s * (rb3 + s * (rb4 + s * (rb5 + s * rb6)))));
S = one + s * (sb1 + s * (sb2 + s * (sb3 + s * (sb4 + s * (sb5 + s * (sb6 + s * sb7))))));
}
z = x;
__LO(z) = 0;
r = __fdlibm_exp(-z * z - 0.5625) * __fdlibm_exp((z - x) * (z + x) + R / S);
if(hx >= 0) return one - r / x;
else
return r / x - one;
}
double erfc(double x) {
int hx, ix;
double R, S, P, Q, s, y, z, r;
hx = __HI(x);
ix = hx & 0x7fffffff;
if(ix >= 0x7ff00000) { /* erfc(nan)=nan */
/* erfc(+-inf)=0,2 */
return (double)(((unsigned)hx >> 31) << 1) + one / x;
}
if(ix < 0x3feb0000) { /* |x|<0.84375 */
if(ix < 0x3c700000) /* |x|<2**-56 */
return one - x;
z = x * x;
r = pp0 + z * (pp1 + z * (pp2 + z * (pp3 + z * pp4)));
s = one + z * (qq1 + z * (qq2 + z * (qq3 + z * (qq4 + z * qq5))));
y = r / s;
if(hx < 0x3fd00000) { /* x<1/4 */
return one - (x + x * y);
} else {
r = x * y;
r += (x - half);
return half - r;
}
}
if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
s = fabs(x) - one;
P = pa0 + s * (pa1 + s * (pa2 + s * (pa3 + s * (pa4 + s * (pa5 + s * pa6)))));
Q = one + s * (qa1 + s * (qa2 + s * (qa3 + s * (qa4 + s * (qa5 + s * qa6)))));
if(hx >= 0) {
z = one - erx;
return z - P / Q;
} else {
z = erx + P / Q;
return one + z;
}
}
if(ix < 0x403c0000) { /* |x|<28 */
x = fabs(x);
s = one / (x * x);
if(ix < 0x4006DB6D) { /* |x| < 1/.35 ~ 2.857143*/
R = ra0 + s * (ra1 + s * (ra2 + s * (ra3 + s * (ra4 + s * (ra5 + s * (ra6 + s * ra7))))));
S = one + s * (sa1 + s * (sa2 + s * (sa3 + s * (sa4 + s * (sa5 + s * (sa6 + s * (sa7 + s * sa8)))))));
} else { /* |x| >= 1/.35 ~ 2.857143 */
if(hx < 0 && ix >= 0x40180000) return two - tinyv; /* x < -6 */
R = rb0 + s * (rb1 + s * (rb2 + s * (rb3 + s * (rb4 + s * (rb5 + s * rb6)))));
S = one + s * (sb1 + s * (sb2 + s * (sb3 + s * (sb4 + s * (sb5 + s * (sb6 + s * sb7))))));
}
z = x;
__LO(z) = 0;
r = __fdlibm_exp(-z * z - 0.5625) *
__fdlibm_exp((z - x) * (z + x) + R / S);
if(hx > 0) return r / x;
else
return two - r / x;
} else {
if(hx > 0) return tinyv * tinyv;
else
return two - tinyv;
}
}

213
external/fdlibm/s_expm1.c vendored Normal file
View File

@@ -0,0 +1,213 @@
/* @(#)s_expm1.c 1.5 04/04/22 */
/*
* ====================================================
* Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
*
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* 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 Remes algorithm on [0,0.347] to generate
* a polynomial of degree 5 in r*r to approximate R1. The
* maximum error of this polynomial approximation is bounded
* by 2**-61. In other words,
* R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5
* where Q1 = -1.6666666666666567384E-2,
* Q2 = 3.9682539681370365873E-4,
* Q3 = -9.9206344733435987357E-6,
* Q4 = 2.5051361420808517002E-7,
* Q5 = -6.2843505682382617102E-9;
* (where z=r*r, and the values of Q1 to Q5 are listed below)
* with error bounded by
* | 5 | -61
* | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2
* | |
*
* expm1(r) = exp(r)-1 is then computed by the following
* specific way which minimize the accumulation rounding error:
* 2 3
* r r [ 3 - (R1 + R1*r/2) ]
* expm1(r) = r + --- + --- * [--------------------]
* 2 2 [ 6 - r*(3 - R1*r/2) ]
*
* To compensate the error in the argument reduction, we use
* expm1(r+c) = expm1(r) + c + expm1(r)*c
* ~ expm1(r) + c + r*c
* Thus c+r*c will be added in as the correction terms for
* expm1(r+c). Now rearrange the term to avoid optimization
* screw up:
* ( 2 2 )
* ({ ( r [ R1 - (3 - R1*r/2) ] ) } r )
* expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- )
* ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 )
* ( )
*
* = r - E
* 3. Scale back to obtain expm1(x):
* From step 1, we have
* expm1(x) = either 2^k*[expm1(r)+1] - 1
* = or 2^k*[expm1(r) + (1-2^-k)]
* 4. Implementation notes:
* (A). To save one multiplication, we scale the coefficient Qi
* to Qi*2^i, and replace z by (x^2)/2.
* (B). To achieve maximum accuracy, we compute expm1(x) by
* (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf)
* (ii) if k=0, return r-E
* (iii) if k=-1, return 0.5*(r-E)-0.5
* (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E)
* else return 1.0+2.0*(r-E);
* (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1)
* (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else
* (vii) return 2^k(1-((E+2^-k)-r))
*
* Special cases:
* expm1(INF) is INF, expm1(NaN) is NaN;
* expm1(-INF) is -1, and
* for finite argument, only expm1(0)=0 is exact.
*
* Accuracy:
* according to an error analysis, the error is always less than
* 1 ulp (unit in the last place).
*
* Misc. info.
* For IEEE double
* if x > 7.09782712893383973096e+02 then expm1(x) overflow
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
#include "math.h"
static const double
one = 1.0,
hugev = 1.0e+300,
tinyv = 1.0e-300,
o_threshold = 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
ln2_hi = 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */
ln2_lo = 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */
invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */
/* scaled coefficients related to expm1 */
Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */
Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */
Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */
Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */
Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */
double expm1(double x) {
double y, hi, lo, c, t, e, hxs, hfx, r1;
int k, xsb;
unsigned hx;
hx = __HI(x); /* high word of x */
xsb = hx & 0x80000000; /* sign bit of x */
if(xsb == 0) y = x;
else
y = -x; /* y = |x| */
hx &= 0x7fffffff; /* high word of |x| */
/* filter out hugev and non-finite argument */
if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */
if(hx >= 0x40862E42) { /* if |x|>=709.78... */
if(hx >= 0x7ff00000) {
if(((hx & 0xfffff) | __LO(x)) != 0)
return x + x; /* NaN */
else
return (xsb == 0) ? x : -1.0; /* exp(+-inf)={inf,-1} */
}
if(x > o_threshold) return hugev * hugev; /* overflow */
}
if(xsb != 0) { /* x < -56*ln2, return -1.0 with inexact */
if(x + tinyv < 0.0) /* raise inexact */
return tinyv - one; /* return -1 */
}
}
/* argument reduction */
if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
if(xsb == 0) {
hi = x - ln2_hi;
lo = ln2_lo;
k = 1;
} else {
hi = x + ln2_hi;
lo = -ln2_lo;
k = -1;
}
} else {
k = invln2 * x + ((xsb == 0) ? 0.5 : -0.5);
t = k;
hi = x - t * ln2_hi; /* t*ln2_hi is exact here */
lo = t * ln2_lo;
}
x = hi - lo;
c = (hi - x) - lo;
} else if(hx < 0x3c900000) { /* when |x|<2**-54, return x */
t = hugev + x; /* return x with inexact flags when x!=0 */
return x - (t - (hugev + x));
} else
k = 0;
/* x is now in primary range */
hfx = 0.5 * x;
hxs = x * hfx;
r1 = one + hxs * (Q1 + hxs * (Q2 + hxs * (Q3 + hxs * (Q4 + hxs * Q5))));
t = 3.0 - r1 * hfx;
e = hxs * ((r1 - t) / (6.0 - x * t));
if(k == 0) return x - (x * e - hxs); /* c is 0 */
else {
e = (x * (e - c) - c);
e -= hxs;
if(k == -1) return 0.5 * (x - e) - 0.5;
if(k == 1)
if(x < -0.25) return -2.0 * (e - (x + 0.5));
else
return one + 2.0 * (x - e);
if(k <= -2 || k > 56) { /* suffice to return exp(x)-1 */
y = one - (e - x);
__HI(y) += (k << 20); /* add k to y's exponent */
return y - one;
}
t = one;
if(k < 20) {
__HI(t) = 0x3ff00000 - (0x200000 >> k); /* t=1-2^-k */
y = t - (e - x);
__HI(y) += (k << 20); /* add k to y's exponent */
} else {
__HI(t) = ((0x3ff - k) << 20); /* 2^-k */
y = x - (e + t);
y += one;
__HI(y) += (k << 20); /* add k to y's exponent */
}
}
return y;
}

23
external/fdlibm/s_fabs.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)s_fabs.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* fabs(x) returns the absolute value of x.
*/
#include "math.h"
double fabs(double x) {
__HI(x) &= 0x7fffffff;
return x;
}

25
external/fdlibm/s_finite.c vendored Normal file
View File

@@ -0,0 +1,25 @@
/* @(#)s_finite.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* finite(x) returns 1 is x is finite, else 0;
* no branching!
*/
#include "math.h"
int finite(double x) {
int hx;
hx = __HI(x);
return (unsigned)((hx & 0x7fffffff) - 0x7ff00000) >> 31;
}

74
external/fdlibm/s_floor.c vendored Normal file
View File

@@ -0,0 +1,74 @@
/* @(#)s_floor.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* floor(x)
* Return x rounded toward -inf to integral value
* Method:
* Bit twiddling.
* Exception:
* Inexact flag raised if x not equal to floor(x).
*/
#include "math.h"
static const double hugev = 1.0e300;
double floor(double x) {
int i0, i1, j0;
unsigned i, j;
i0 = __HI(x);
i1 = __LO(x);
j0 = ((i0 >> 20) & 0x7ff) - 0x3ff;
if(j0 < 20) {
if(j0 < 0) { /* raise inexact if x != 0 */
if(hugev + x > 0.0) { /* return 0*sign(x) if |x|<1 */
if(i0 >= 0) {
i0 = i1 = 0;
} else if(((i0 & 0x7fffffff) | i1) != 0) {
i0 = 0xbff00000;
i1 = 0;
}
}
} else {
i = (0x000fffff) >> j0;
if(((i0 & i) | i1) == 0) return x; /* x is integral */
if(hugev + x > 0.0) { /* raise inexact flag */
if(i0 < 0) i0 += (0x00100000) >> j0;
i0 &= (~i);
i1 = 0;
}
}
} else if(j0 > 51) {
if(j0 == 0x400) return x + x; /* inf or NaN */
else
return x; /* x is integral */
} else {
i = ((unsigned)(0xffffffff)) >> (j0 - 20);
if((i1 & i) == 0) return x; /* x is integral */
if(hugev + x > 0.0) { /* raise inexact flag */
if(i0 < 0) {
if(j0 == 20) i0 += 1;
else {
j = i1 + (1 << (52 - j0));
if(j < i1) i0 += 1; /* got a carry */
i1 = j;
}
}
i1 &= (~i);
}
}
__HI(x) = i0;
__LO(x) = i1;
return x;
}

46
external/fdlibm/s_frexp.c vendored Normal file
View File

@@ -0,0 +1,46 @@
/* @(#)s_frexp.c 1.4 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* for non-zero x
* x = frexp(arg,&exp);
* return a double fp quantity x such that 0.5 <= |x| <1.0
* and the corresponding binary exponent "exp". That is
* arg = x*2^exp.
* If arg is inf, 0.0, or NaN, then frexp(arg,&exp) returns arg
* with *exp=0.
*/
#include "math.h"
static const double
two54 = 1.80143985094819840000e+16; /* 0x43500000, 0x00000000 */
double frexp(double x, int* eptr) {
int hx, ix, lx;
hx = __HI(x);
ix = 0x7fffffff & hx;
lx = __LO(x);
*eptr = 0;
if(ix >= 0x7ff00000 || ((ix | lx) == 0)) return x; /* 0,inf,nan */
if(ix < 0x00100000) { /* subnormal */
x *= two54;
hx = __HI(x);
ix = hx & 0x7fffffff;
*eptr = -54;
}
*eptr += (ix >> 20) - 1022;
hx = (hx & 0x800fffff) | 0x3fe00000;
__HI(x) = hx;
return x;
}

41
external/fdlibm/s_ilogb.c vendored Normal file
View File

@@ -0,0 +1,41 @@
/* @(#)s_ilogb.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* ilogb(double x)
* return the binary exponent of non-zero x
* ilogb(0) = 0x80000001
* ilogb(inf/NaN) = 0x7fffffff (no signal is raised)
*/
#include "math.h"
int ilogb(double x) {
int hx, lx, ix;
hx = (__HI(x)) & 0x7fffffff; /* high word of x */
if(hx < 0x00100000) {
lx = __LO(x);
if((hx | lx) == 0)
return 0x80000001; /* ilogb(0) = 0x80000001 */
else /* subnormal x */
if(hx == 0) {
for(ix = -1043; lx > 0; lx <<= 1) ix -= 1;
} else {
for(ix = -1022, hx <<= 11; hx > 0; hx <<= 1) ix -= 1;
}
return ix;
} else if(hx < 0x7ff00000)
return (hx >> 20) - 1023;
else
return 0x7fffffff;
}

28
external/fdlibm/s_isnan.c vendored Normal file
View File

@@ -0,0 +1,28 @@
/* @(#)s_isnan.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* isnan(x) returns 1 is x is nan, else 0;
* no branching!
*/
#include "math.h"
int isnan(double x) {
int hx, lx;
hx = (__HI(x) & 0x7fffffff);
lx = __LO(x);
hx |= (unsigned)(lx | (-lx)) >> 31;
hx = 0x7ff00000 - hx;
return ((unsigned)(hx)) >> 31;
}

22
external/fdlibm/s_ldexp.c vendored Normal file
View File

@@ -0,0 +1,22 @@
/* @(#)s_ldexp.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
#include "math.h"
#include <errno.h>
double ldexp(double value, int exp) {
if(!finite(value) || value == 0.0) return value;
value = scalbn(value, exp);
if(!finite(value) || value == 0.0) errno = ERANGE;
return value;
}

165
external/fdlibm/s_log1p.c vendored Normal file
View File

@@ -0,0 +1,165 @@
/* @(#)s_log1p.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* double log1p(double x)
*
* Method :
* 1. Argument Reduction: find k and f such that
* 1+x = 2^k * (1+f),
* where sqrt(2)/2 < 1+f < sqrt(2) .
*
* Note. If k=0, then f=x is exact. However, if k!=0, then f
* may not be representable exactly. In that case, a correction
* term is need. Let u=1+x rounded. Let c = (1+x)-u, then
* log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u),
* and add back the correction term c/u.
* (Note: when x > 2**53, one can simply return log(x))
*
* 2. Approximation of log1p(f).
* Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
* = 2s + 2/3 s**3 + 2/5 s**5 + .....,
* = 2s + s*R
* We use a special Reme algorithm on [0,0.1716] to generate
* a polynomial of degree 14 to approximate R The maximum error
* of this polynomial approximation is bounded by 2**-58.45. In
* other words,
* 2 4 6 8 10 12 14
* R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s
* (the values of Lp1 to Lp7 are listed in the program)
* and
* | 2 14 | -58.45
* | Lp1*s +...+Lp7*s - R(z) | <= 2
* | |
* Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
* In order to guarantee error in log below 1ulp, we compute log
* by
* log1p(f) = f - (hfsq - s*(hfsq+R)).
*
* 3. Finally, log1p(x) = k*ln2 + log1p(f).
* = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
* Here ln2 is split into two floating point number:
* ln2_hi + ln2_lo,
* where n*ln2_hi is always exact for |n| < 2000.
*
* Special cases:
* log1p(x) is NaN with signal if x < -1 (including -INF) ;
* log1p(+INF) is +INF; log1p(-1) is -INF with signal;
* log1p(NaN) is that NaN with no signal.
*
* Accuracy:
* according to an error analysis, the error is always less than
* 1 ulp (unit in the last place).
*
* Constants:
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*
* Note: Assuming log() return accurate answer, the following
* algorithm can be used to compute log1p(x) to within a few ULP:
*
* u = 1+x;
* if(u==1.0) return x ; else
* return log(u)*(x/(u-1.0));
*
* See HP-15C Advanced Functions Handbook, p.193.
*/
#include "math.h"
static const double
ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
static double zero = 0.0;
double log1p(double x) {
double hfsq, f, c, s, z, R, u;
int k, hx, hu, ax;
hx = __HI(x); /* high word of x */
ax = hx & 0x7fffffff;
k = 1;
if(hx < 0x3FDA827A) { /* x < 0.41422 */
if(ax >= 0x3ff00000) { /* x <= -1.0 */
if(x == -1.0) return -two54 / zero; /* log1p(-1)=+inf */
else
return (x - x) / (x - x); /* log1p(x<-1)=NaN */
}
if(ax < 0x3e200000) { /* |x| < 2**-29 */
if(two54 + x > zero /* raise inexact */
&& ax < 0x3c900000) /* |x| < 2**-54 */
return x;
else
return x - x * x * 0.5;
}
if(hx > 0 || hx <= ((int)0xbfd2bec3)) {
k = 0;
f = x;
hu = 1;
} /* -0.2929<x<0.41422 */
}
if(hx >= 0x7ff00000) return x + x;
if(k != 0) {
if(hx < 0x43400000) {
u = 1.0 + x;
hu = __HI(u); /* high word of u */
k = (hu >> 20) - 1023;
c = (k > 0) ? 1.0 - (u - x) : x - (u - 1.0); /* correction term */
c /= u;
} else {
u = x;
hu = __HI(u); /* high word of u */
k = (hu >> 20) - 1023;
c = 0;
}
hu &= 0x000fffff;
if(hu < 0x6a09e) {
__HI(u) = hu | 0x3ff00000; /* normalize u */
} else {
k += 1;
__HI(u) = hu | 0x3fe00000; /* normalize u/2 */
hu = (0x00100000 - hu) >> 2;
}
f = u - 1.0;
}
hfsq = 0.5 * f * f;
if(hu == 0) { /* |f| < 2**-20 */
if(f == zero)
if(k == 0) return zero;
else {
c += k * ln2_lo;
return k * ln2_hi + c;
}
R = hfsq * (1.0 - 0.66666666666666666 * f);
if(k == 0) return f - R;
else
return k * ln2_hi - ((R - (k * ln2_lo + c)) - f);
}
s = f / (2.0 + f);
z = s * s;
R = z * (Lp1 + z * (Lp2 + z * (Lp3 + z * (Lp4 + z * (Lp5 + z * (Lp6 + z * Lp7))))));
if(k == 0) return f - (hfsq - s * (hfsq + R));
else
return k * ln2_hi - ((hfsq - (s * (hfsq + R) + (k * ln2_lo + c))) - f);
}

32
external/fdlibm/s_logb.c vendored Normal file
View File

@@ -0,0 +1,32 @@
/* @(#)s_logb.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* double logb(x)
* IEEE 754 logb. Included to pass IEEE test suite. Not recommend.
* Use ilogb instead.
*/
#include "math.h"
double logb(double x) {
int lx, ix;
ix = (__HI(x)) & 0x7fffffff; /* high |x| */
lx = __LO(x); /* low x */
if((ix | lx) == 0) return -1.0 / fabs(x);
if(ix >= 0x7ff00000) return x * x;
if((ix >>= 20) == 0) /* IEEE 754 logb */
return -1022.0;
else
return (double)(ix - 1023);
}

70
external/fdlibm/s_modf.c vendored Normal file
View File

@@ -0,0 +1,70 @@
/* @(#)s_modf.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* modf(double x, double *iptr)
* return fraction part of x, and return x's integral part in *iptr.
* Method:
* Bit twiddling.
*
* Exception:
* No exception.
*/
#include "math.h"
static const double one = 1.0;
double modf(double x, double* iptr) {
int i0, i1, j0;
unsigned i;
i0 = __HI(x); /* high x */
i1 = __LO(x); /* low x */
j0 = ((i0 >> 20) & 0x7ff) - 0x3ff; /* exponent of x */
if(j0 < 20) { /* integer part in high x */
if(j0 < 0) { /* |x|<1 */
__HIp(iptr) = i0 & 0x80000000;
__LOp(iptr) = 0; /* *iptr = +-0 */
return x;
} else {
i = (0x000fffff) >> j0;
if(((i0 & i) | i1) == 0) { /* x is integral */
*iptr = x;
__HI(x) &= 0x80000000;
__LO(x) = 0; /* return +-0 */
return x;
} else {
__HIp(iptr) = i0 & (~i);
__LOp(iptr) = 0;
return x - *iptr;
}
}
} else if(j0 > 51) { /* no fraction part */
*iptr = x * one;
__HI(x) &= 0x80000000;
__LO(x) = 0; /* return +-0 */
return x;
} else { /* fraction part in low x */
i = ((unsigned)(0xffffffff)) >> (j0 - 20);
if((i1 & i) == 0) { /* x is integral */
*iptr = x;
__HI(x) &= 0x80000000;
__LO(x) = 0; /* return +-0 */
return x;
} else {
__HIp(iptr) = i0;
__LOp(iptr) = i1 & (~i);
return x - *iptr;
}
}
}

76
external/fdlibm/s_nextafter.c vendored Normal file
View File

@@ -0,0 +1,76 @@
/* @(#)s_nextafter.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* IEEE functions
* nextafter(x,y)
* return the next machine floating-point number of x in the
* direction toward y.
* Special cases:
*/
#include "math.h"
double nextafter(double x, double y) {
int hx, hy, ix, iy;
unsigned lx, ly;
hx = __HI(x); /* high word of x */
lx = __LO(x); /* low word of x */
hy = __HI(y); /* high word of y */
ly = __LO(y); /* low word of y */
ix = hx & 0x7fffffff; /* |x| */
iy = hy & 0x7fffffff; /* |y| */
if(((ix >= 0x7ff00000) && ((ix - 0x7ff00000) | lx) != 0) || /* x is nan */
((iy >= 0x7ff00000) && ((iy - 0x7ff00000) | ly) != 0)) /* y is nan */
return x + y;
if(x == y) return x; /* x=y, return x */
if((ix | lx) == 0) { /* x == 0 */
__HI(x) = hy & 0x80000000; /* return +-minsubnormal */
__LO(x) = 1;
y = x * x;
if(y == x) return y;
else
return x; /* raise underflow flag */
}
if(hx >= 0) { /* x > 0 */
if(hx > hy || ((hx == hy) && (lx > ly))) { /* x > y, x -= ulp */
if(lx == 0) hx -= 1;
lx -= 1;
} else { /* x < y, x += ulp */
lx += 1;
if(lx == 0) hx += 1;
}
} else { /* x < 0 */
if(hy >= 0 || hx > hy || ((hx == hy) && (lx > ly))) { /* x < y, x -= ulp */
if(lx == 0) hx -= 1;
lx -= 1;
} else { /* x > y, x += ulp */
lx += 1;
if(lx == 0) hx += 1;
}
}
hy = hx & 0x7ff00000;
if(hy >= 0x7ff00000) return x + x; /* overflow */
if(hy < 0x00100000) { /* underflow */
y = x * x;
if(y != x) { /* raise underflow flag */
__HI(y) = hx;
__LO(y) = lx;
return y;
}
}
__HI(x) = hx;
__LO(x) = lx;
return x;
}

76
external/fdlibm/s_rint.c vendored Normal file
View File

@@ -0,0 +1,76 @@
/* @(#)s_rint.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* rint(x)
* Return x rounded to integral value according to the prevailing
* rounding mode.
* Method:
* Using floating addition.
* Exception:
* Inexact flag raised if x not equal to rint(x).
*/
#include "math.h"
static const double
TWO52[2] = {
4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
-4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */
};
double rint(double x) {
int i0, j0, sx;
unsigned i, i1;
double w, t;
i0 = __HI(x);
sx = (i0 >> 31) & 1;
i1 = __LO(x);
j0 = ((i0 >> 20) & 0x7ff) - 0x3ff;
if(j0 < 20) {
if(j0 < 0) {
if(((i0 & 0x7fffffff) | i1) == 0) return x;
i1 |= (i0 & 0x0fffff);
i0 &= 0xfffe0000;
i0 |= ((i1 | -i1) >> 12) & 0x80000;
__HI(x) = i0;
w = TWO52[sx] + x;
t = w - TWO52[sx];
i0 = __HI(t);
__HI(t) = (i0 & 0x7fffffff) | (sx << 31);
return t;
} else {
i = (0x000fffff) >> j0;
if(((i0 & i) | i1) == 0) return x; /* x is integral */
i >>= 1;
if(((i0 & i) | i1) != 0) {
if(j0 == 19) i1 = 0x40000000;
else
i0 = (i0 & (~i)) | ((0x20000) >> j0);
}
}
} else if(j0 > 51) {
if(j0 == 0x400) return x + x; /* inf or NaN */
else
return x; /* x is integral */
} else {
i = ((unsigned)(0xffffffff)) >> (j0 - 20);
if((i1 & i) == 0) return x; /* x is integral */
i >>= 1;
if((i1 & i) != 0) i1 = (i1 & (~i)) | ((0x40000000) >> (j0 - 20));
}
__HI(x) = i0;
__LO(x) = i1;
w = TWO52[sx] + x;
return w - TWO52[sx];
}

57
external/fdlibm/s_scalbn.c vendored Normal file
View File

@@ -0,0 +1,57 @@
/* @(#)s_scalbn.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* scalbn (double x, int n)
* scalbn(x,n) returns x* 2**n computed by exponent
* manipulation rather than by actually performing an
* exponentiation or a multiplication.
*/
#include "math.h"
static const double
two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */
hugev = 1.0e+300,
tinyv = 1.0e-300;
double scalbn(double x, int n) {
int k, hx, lx;
hx = __HI(x);
lx = __LO(x);
k = (hx & 0x7ff00000) >> 20; /* extract exponent */
if(k == 0) { /* 0 or subnormal x */
if((lx | (hx & 0x7fffffff)) == 0) return x; /* +-0 */
x *= two54;
hx = __HI(x);
k = ((hx & 0x7ff00000) >> 20) - 54;
if(n < -50000) return tinyv * x; /*underflow*/
}
if(k == 0x7ff) return x + x; /* NaN or Inf */
k = k + n;
if(k > 0x7fe) return hugev * copysign(hugev, x); /* overflow */
if(k > 0) /* normal result */
{
__HI(x) = (hx & 0x800fffff) | (k << 20);
return x;
}
if(k <= -54)
if(n > 50000) /* in case integer overflow in n+k */
return hugev * copysign(hugev, x); /*overflow*/
else
return tinyv * copysign(tinyv, x); /*underflow*/
k += 54; /* subnormal result */
__HI(x) = (hx & 0x800fffff) | (k << 20);
return x * twom54;
}

2
external/fdlibm/s_signgam.c vendored Normal file
View File

@@ -0,0 +1,2 @@
#include "math.h"
int signgam = 0;

24
external/fdlibm/s_significand.c vendored Normal file
View File

@@ -0,0 +1,24 @@
/* @(#)s_significand.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* significand(x) computes just
* scalb(x, (double) -ilogb(x)),
* for exercising the fraction-part(F) IEEE 754-1985 test vector.
*/
#include "math.h"
double significand(double x) {
return __fdlibm_scalb(x, (double)-ilogb(x));
}

76
external/fdlibm/s_sin.c vendored Normal file
View File

@@ -0,0 +1,76 @@
/* @(#)s_sin.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* sin(x)
* Return sine function of x.
*
* kernel function:
* __fdlibm_kernel_sin ... sine function on [-pi/4,pi/4]
* __fdlibm_kernel_cos ... cose function on [-pi/4,pi/4]
* __fdlibm_kernel_rem_pio2 ... argument reduction routine
*
* Method.
* Let S,C and T denote the sin, cos and tan respectively on
* [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
* in [-pi/4 , +pi/4], and let n = k mod 4.
* We have
*
* n sin(x) cos(x) tan(x)
* ----------------------------------------------------------
* 0 S C T
* 1 C -S -1/T
* 2 -S -C T
* 3 -C S -1/T
* ----------------------------------------------------------
*
* Special cases:
* Let trig be any of sin, cos, or tan.
* trig(+-INF) is NaN, with signals;
* trig(NaN) is that NaN;
*
* Accuracy:
* TRIG(x) returns trig(x) nearly rounded
*/
#include "math.h"
double sin(double x) {
double y[2], z = 0.0;
int n, ix;
/* High word of x. */
ix = __HI(x);
/* |x| ~< pi/4 */
ix &= 0x7fffffff;
if(ix <= 0x3fe921fb) return __fdlibm_kernel_sin(x, z, 0);
/* sin(Inf or NaN) is NaN */
else if(ix >= 0x7ff00000)
return x - x;
/* argument reduction needed */
else {
n = __fdlibm_rem_pio2(x, y);
switch(n & 3) {
case 0:
return __fdlibm_kernel_sin(y[0], y[1], 1);
case 1:
return __fdlibm_kernel_cos(y[0], y[1]);
case 2:
return -__fdlibm_kernel_sin(y[0], y[1], 1);
default:
return -__fdlibm_kernel_cos(y[0], y[1]);
}
}
}

67
external/fdlibm/s_tan.c vendored Normal file
View File

@@ -0,0 +1,67 @@
/* @(#)s_tan.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* tan(x)
* Return tangent function of x.
*
* kernel function:
* __fdlibm_kernel_tan ... tangent function on [-pi/4,pi/4]
* __fdlibm_kernel_rem_pio2 ... argument reduction routine
*
* Method.
* Let S,C and T denote the sin, cos and tan respectively on
* [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
* in [-pi/4 , +pi/4], and let n = k mod 4.
* We have
*
* n sin(x) cos(x) tan(x)
* ----------------------------------------------------------
* 0 S C T
* 1 C -S -1/T
* 2 -S -C T
* 3 -C S -1/T
* ----------------------------------------------------------
*
* Special cases:
* Let trig be any of sin, cos, or tan.
* trig(+-INF) is NaN, with signals;
* trig(NaN) is that NaN;
*
* Accuracy:
* TRIG(x) returns trig(x) nearly rounded
*/
#include "math.h"
double tan(double x) {
double y[2], z = 0.0;
int n, ix;
/* High word of x. */
ix = __HI(x);
/* |x| ~< pi/4 */
ix &= 0x7fffffff;
if(ix <= 0x3fe921fb) return __fdlibm_kernel_tan(x, z, 1);
/* tan(Inf or NaN) is NaN */
else if(ix >= 0x7ff00000)
return x - x; /* NaN */
/* argument reduction needed */
else {
n = __fdlibm_rem_pio2(x, y);
return __fdlibm_kernel_tan(y[0], y[1], 1 - ((n & 1) << 1)); /* 1 -- n even
-1 -- n odd */
}
}

73
external/fdlibm/s_tanh.c vendored Normal file
View File

@@ -0,0 +1,73 @@
/* @(#)s_tanh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/* Tanh(x)
* Return the Hyperbolic Tangent of x
*
* Method :
* x -x
* e - e
* 0. tanh(x) is defined to be -----------
* x -x
* e + e
* 1. reduce x to non-negative by tanh(-x) = -tanh(x).
* 2. 0 <= x <= 2**-55 : tanh(x) := x*(one+x)
* -t
* 2**-55 < x <= 1 : tanh(x) := -----; t = expm1(-2x)
* t + 2
* 2
* 1 <= x <= 22.0 : tanh(x) := 1- ----- ; t=expm1(2x)
* t + 2
* 22.0 < x <= INF : tanh(x) := 1.
*
* Special cases:
* tanh(NaN) is NaN;
* only tanh(0)=0 is exact for finite argument.
*/
#include "math.h"
static const double one = 1.0, two = 2.0, tinyv = 1.0e-300;
double tanh(double x) {
double t, z;
int jx, ix;
/* High word of |x|. */
jx = __HI(x);
ix = jx & 0x7fffffff;
/* x is INF or NaN */
if(ix >= 0x7ff00000) {
if(jx >= 0) return one / x + one; /* tanh(+-inf)=+-1 */
else
return one / x - one; /* tanh(NaN) = NaN */
}
/* |x| < 22 */
if(ix < 0x40360000) { /* |x|<22 */
if(ix < 0x3c800000) /* |x|<2**-55 */
return x * (one + x); /* tanh(small) = small */
if(ix >= 0x3ff00000) { /* |x|>=1 */
t = expm1(two * fabs(x));
z = one - two / (t + two);
} else {
t = expm1(-two * fabs(x));
z = -t / (t + two);
}
/* |x| > 22, return +-1 */
} else {
z = one - tinyv; /* raised inexact flag */
}
return (jx >= 0) ? z : -z;
}

23
external/fdlibm/w_acos.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_acos.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrap_acos(x)
*/
#include "math.h"
double acos(double x) /* wrapper acos */
{
return __fdlibm_acos(x);
}

24
external/fdlibm/w_acosh.c vendored Normal file
View File

@@ -0,0 +1,24 @@
/* @(#)w_acosh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/*
* wrapper acosh(x)
*/
#include "math.h"
double acosh(double x) /* wrapper acosh */
{
return __fdlibm_acosh(x);
}

24
external/fdlibm/w_asin.c vendored Normal file
View File

@@ -0,0 +1,24 @@
/* @(#)w_asin.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/*
* wrapper asin(x)
*/
#include "math.h"
double asin(double x) /* wrapper asin */
{
return __fdlibm_asin(x);
}

24
external/fdlibm/w_atan2.c vendored Normal file
View File

@@ -0,0 +1,24 @@
/* @(#)w_atan2.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/*
* wrapper atan2(y,x)
*/
#include "math.h"
double atan2(double y, double x) /* wrapper atan2 */
{
return __fdlibm_atan2(y, x);
}

22
external/fdlibm/w_atanh.c vendored Normal file
View File

@@ -0,0 +1,22 @@
/* @(#)w_atanh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper atanh(x)
*/
#include "math.h"
double atanh(double x) /* wrapper atanh */
{
return __fdlibm_atanh(x);
}

23
external/fdlibm/w_cosh.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_cosh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper cosh(x)
*/
#include "math.h"
double cosh(double x) /* wrapper cosh */
{
return __fdlibm_cosh(x);
}

26
external/fdlibm/w_exp.c vendored Normal file
View File

@@ -0,0 +1,26 @@
/* @(#)w_exp.c 1.4 04/04/22 */
/*
* ====================================================
* Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved.
*
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper exp(x)
*/
#include "math.h"
static const double
o_threshold = 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
u_threshold = -7.45133219101941108420e+02; /* 0xc0874910, 0xD52D3051 */
double exp(double x) /* wrapper exp */
{
return __fdlibm_exp(x);
}

23
external/fdlibm/w_fmod.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_fmod.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper fmod(x,y)
*/
#include "math.h"
double fmod(double x, double y) /* wrapper fmod */
{
return __fdlibm_fmod(x, y);
}

27
external/fdlibm/w_gamma.c vendored Normal file
View File

@@ -0,0 +1,27 @@
/* @(#)w_gamma.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* double gamma(double x)
* Return the logarithm of the Gamma function of x.
*
* Method: call gamma_r
*/
#include "math.h"
extern int signgam;
double gamma(double x) {
return __fdlibm_gamma_r(x, &signgam);
}

23
external/fdlibm/w_gamma_r.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_gamma_r.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper double gamma_r(double x, int *signgamp)
*/
#include "math.h"
double gamma_r(double x, int* signgamp) /* wrapper lgamma_r */
{
return __fdlibm_gamma_r(x, signgamp);
}

23
external/fdlibm/w_hypot.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_hypot.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper hypot(x,y)
*/
#include "math.h"
double hypot(double x, double y) /* wrapper hypot */
{
return __fdlibm_hypot(x, y);
}

28
external/fdlibm/w_j0.c vendored Normal file
View File

@@ -0,0 +1,28 @@
/* @(#)w_j0.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper j0(double x), y0(double x)
*/
#include "math.h"
double j0(double x) /* wrapper j0 */
{
return __fdlibm_j0(x);
}
double y0(double x) /* wrapper y0 */
{
return __fdlibm_y0(x);
}

28
external/fdlibm/w_j1.c vendored Normal file
View File

@@ -0,0 +1,28 @@
/* @(#)w_j1.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper of j1,y1
*/
#include "math.h"
double j1(double x) /* wrapper j1 */
{
return __fdlibm_j1(x);
}
double y1(double x) /* wrapper y1 */
{
return __fdlibm_y1(x);
}

50
external/fdlibm/w_jn.c vendored Normal file
View File

@@ -0,0 +1,50 @@
/* @(#)w_jn.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper jn(int n, double x), yn(int n, double x)
* floating point Bessel's function of the 1st and 2nd kind
* of order n
*
* Special cases:
* y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal;
* y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal.
* Note 2. About jn(n,x), yn(n,x)
* For n=0, j0(x) is called,
* for n=1, j1(x) is called,
* for n<x, forward recursion us used starting
* from values of j0(x) and j1(x).
* for n>x, a continued fraction approximation to
* j(n,x)/j(n-1,x) is evaluated and then backward
* recursion is used starting from a supposed value
* for j(n,x). The resulting value of j(0,x) is
* compared with the actual value to correct the
* supposed value of j(n,x).
*
* yn(n,x) is similar in all respects, except
* that forward recursion is used for all
* values of n>1.
*
*/
#include "math.h"
double jn(int n, double x) /* wrapper jn */
{
return __fdlibm_jn(n, x);
}
double yn(int n, double x) /* wrapper yn */
{
return __fdlibm_yn(n, x);
}

27
external/fdlibm/w_lgamma.c vendored Normal file
View File

@@ -0,0 +1,27 @@
/* @(#)w_lgamma.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*
*/
/* double lgamma(double x)
* Return the logarithm of the Gamma function of x.
*
* Method: call __fdlibm_lgamma_r
*/
#include "math.h"
extern int signgam;
double lgamma(double x) {
return __fdlibm_lgamma_r(x, &signgam);
}

23
external/fdlibm/w_lgamma_r.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_lgamma_r.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper double lgamma_r(double x, int *signgamp)
*/
#include "math.h"
double lgamma_r(double x, int* signgamp) /* wrapper lgamma_r */
{
return __fdlibm_lgamma_r(x, signgamp);
}

23
external/fdlibm/w_log.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_log.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper log(x)
*/
#include "math.h"
double log(double x) /* wrapper log */
{
return __fdlibm_log(x);
}

23
external/fdlibm/w_log10.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_log10.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper log10(X)
*/
#include "math.h"
double log10(double x) /* wrapper log10 */
{
return __fdlibm_log10(x);
}

24
external/fdlibm/w_pow.c vendored Normal file
View File

@@ -0,0 +1,24 @@
/* @(#)w_pow.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper pow(x,y) return x**y
*/
#include "math.h"
double pow(double x, double y) /* wrapper pow */
{
return __fdlibm_pow(x, y);
}

23
external/fdlibm/w_remainder.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_remainder.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper remainder(x,p)
*/
#include "math.h"
double remainder(double x, double y) /* wrapper remainder */
{
return __fdlibm_remainder(x, y);
}

27
external/fdlibm/w_scalb.c vendored Normal file
View File

@@ -0,0 +1,27 @@
/* @(#)w_scalb.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper scalb(double x, double fn) is provide for
* passing various standard test suite. One
* should use scalbn() instead.
*/
#include "math.h"
#include <errno.h>
double scalb(double x, double fn) /* wrapper scalb */
{
return __fdlibm_scalb(x, fn);
}

23
external/fdlibm/w_sinh.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_sinh.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper sinh(x)
*/
#include "math.h"
double sinh(double x) /* wrapper sinh */
{
return __fdlibm_sinh(x);
}

23
external/fdlibm/w_sqrt.c vendored Normal file
View File

@@ -0,0 +1,23 @@
/* @(#)w_sqrt.c 1.3 95/01/18 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunSoft, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
/*
* wrapper sqrt(x)
*/
#include "math.h"
double sqrt(double x) /* wrapper sqrt */
{
return __fdlibm_sqrt(x);
}