lostecho/oldlinux-files
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add directory gnu

Browse Source
This commit is contained in:
gohigh
2024-02-19 00:24:47 -05:00
parent 32616db5a4
commit a40f4cadb0
5086 changed files with 1860970 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

153
gnu/glibc/glibc-1.03/math/bsd/common_source/__expm1.c Normal file
View File

@@ -0,0 +1,153 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)expm1.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* EXPM1(X)
* RETURN THE EXPONENTIAL OF X MINUS ONE
* DOUBLE PRECISION (IEEE 53 BITS, VAX D FORMAT 56 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/6/85, 3/7/85, 3/21/85, 4/16/85.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* finite(x)
*
* Kernel function:
* exp__E(x,c)
*
* Method:
* 1. Argument Reduction: given the input x, find r and integer k such
* that
* x = k*ln2 + r, |r| <= 0.5*ln2 .
* r will be represented as r := z+c for better accuracy.
*
* 2. Compute EXPM1(r)=exp(r)-1 by
*
* EXPM1(r=z+c) := z + exp__E(z,c)
*
* 3. EXPM1(x) = 2^k * ( EXPM1(r) + 1-2^-k ).
*
* Remarks:
* 1. When k=1 and z < -0.25, we use the following formula for
* better accuracy:
* EXPM1(x) = 2 * ( (z+0.5) + exp__E(z,c) )
* 2. To avoid rounding error in 1-2^-k where k is large, we use
* EXPM1(x) = 2^k * { [z+(exp__E(z,c)-2^-k )] + 1 }
* when k>56.
*
* Special cases:
* EXPM1(INF) is INF, EXPM1(NaN) is NaN;
* EXPM1(-INF)= -1;
* for finite argument, only EXPM1(0)=0 is exact.
*
* Accuracy:
* EXPM1(x) returns the exact (exp(x)-1) nearly rounded. In a test run with
* 1,166,000 random arguments on a VAX, the maximum observed error was
* .872 ulps (units of 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 "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(lnhuge, 9.4961163736712506989E1 ,ec1d,43bd,9010,a73e, 7, .BDEC1DA73E9010)
vc(invln2, 1.4426950408889634148E0 ,aa3b,40b8,17f1,295c, 1, .B8AA3B295C17F1)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(lnhuge, 7.1602103751842355450E2, 9, 1.6602B15B7ECF2)
ic(invln2, 1.4426950408889633870E0, 0, 1.71547652B82FE)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define lnhuge vccast(lnhuge)
#define invln2 vccast(invln2)
#endif
double expm1(x)
double x;
{
const static double one=1.0, half=1.0/2.0;
double z,hi,lo,c;
int k;
#if defined(vax)||defined(tahoe)
static prec=56;
#else /* defined(vax)||defined(tahoe) */
static prec=53;
#endif /* defined(vax)||defined(tahoe) */
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if( x <= lnhuge ) {
if( x >= -40.0 ) {
/* argument reduction : x - k*ln2 */
k= invln2 *x+copysign(0.5,x); /* k=NINT(x/ln2) */
hi=x-k*ln2hi ;
z=hi-(lo=k*ln2lo);
c=(hi-z)-lo;
if(k==0) return(z+exp__E(z,c));
if(k==1)
if(z< -0.25)
{x=z+half;x +=exp__E(z,c); return(x+x);}
else
{z+=exp__E(z,c); x=half+z; return(x+x);}
/* end of k=1 */
else {
if(k<=prec)
{ x=one-scalb(one,-k); z += exp__E(z,c);}
else if(k<100)
{ x = exp__E(z,c)-scalb(one,-k); x+=z; z=one;}
else
{ x = exp__E(z,c)+z; z=one;}
return (scalb(x+z,k));
}
}
/* end of x > lnunfl */
else
/* expm1(-big#) rounded to -1 (inexact) */
if(finite(x))
{ ln2hi+ln2lo; return(-one);}
/* expm1(-INF) is -1 */
else return(-one);
}
/* end of x < lnhuge */
else
/* expm1(INF) is INF, expm1(+big#) overflows to INF */
return( finite(x) ? scalb(one,5000) : x);
}

88
gnu/glibc/glibc-1.03/math/bsd/common_source/acosh.c Normal file
View File

@@ -0,0 +1,88 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)acosh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ACOSH(X)
* RETURN THE INVERSE HYPERBOLIC COSINE OF X
* DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 2/16/85;
* REVISED BY K.C. NG on 3/6/85, 3/24/85, 4/16/85, 8/17/85.
*
* Required system supported functions :
* sqrt(x)
*
* Required kernel function:
* log1p(x) ...return log(1+x)
*
* Method :
* Based on
* acosh(x) = log [ x + sqrt(x*x-1) ]
* we have
* acosh(x) := log1p(x)+ln2, if (x > 1.0E20); else
* acosh(x) := log1p( sqrt(x-1) * (sqrt(x-1) + sqrt(x+1)) ) .
* These formulae avoid the over/underflow complication.
*
* Special cases:
* acosh(x) is NaN with signal if x<1.
* acosh(NaN) is NaN without signal.
*
* Accuracy:
* acosh(x) returns the exact inverse hyperbolic cosine of x nearly
* rounded. In a test run with 512,000 random arguments on a VAX, the
* maximum observed error was 3.30 ulps (units of the last place) at
* x=1.0070493753568216 .
*
* 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 "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10,-33, 1.A39EF35793C76)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#endif
double acosh(x)
double x;
{
double t,big=1.E20; /* big+1==big */
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
/* return log1p(x) + log(2) if x is large */
if(x>big) {t=log1p(x)+ln2lo; return(t+ln2hi);}
t=sqrt(x-1.0);
return(log1p(t*(t+sqrt(x+1.0))));
}

155
gnu/glibc/glibc-1.03/math/bsd/common_source/asincos.c Normal file
View File

@@ -0,0 +1,155 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)asincos.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
/* ASIN(X)
* RETURNS ARC SINE OF X
* DOUBLE PRECISION (IEEE DOUBLE 53 bits, VAX D FORMAT 56 bits)
* CODED IN C BY K.C. NG, 4/16/85, REVISED ON 6/10/85.
*
* Required system supported functions:
* copysign(x,y)
* sqrt(x)
*
* Required kernel function:
* atan2(y,x)
*
* Method :
* asin(x) = atan2(x,sqrt(1-x*x)); for better accuracy, 1-x*x is
* computed as follows
* 1-x*x if x < 0.5,
* 2*(1-|x|)-(1-|x|)*(1-|x|) if x >= 0.5.
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN.
*
* Accuracy:
* 1) If atan2() uses machine PI, then
*
* asin(x) returns (PI/pi) * (the exact arc sine of x) nearly rounded;
* and PI is the exact pi rounded to machine precision (see atan2 for
* details):
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with more than 200,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 2.06 ulps. (comparing against (PI/pi)*(exact asin(x)));
*
* 2) If atan2() uses true pi, then
*
* asin(x) returns the exact asin(x) with error below about 2 ulps.
*
* In a test run with more than 1,024,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 1.99 ulps.
*/
double asin(x)
double x;
{
double s,t,copysign(),atan2(),sqrt(),one=1.0;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
s=copysign(x,one);
if(s <= 0.5)
return(atan2(x,sqrt(one-x*x)));
else
{ t=one-s; s=t+t; return(atan2(x,sqrt(s-t*t))); }
}
/* ACOS(X)
* RETURNS ARC COS OF X
* DOUBLE PRECISION (IEEE DOUBLE 53 bits, VAX D FORMAT 56 bits)
* CODED IN C BY K.C. NG, 4/16/85, REVISED ON 6/10/85.
*
* Required system supported functions:
* copysign(x,y)
* sqrt(x)
*
* Required kernel function:
* atan2(y,x)
*
* Method :
* ________
* / 1 - x
* acos(x) = 2*atan2( / -------- , 1 ) .
* \/ 1 + x
*
* Special cases:
* if x is NaN, return x itself;
* if |x|>1, return NaN.
*
* Accuracy:
* 1) If atan2() uses machine PI, then
*
* acos(x) returns (PI/pi) * (the exact arc cosine of x) nearly rounded;
* and PI is the exact pi rounded to machine precision (see atan2 for
* details):
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with more than 200,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 2.07 ulps. (comparing against (PI/pi)*(exact acos(x)));
*
* 2) If atan2() uses true pi, then
*
* acos(x) returns the exact acos(x) with error below about 2 ulps.
*
* In a test run with more than 1,024,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 2.15 ulps.
*/
double acos(x)
double x;
{
double t,copysign(),atan2(),sqrt(),one=1.0;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x);
#endif /* !defined(vax)&&!defined(tahoe) */
if( x != -1.0)
t=atan2(sqrt((one-x)/(one+x)),one);
else
t=atan2(one,0.0); /* t = PI/2 */
return(t+t);
}

87
gnu/glibc/glibc-1.03/math/bsd/common_source/asinh.c Normal file
View File

@@ -0,0 +1,87 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)asinh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ASINH(X)
* RETURN THE INVERSE HYPERBOLIC SINE OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 2/16/85;
* REVISED BY K.C. NG on 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions :
* copysign(x,y)
* sqrt(x)
*
* Required kernel function:
* log1p(x) ...return log(1+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)*(log1p(x)+ln2)) if sqrt(1+x*x)=x, else
* := sign(x)*log1p(|x| + |x|/(1/|x| + sqrt(1+(1/|x|)^2)) )
*
* Accuracy:
* asinh(x) returns the exact inverse hyperbolic sine of x nearly rounded.
* In a test run with 52,000 random arguments on a VAX, the maximum
* observed error was 1.58 ulps (units 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 "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#endif
double asinh(x)
double x;
{
double t,s;
const static double small=1.0E-10, /* fl(1+small*small) == 1 */
big =1.0E20, /* fl(1+big) == big */
one =1.0 ;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if((t=copysign(x,one))>small)
if(t<big) {
s=one/t; return(copysign(log1p(t+t/(s+sqrt(one+s*s))),x)); }
else /* if |x| > big */
{s=log1p(t)+ln2lo; return(copysign(s+ln2hi,x));}
else /* if |x| < small */
return(x);
}

73
gnu/glibc/glibc-1.03/math/bsd/common_source/atan.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)atan.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
/* ATAN(X)
* RETURNS ARC TANGENT OF X
* DOUBLE PRECISION (IEEE DOUBLE 53 bits, VAX D FORMAT 56 bits)
* CODED IN C BY K.C. NG, 4/16/85, REVISED ON 6/10/85.
*
* Required kernel function:
* atan2(y,x)
*
* Method:
* atan(x) = atan2(x,1.0).
*
* Special case:
* if x is NaN, return x itself.
*
* Accuracy:
* 1) If atan2() uses machine PI, then
*
* atan(x) returns (PI/pi) * (the exact arc tangent of x) nearly rounded;
* and PI is the exact pi rounded to machine precision (see atan2 for
* details):
*
* in decimal:
* pi = 3.141592653589793 23846264338327 .....
* 53 bits PI = 3.141592653589793 115997963 ..... ,
* 56 bits PI = 3.141592653589793 227020265 ..... ,
*
* in hexadecimal:
* pi = 3.243F6A8885A308D313198A2E....
* 53 bits PI = 3.243F6A8885A30 = 2 * 1.921FB54442D18 error=.276ulps
* 56 bits PI = 3.243F6A8885A308 = 4 * .C90FDAA22168C2 error=.206ulps
*
* In a test run with more than 200,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 0.86 ulps. (comparing against (PI/pi)*(exact atan(x))).
*
* 2) If atan2() uses true pi, then
*
* atan(x) returns the exact atan(x) with error below about 2 ulps.
*
* In a test run with more than 1,024,000 random arguments on a VAX, the
* maximum observed error in ulps (units in the last place) was
* 0.85 ulps.
*/
double atan(x)
double x;
{
double atan2(),one=1.0;
return(atan2(x,one));
}

69
gnu/glibc/glibc-1.03/math/bsd/common_source/atanh.c Normal file
View File

@@ -0,0 +1,69 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)atanh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* ATANH(X)
* RETURN THE HYPERBOLIC ARC TANGENT OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/7/85, 3/7/85, 8/18/85.
*
* Required kernel function:
* log1p(x) ...return log(1+x)
*
* Method :
* Return
* 1 2x x
* atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
* 2 1 - 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.
*
* Accuracy:
* atanh(x) returns the exact hyperbolic arc tangent of x nearly rounded.
* In a test run with 512,000 random arguments on a VAX, the maximum
* observed error was 1.87 ulps (units in the last place) at
* x= -3.8962076028810414000e-03.
*/
#include "mathimpl.h"
#if defined(vax)||defined(tahoe)
#include <errno.h>
#endif /* defined(vax)||defined(tahoe) */
double atanh(x)
double x;
{
double z;
z = copysign(0.5,x);
x = copysign(x,1.0);
#if defined(vax)||defined(tahoe)
if (x == 1.0) {
return(copysign(1.0,z)*infnan(ERANGE)); /* sign(x)*INF */
}
#endif /* defined(vax)||defined(tahoe) */
x = x/(1.0-x);
return( z*log1p(x+x) );
}

119
gnu/glibc/glibc-1.03/math/bsd/common_source/cosh.c Normal file
View File

@@ -0,0 +1,119 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)cosh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* COSH(X)
* RETURN THE HYPERBOLIC COSINE OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 2/23/85, 3/7/85, 3/29/85, 4/16/85.
*
* Required system supported functions :
* copysign(x,y)
* scalb(x,N)
*
* Required kernel function:
* exp(x)
* exp__E(x,c) ...return exp(x+c)-1-x for |x|<0.3465
*
* Method :
* 1. Replace x by |x|.
* 2.
* [ exp(x) - 1 ]^2
* 0 <= x <= 0.3465 : cosh(x) := 1 + -------------------
* 2*exp(x)
*
* exp(x) + 1/exp(x)
* 0.3465 <= x <= 22 : cosh(x) := -------------------
* 2
* 22 <= x <= lnovfl : cosh(x) := exp(x)/2
* lnovfl <= x <= lnovfl+log(2)
* : cosh(x) := exp(x)/2 (avoid overflow)
* log(2)+lnovfl < x < INF: overflow to INF
*
* Note: .3465 is a number near one half of ln2.
*
* Special cases:
* cosh(x) is x if x is +INF, -INF, or NaN.
* only cosh(0)=1 is exact for finite x.
*
* Accuracy:
* cosh(x) returns the exact hyperbolic cosine of x nearly rounded.
* In a test run with 768,000 random arguments on a VAX, the maximum
* observed error was 1.23 ulps (units 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 "mathimpl.h"
vc(mln2hi, 8.8029691931113054792E1 ,0f33,43b0,2bdb,c7e2, 7, .B00F33C7E22BDB)
vc(mln2lo,-4.9650192275318476525E-16 ,1b60,a70f,582a,279e, -50,-.8F1B60279E582A)
vc(lnovfl, 8.8029691931113053016E1 ,0f33,43b0,2bda,c7e2, 7, .B00F33C7E22BDA)
ic(mln2hi, 7.0978271289338397310E2, 10, 1.62E42FEFA39EF)
ic(mln2lo, 2.3747039373786107478E-14, -45, 1.ABC9E3B39803F)
ic(lnovfl, 7.0978271289338397310E2, 9, 1.62E42FEFA39EF)
#ifdef vccast
#define mln2hi vccast(mln2hi)
#define mln2lo vccast(mln2lo)
#define lnovfl vccast(lnovfl)
#endif
#if defined(vax)||defined(tahoe)
static max = 126 ;
#else /* defined(vax)||defined(tahoe) */
static max = 1023 ;
#endif /* defined(vax)||defined(tahoe) */
double cosh(x)
double x;
{
static const double half=1.0/2.0,
one=1.0, small=1.0E-18; /* fl(1+small)==1 */
double t;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if((x=copysign(x,one)) <= 22)
if(x<0.3465)
if(x<small) return(one+x);
else {t=x+exp__E(x,0.0);x=t+t; return(one+t*t/(2.0+x)); }
else /* for x lies in [0.3465,22] */
{ t=exp(x); return((t+one/t)*half); }
if( lnovfl <= x && x <= (lnovfl+0.7))
/* for x lies in [lnovfl, lnovfl+ln2], decrease x by ln(2^(max+1))
* and return 2^max*exp(x) to avoid unnecessary overflow
*/
return(scalb(exp((x-mln2hi)-mln2lo), max));
else
return(exp(x)*half); /* for large x, cosh(x)=exp(x)/2 */
}

144
gnu/glibc/glibc-1.03/math/bsd/common_source/exp.c Normal file
View File

@@ -0,0 +1,144 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)exp.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* EXP(X)
* RETURN THE EXPONENTIAL OF X
* DOUBLE PRECISION (IEEE 53 bits, VAX D FORMAT 56 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/6/85, 2/15/85, 3/7/85, 3/24/85, 4/16/85, 6/14/86.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* finite(x)
*
* Method:
* 1. Argument Reduction: given the input x, find r and integer k such
* that
* x = k*ln2 + r, |r| <= 0.5*ln2 .
* r will be represented as r := z+c for better accuracy.
*
* 2. Compute exp(r) by
*
* exp(r) = 1 + r + r*R1/(2-R1),
* where
* R1 = x - x^2*(p1+x^2*(p2+x^2*(p3+x^2*(p4+p5*x^2)))).
*
* 3. exp(x) = 2^k * exp(r) .
*
* Special cases:
* exp(INF) is INF, exp(NaN) is NaN;
* exp(-INF)= 0;
* for finite argument, only exp(0)=1 is exact.
*
* Accuracy:
* exp(x) returns the exponential of x nearly rounded. In a test run
* with 1,156,000 random arguments on a VAX, the maximum observed
* error was 0.869 ulps (units 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 "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(lnhuge, 9.4961163736712506989E1 ,ec1d,43bd,9010,a73e, 7, .BDEC1DA73E9010)
vc(lntiny,-9.5654310917272452386E1 ,4f01,c3bf,33af,d72e, 7,-.BF4F01D72E33AF)
vc(invln2, 1.4426950408889634148E0 ,aa3b,40b8,17f1,295c, 1, .B8AA3B295C17F1)
vc(p1, 1.6666666666666602251E-1 ,aaaa,3f2a,a9f1,aaaa, -2, .AAAAAAAAAAA9F1)
vc(p2, -2.7777777777015591216E-3 ,0b60,bc36,ec94,b5f5, -8,-.B60B60B5F5EC94)
vc(p3, 6.6137563214379341918E-5 ,b355,398a,f15f,792e, -13, .8AB355792EF15F)
vc(p4, -1.6533902205465250480E-6 ,ea0e,b6dd,5f84,2e93, -19,-.DDEA0E2E935F84)
vc(p5, 4.1381367970572387085E-8 ,bb4b,3431,2683,95f5, -24, .B1BB4B95F52683)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define lnhuge vccast(lnhuge)
#define lntiny vccast(lntiny)
#define invln2 vccast(invln2)
#define p1 vccast(p1)
#define p2 vccast(p2)
#define p3 vccast(p3)
#define p4 vccast(p4)
#define p5 vccast(p5)
#endif
ic(p1, 1.6666666666666601904E-1, -3, 1.555555555553E)
ic(p2, -2.7777777777015593384E-3, -9, -1.6C16C16BEBD93)
ic(p3, 6.6137563214379343612E-5, -14, 1.1566AAF25DE2C)
ic(p4, -1.6533902205465251539E-6, -20, -1.BBD41C5D26BF1)
ic(p5, 4.1381367970572384604E-8, -25, 1.6376972BEA4D0)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10,-33, 1.A39EF35793C76)
ic(lnhuge, 7.1602103751842355450E2, 9, 1.6602B15B7ECF2)
ic(lntiny,-7.5137154372698068983E2, 9, -1.77AF8EBEAE354)
ic(invln2, 1.4426950408889633870E0, 0, 1.71547652B82FE)
double exp(x)
double x;
{
double z,hi,lo,c;
int k;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if( x <= lnhuge ) {
if( x >= lntiny ) {
/* argument reduction : x --> x - k*ln2 */
k=invln2*x+copysign(0.5,x); /* k=NINT(x/ln2) */
/* express x-k*ln2 as hi-lo and let x=hi-lo rounded */
hi=x-k*ln2hi;
x=hi-(lo=k*ln2lo);
/* return 2^k*[1+x+x*c/(2+c)] */
z=x*x;
c= x - z*(p1+z*(p2+z*(p3+z*(p4+z*p5))));
return scalb(1.0+(hi-(lo-(x*c)/(2.0-c))),k);
}
/* end of x > lntiny */
else
/* exp(-big#) underflows to zero */
if(finite(x)) return(scalb(1.0,-5000));
/* exp(-INF) is zero */
else return(0.0);
}
/* end of x < lnhuge */
else
/* exp(INF) is INF, exp(+big#) overflows to INF */
return( finite(x) ? scalb(1.0,5000) : x);
}

122
gnu/glibc/glibc-1.03/math/bsd/common_source/exp__E.c Normal file
View File

@@ -0,0 +1,122 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)exp__E.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* exp__E(x,c)
* ASSUMPTION: c << x SO THAT fl(x+c)=x.
* (c is the correction term for x)
* exp__E RETURNS
*
* / exp(x+c) - 1 - x , 1E-19 < |x| < .3465736
* exp__E(x,c) = |
* \ 0 , |x| < 1E-19.
*
* DOUBLE PRECISION (IEEE 53 bits, VAX D FORMAT 56 BITS)
* KERNEL FUNCTION OF EXP, EXPM1, POW FUNCTIONS
* CODED IN C BY K.C. NG, 1/31/85;
* REVISED BY K.C. NG on 3/16/85, 4/16/85.
*
* Required system supported function:
* copysign(x,y)
*
* Method:
* 1. Rational approximation. Let r=x+c.
* Based on
* 2 * sinh(r/2)
* exp(r) - 1 = ---------------------- ,
* cosh(r/2) - sinh(r/2)
* exp__E(r) is computed using
* x*x (x/2)*W - ( Q - ( 2*P + x*P ) )
* --- + (c + x*[---------------------------------- + c ])
* 2 1 - W
* where P := p1*x^2 + p2*x^4,
* Q := q1*x^2 + q2*x^4 (for 56 bits precision, add q3*x^6)
* W := x/2-(Q-x*P),
*
* (See the listing below for the values of p1,p2,q1,q2,q3. The poly-
* nomials P and Q may be regarded as the approximations to sinh
* and cosh :
* sinh(r/2) = r/2 + r * P , cosh(r/2) = 1 + Q . )
*
* The coefficients were obtained by a special Remez algorithm.
*
* Approximation error:
*
* | exp(x) - 1 | 2**(-57), (IEEE double)
* | ------------ - (exp__E(x,0)+x)/x | <=
* | x | 2**(-69). (VAX D)
*
* 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 "mathimpl.h"
vc(p1, 1.5150724356786683059E-2 ,3abe,3d78,066a,67e1, -6, .F83ABE67E1066A)
vc(p2, 6.3112487873718332688E-5 ,5b42,3984,0173,48cd, -13, .845B4248CD0173)
vc(q1, 1.1363478204690669916E-1 ,b95a,3ee8,ec45,44a2, -3, .E8B95A44A2EC45)
vc(q2, 1.2624568129896839182E-3 ,7905,3ba5,f5e7,72e4, -9, .A5790572E4F5E7)
vc(q3, 1.5021856115869022674E-6 ,9eb4,36c9,c395,604a, -19, .C99EB4604AC395)
ic(p1, 1.3887401997267371720E-2, -7, 1.C70FF8B3CC2CF)
ic(p2, 3.3044019718331897649E-5, -15, 1.15317DF4526C4)
ic(q1, 1.1110813732786649355E-1, -4, 1.C719538248597)
ic(q2, 9.9176615021572857300E-4, -10, 1.03FC4CB8C98E8)
#ifdef vccast
#define p1 vccast(p1)
#define p2 vccast(p2)
#define q1 vccast(q1)
#define q2 vccast(q2)
#define q3 vccast(q3)
#endif
double exp__E(x,c)
double x,c;
{
const static double zero=0.0, one=1.0, half=1.0/2.0, small=1.0E-19;
double z,p,q,xp,xh,w;
if(copysign(x,one)>small) {
z = x*x ;
p = z*( p1 +z* p2 );
#if defined(vax)||defined(tahoe)
q = z*( q1 +z*( q2 +z* q3 ));
#else /* defined(vax)||defined(tahoe) */
q = z*( q1 +z* q2 );
#endif /* defined(vax)||defined(tahoe) */
xp= x*p ;
xh= x*half ;
w = xh-(q-xp) ;
p = p+p;
c += x*((xh*w-(q-(p+xp)))/(one-w)+c);
return(z*half+c);
}
/* end of |x| > small */
else {
if(x!=zero) one+small; /* raise the inexact flag */
return(copysign(zero,x));
}
}

126
gnu/glibc/glibc-1.03/math/bsd/common_source/floor.c Normal file
View File

@@ -0,0 +1,126 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)floor.c 5.7 (Berkeley) 10/9/90";
#endif /* not lint */
#include "mathimpl.h"
vc(L, 4503599627370496.0E0 ,0000,5c00,0000,0000, 55, 1.0) /* 2**55 */
ic(L, 4503599627370496.0E0, 52, 1.0) /* 2**52 */
#ifdef vccast
#define L vccast(L)
#endif
double ceil();
double floor();
/*
* floor(x) := the largest integer no larger than x;
* ceil(x) := -floor(-x), for all real x.
*
* Note: Inexact will be signaled if x is not an integer, as is
* customary for IEEE 754. No other signal can be emitted.
*/
double
floor(x)
double x;
{
double y;
if (
#if !defined(vax)&&!defined(tahoe)
x != x || /* NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
x >= L) /* already an even integer */
return x;
else if (x < (double)0)
return -ceil(-x);
else { /* now 0 <= x < L */
y = L+x; /* destructive store must be forced */
y -= L; /* an integer, and |x-y| < 1 */
return x < y ? y-(double)1 : y;
}
}
double
ceil(x)
double x;
{
double y;
if (
#if !defined(vax)&&!defined(tahoe)
x != x || /* NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
x >= L) /* already an even integer */
return x;
else if (x < (double)0)
return -floor(-x);
else { /* now 0 <= x < L */
y = L+x; /* destructive store must be forced */
y -= L; /* an integer, and |x-y| < 1 */
return x > y ? y+(double)1 : y;
}
}
#ifndef national /* rint() is in ./NATIONAL/support.s */
/*
* algorithm for rint(x) in pseudo-pascal form ...
*
* real rint(x): real x;
* ... delivers integer nearest x in direction of prevailing rounding
* ... mode
* const L = (last consecutive integer)/2
* = 2**55; for VAX D
* = 2**52; for IEEE 754 Double
* real s,t;
* begin
* if x != x then return x; ... NaN
* if |x| >= L then return x; ... already an integer
* s := copysign(L,x);
* t := x + s; ... = (x+s) rounded to integer
* return t - s
* end;
*
* Note: Inexact will be signaled if x is not an integer, as is
* customary for IEEE 754. No other signal can be emitted.
*/
double
__rint(x)
double x;
{
double s,t;
const double one = 1.0;
#if !defined(vax)&&!defined(tahoe)
if (x != x) /* NaN */
return (x);
#endif /* !defined(vax)&&!defined(tahoe) */
if (copysign(x,one) >= L) /* already an integer */
return (x);
s = copysign(L,x);
t = x + s; /* x+s rounded to integer */
return (t - s);
}
#endif /* not national */

143
gnu/glibc/glibc-1.03/math/bsd/common_source/fmod.c Normal file
View File

@@ -0,0 +1,143 @@
/*
* Copyright (c) 1989 The Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted
* provided that: (1) source distributions retain this entire copyright
* notice and comment, and (2) distributions including binaries display
* the following acknowledgement: ``This product includes software
* developed by the University of California, Berkeley and its contributors''
* in the documentation or other materials provided with the distribution
* and in all advertising materials mentioning features or use of this
* software. Neither the name of the University nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)fmod.c 5.2 (Berkeley) 6/1/90";
#endif /* not lint */
/* fmod.c
*
* SYNOPSIS
*
* #include <math.h>
* double fmod(double x, double y)
*
* DESCRIPTION
*
* The fmod function computes the floating-point remainder of x/y.
*
* RETURNS
*
* The fmod function returns the value x-i*y, for some integer i
* such that, if y is nonzero, the result has the same sign as x and
* magnitude less than the magnitude of y.
*
* On a VAX or CCI,
*
* fmod(x,0) traps/faults on floating-point divided-by-zero.
*
* On IEEE-754 conforming machines with "isnan()" primitive,
*
* fmod(x,0), fmod(INF,y) are invalid operations and NaN is returned.
*
*/
#include "mathimpl.h"
#if !defined(vax) && !defined(tahoe)
extern int isnan(),finite();
#endif /* !defined(vax) && !defined(tahoe) */
extern double frexp(),ldexp(),fabs();
#ifdef TEST_FMOD
static double
_fmod(x,y)
#else /* TEST_FMOD */
double
fmod(x,y)
#endif /* TEST_FMOD */
double x,y;
{
int ir,iy;
double r,w;
if (y == (double)0
#if !defined(vax) && !defined(tahoe) /* per "fmod" manual entry, SunOS 4.0 */
|| isnan(y) || !finite(x)
#endif /* !defined(vax) && !defined(tahoe) */
)
return (x*y)/(x*y);
r = fabs(x);
y = fabs(y);
(void)frexp(y,&iy);
while (r >= y) {
(void)frexp(r,&ir);
w = ldexp(y,ir-iy);
r -= w <= r ? w : w*(double)0.5;
}
return x >= (double)0 ? r : -r;
}
#ifdef TEST_FMOD
extern long random();
extern double fmod();
#define NTEST 10000
#define NCASES 3
static int nfail = 0;
static void
doit(x,y)
double x,y;
{
double ro = fmod(x,y),rn = _fmod(x,y);
if (ro != rn) {
(void)printf(" x = 0x%08.8x %08.8x (%24.16e)\n",x,x);
(void)printf(" y = 0x%08.8x %08.8x (%24.16e)\n",y,y);
(void)printf(" fmod = 0x%08.8x %08.8x (%24.16e)\n",ro,ro);
(void)printf("_fmod = 0x%08.8x %08.8x (%24.16e)\n",rn,rn);
(void)printf("\n");
}
}
main()
{
register int i,cases;
double x,y;
srandom(12345);
for (i = 0; i < NTEST; i++) {
x = (double)random();
y = (double)random();
for (cases = 0; cases < NCASES; cases++) {
switch (cases) {
case 0:
break;
case 1:
y = (double)1/y; break;
case 2:
x = (double)1/x; break;
default:
abort(); break;
}
doit(x,y);
doit(x,-y);
doit(-x,y);
doit(-x,-y);
}
}
if (nfail)
(void)printf("Number of failures: %d (out of a total of %d)\n",
nfail,NTEST*NCASES*4);
else
(void)printf("No discrepancies were found\n");
exit(0);
}
#endif /* TEST_FMOD */

149
gnu/glibc/glibc-1.03/math/bsd/common_source/log.c Normal file
View File

@@ -0,0 +1,149 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* LOG(X)
* RETURN THE LOGARITHM OF x
* DOUBLE PRECISION (VAX D FORMAT 56 bits or IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/7/85, 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* logb(x)
* finite(x)
*
* Required kernel function:
* log__L(z)
*
* Method :
* 1. Argument Reduction: find k and f such that
* x = 2^k * (1+f),
* where sqrt(2)/2 < 1+f < sqrt(2) .
*
* 2. 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 + .....,
* log(1+f) is computed by
*
* log(1+f) = 2s + s*log__L(s*s)
* where
* log__L(z) = z*(L1 + z*(L2 + z*(... (L6 + z*L7)...)))
*
* See log__L() for the values of the coefficients.
*
* 3. Finally, log(x) = k*ln2 + log(1+f). (Here n*ln2 will be stored
* in two floating point number: n*ln2hi + n*ln2lo, n*ln2hi is exact
* since the last 20 bits of ln2hi is 0.)
*
* 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:
* log(x) returns the exact log(x) nearly rounded. In a test run with
* 1,536,000 random arguments on a VAX, the maximum observed error was
* .826 ulps (units 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 <errno.h>
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(sqrt2, 1.4142135623730951455E0, 0, 1.6A09E667F3BCD)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define sqrt2 vccast(sqrt2)
#endif
double log(x)
double x;
{
const static double zero=0.0, negone= -1.0, half=1.0/2.0;
double s,z,t;
int k,n;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if(finite(x)) {
if( x > zero ) {
/* argument reduction */
k=logb(x); x=scalb(x,-k);
if(k == -1022) /* subnormal no. */
{n=logb(x); x=scalb(x,-n); k+=n;}
if(x >= sqrt2 ) {k += 1; x *= half;}
x += negone ;
/* compute log(1+x) */
s=x/(2+x); t=x*x*half;
z=k*ln2lo+s*(t+log__L(s*s));
x += (z - t) ;
return(k*ln2hi+x);
}
/* end of if (x > zero) */
else {
#if defined(vax)||defined(tahoe)
if ( x == zero )
return (infnan(-ERANGE)); /* -INF */
else
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
/* zero argument, return -INF with signal */
if ( x == zero )
return( negone/zero );
/* negative argument, return NaN with signal */
else
return ( zero / zero );
#endif /* defined(vax)||defined(tahoe) */
}
}
/* end of if (finite(x)) */
/* NOTREACHED if defined(vax)||defined(tahoe) */
/* log(-INF) is NaN with signal */
else if (x<0)
return(zero/zero);
/* log(+INF) is +INF */
else return(x);
}

81
gnu/glibc/glibc-1.03/math/bsd/common_source/log10.c Normal file
View File

@@ -0,0 +1,81 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log10.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* LOG10(X)
* RETURN THE BASE 10 LOGARITHM OF x
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/20/85;
* REVISED BY K.C. NG on 1/23/85, 3/7/85, 4/16/85.
*
* Required kernel function:
* log(x)
*
* Method :
* log(x)
* log10(x) = --------- or [1/log(10)]*log(x)
* log(10)
*
* Note:
* [log(10)] rounded to 56 bits has error .0895 ulps,
* [1/log(10)] rounded to 53 bits has error .198 ulps;
* therefore, for better accuracy, in VAX D format, we divide
* log(x) by log(10), but in IEEE Double format, we multiply
* log(x) by [1/log(10)].
*
* 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.
*
* Accuracy:
* log10(X) returns the exact log10(x) nearly rounded. In a test run
* with 1,536,000 random arguments on a VAX, the maximum observed
* error was 1.74 ulps (units 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 "mathimpl.h"
vc(ln10hi, 2.3025850929940456790E0 ,5d8d,4113,a8ac,ddaa, 2, .935D8DDDAAA8AC)
ic(ivln10, 4.3429448190325181667E-1, -2, 1.BCB7B1526E50E)
#ifdef vccast
#define ln10hi vccast(ln10hi)
#endif
double log10(x)
double x;
{
#if defined(vax)||defined(tahoe)
return(log(x)/ln10hi);
#else /* defined(vax)||defined(tahoe) */
return(ivln10*log(x));
#endif /* defined(vax)||defined(tahoe) */
}

156
gnu/glibc/glibc-1.03/math/bsd/common_source/log1p.c Normal file
View File

@@ -0,0 +1,156 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log1p.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* LOG1P(x)
* RETURN THE LOGARITHM OF 1+x
* DOUBLE PRECISION (VAX D FORMAT 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. NG on 2/6/85, 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions:
* scalb(x,n)
* copysign(x,y)
* logb(x)
* finite(x)
*
* Required kernel function:
* log__L(z)
*
* Method :
* 1. Argument Reduction: find k and f such that
* 1+x = 2^k * (1+f),
* where sqrt(2)/2 < 1+f < sqrt(2) .
*
* 2. 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 + .....,
* log(1+f) is computed by
*
* log(1+f) = 2s + s*log__L(s*s)
* where
* log__L(z) = z*(L1 + z*(L2 + z*(... (L6 + z*L7)...)))
*
* See log__L() for the values of the coefficients.
*
* 3. Finally, log(1+x) = k*ln2 + log(1+f).
*
* Remarks 1. In step 3 n*ln2 will be stored in two floating point numbers
* n*ln2hi + n*ln2lo, where ln2hi is chosen such that the last
* 20 bits (for VAX D format), or the last 21 bits ( for IEEE
* double) is 0. This ensures n*ln2hi is exactly representable.
* 2. In step 1, f may not be representable. A correction term c
* for f is computed. It follows that the correction term for
* f - t (the leading term of log(1+f) in step 2) is c-c*x. We
* add this correction term to n*ln2lo to attenuate the error.
*
*
* Special cases:
* log1p(x) is NaN with signal if x < -1; log1p(NaN) is NaN with no signal;
* log1p(INF) is +INF; log1p(-1) is -INF with signal;
* only log1p(0)=0 is exact for finite argument.
*
* Accuracy:
* log1p(x) returns the exact log(1+x) nearly rounded. In a test run
* with 1,536,000 random arguments on a VAX, the maximum observed
* error was .846 ulps (units 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 <errno.h>
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(sqrt2, 1.4142135623730951455E0, 0, 1.6A09E667F3BCD)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define sqrt2 vccast(sqrt2)
#endif
double log1p(x)
double x;
{
const static double zero=0.0, negone= -1.0, one=1.0,
half=1.0/2.0, small=1.0E-20; /* 1+small == 1 */
double z,s,t,c;
int k;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
if(finite(x)) {
if( x > negone ) {
/* argument reduction */
if(copysign(x,one)<small) return(x);
k=logb(one+x); z=scalb(x,-k); t=scalb(one,-k);
if(z+t >= sqrt2 )
{ k += 1 ; z *= half; t *= half; }
t += negone; x = z + t;
c = (t-x)+z ; /* correction term for x */
/* compute log(1+x) */
s = x/(2+x); t = x*x*half;
c += (k*ln2lo-c*x);
z = c+s*(t+log__L(s*s));
x += (z - t) ;
return(k*ln2hi+x);
}
/* end of if (x > negone) */
else {
#if defined(vax)||defined(tahoe)
if ( x == negone )
return (infnan(-ERANGE)); /* -INF */
else
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
/* x = -1, return -INF with signal */
if ( x == negone ) return( negone/zero );
/* negative argument for log, return NaN with signal */
else return ( zero / zero );
#endif /* defined(vax)||defined(tahoe) */
}
}
/* end of if (finite(x)) */
/* log(-INF) is NaN */
else if(x<0)
return(zero/zero);
/* log(+INF) is INF */
else return(x);
}

96
gnu/glibc/glibc-1.03/math/bsd/common_source/log__L.c Normal file
View File

@@ -0,0 +1,96 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)log__L.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* log__L(Z)
* LOG(1+X) - 2S X
* RETURN --------------- WHERE Z = S*S, S = ------- , 0 <= Z <= .0294...
* S 2 + X
*
* DOUBLE PRECISION (VAX D FORMAT 56 bits or IEEE DOUBLE 53 BITS)
* KERNEL FUNCTION FOR LOG; TO BE USED IN LOG1P, LOG, AND POW FUNCTIONS
* CODED IN C BY K.C. NG, 1/19/85;
* REVISED BY K.C. Ng, 2/3/85, 4/16/85.
*
* Method :
* 1. Polynomial approximation: let s = x/(2+x).
* Based on log(1+x) = log(1+s) - log(1-s)
* = 2s + 2/3 s**3 + 2/5 s**5 + .....,
*
* (log(1+x) - 2s)/s is computed by
*
* z*(L1 + z*(L2 + z*(... (L7 + z*L8)...)))
*
* where z=s*s. (See the listing below for Lk's values.) The
* coefficients are obtained by a special Remez algorithm.
*
* Accuracy:
* Assuming no rounding error, the maximum magnitude of the approximation
* error (absolute) is 2**(-58.49) for IEEE double, and 2**(-63.63)
* for VAX D format.
*
* 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 "mathimpl.h"
vc(L1, 6.6666666666666703212E-1 ,aaaa,402a,aac5,aaaa, 0, .AAAAAAAAAAAAC5)
vc(L2, 3.9999999999970461961E-1 ,cccc,3fcc,2684,cccc, -1, .CCCCCCCCCC2684)
vc(L3, 2.8571428579395698188E-1 ,4924,3f92,5782,92f8, -1, .92492492F85782)
vc(L4, 2.2222221233634724402E-1 ,8e38,3f63,af2c,39b7, -2, .E38E3839B7AF2C)
vc(L5, 1.8181879517064680057E-1 ,2eb4,3f3a,655e,cc39, -2, .BA2EB4CC39655E)
vc(L6, 1.5382888777946145467E-1 ,8551,3f1d,781d,e8c5, -2, .9D8551E8C5781D)
vc(L7, 1.3338356561139403517E-1 ,95b3,3f08,cd92,907f, -2, .8895B3907FCD92)
vc(L8, 1.2500000000000000000E-1 ,0000,3f00,0000,0000, -2, .80000000000000)
ic(L1, 6.6666666666667340202E-1, -1, 1.5555555555592)
ic(L2, 3.9999999999416702146E-1, -2, 1.999999997FF24)
ic(L3, 2.8571428742008753154E-1, -2, 1.24924941E07B4)
ic(L4, 2.2222198607186277597E-1, -3, 1.C71C52150BEA6)
ic(L5, 1.8183562745289935658E-1, -3, 1.74663CC94342F)
ic(L6, 1.5314087275331442206E-1, -3, 1.39A1EC014045B)
ic(L7, 1.4795612545334174692E-1, -3, 1.2F039F0085122)
#ifdef vccast
#define L1 vccast(L1)
#define L2 vccast(L2)
#define L3 vccast(L3)
#define L4 vccast(L4)
#define L5 vccast(L5)
#define L6 vccast(L6)
#define L7 vccast(L7)
#define L8 vccast(L8)
#endif
double log__L(z)
double z;
{
#if defined(vax)||defined(tahoe)
return(z*(L1+z*(L2+z*(L3+z*(L4+z*(L5+z*(L6+z*(L7+z*L8))))))));
#else /* defined(vax)||defined(tahoe) */
return(z*(L1+z*(L2+z*(L3+z*(L4+z*(L5+z*(L6+z*L7)))))));
#endif /* defined(vax)||defined(tahoe) */
}

116
gnu/glibc/glibc-1.03/math/bsd/common_source/mathimpl.h Normal file
View File

@@ -0,0 +1,116 @@
/*
* Copyright (c) 1988 The Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*
* @(#)mathimpl.h 5.3 (Berkeley) 10/9/90
*/
#include <math.h>
#include <endian.h>
#ifdef __LITTLE_ENDIAN
#undef national
#define national
#endif
#undef isinf
#define isinf __isinf
#undef isnan
#define isnan __isnan
#undef infnan
#define infnan __infnan
#undef copysign
#define copysign __copysign
#undef scalb
#define scalb __scalb
#undef drem
#define drem __drem
#undef logb
#define logb __logb
#undef __finite
#undef finite
#define finite __finite
#undef expm1
#define expm1 __expm1
#define exp__E __exp__E
#define log__L __log__L
#ifdef __STDC__
#define const const
#else
#define const /**/
#endif
#if defined(vax)||defined(tahoe)
/* Deal with different ways to concatenate in cpp */
# ifdef __STDC__
# define cat3(a,b,c) a ## b ## c
# else
# define cat3(a,b,c) a/**/b/**/c
# endif
/* Deal with vax/tahoe byte order issues */
# ifdef vax
# define cat3t(a,b,c) cat3(a,b,c)
# else
# define cat3t(a,b,c) cat3(a,c,b)
# endif
# define vccast(name) (*(const double *)(cat3(name,,x)))
/*
* Define a constant to high precision on a Vax or Tahoe.
*
* Args are the name to define, the decimal floating point value,
* four 16-bit chunks of the float value in hex
* (because the vax and tahoe differ in float format!), the power
* of 2 of the hex-float exponent, and the hex-float mantissa.
* Most of these arguments are not used at compile time; they are
* used in a post-check to make sure the constants were compiled
* correctly.
*
* People who want to use the constant will have to do their own
* #define foo vccast(foo)
* since CPP cannot do this for them from inside another macro (sigh).
* We define "vccast" if this needs doing.
*/
# define vc(name, value, x1,x2,x3,x4, bexp, xval) \
const static long cat3(name,,x)[] = {cat3t(0x,x1,x2), cat3t(0x,x3,x4)};
# define ic(name, value, bexp, xval) ;
#else /* vax or tahoe */
/* Hooray, we have an IEEE machine */
# undef vccast
# define vc(name, value, x1,x2,x3,x4, bexp, xval) ;
# define ic(name, value, bexp, xval) \
const static double name = value;
#endif /* defined(vax)||defined(tahoe) */
/*
* Functions internal to the math package, yet not static.
*/
extern double exp__E();
extern double log__L();

236
gnu/glibc/glibc-1.03/math/bsd/common_source/pow.c Normal file
View File

@@ -0,0 +1,236 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)pow.c 5.7 (Berkeley) 10/9/90";
#endif /* not lint */
/* POW(X,Y)
* RETURN X**Y
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 7/10/85.
*
* Required system supported functions:
* scalb(x,n)
* logb(x)
* copysign(x,y)
* finite(x)
* drem(x,y)
*
* Required kernel functions:
* exp__E(a,c) ...return exp(a+c) - 1 - a*a/2
* log__L(x) ...return (log(1+x) - 2s)/s, s=x/(2+x)
* pow_p(x,y) ...return +(anything)**(finite non zero)
*
* Method
* 1. Compute and return log(x) in three pieces:
* log(x) = n*ln2 + hi + lo,
* where n is an integer.
* 2. Perform y*log(x) by simulating muti-precision arithmetic and
* return the answer in three pieces:
* y*log(x) = m*ln2 + hi + lo,
* where m is an integer.
* 3. Return x**y = exp(y*log(x))
* = 2^m * ( exp(hi+lo) ).
*
* Special cases:
* (anything) ** 0 is 1 ;
* (anything) ** 1 is itself;
* (anything) ** NaN is NaN;
* NaN ** (anything except 0) is NaN;
* +-(anything > 1) ** +INF is +INF;
* +-(anything > 1) ** -INF is +0;
* +-(anything < 1) ** +INF is +0;
* +-(anything < 1) ** -INF is +INF;
* +-1 ** +-INF is NaN and signal INVALID;
* +0 ** +(anything except 0, NaN) is +0;
* -0 ** +(anything except 0, NaN, odd integer) is +0;
* +0 ** -(anything except 0, NaN) is +INF and signal DIV-BY-ZERO;
* -0 ** -(anything except 0, NaN, odd integer) is +INF with signal;
* -0 ** (odd integer) = -( +0 ** (odd integer) );
* +INF ** +(anything except 0,NaN) is +INF;
* +INF ** -(anything except 0,NaN) is +0;
* -INF ** (odd integer) = -( +INF ** (odd integer) );
* -INF ** (even integer) = ( +INF ** (even integer) );
* -INF ** -(anything except integer,NaN) is NaN with signal;
* -(x=anything) ** (k=integer) is (-1)**k * (x ** k);
* -(anything except 0) ** (non-integer) is NaN with signal;
*
* Accuracy:
* pow(x,y) returns x**y nearly rounded. In particular, on a SUN, a VAX,
* and a Zilog Z8000,
* pow(integer,integer)
* always returns the correct integer provided it is representable.
* In a test run with 100,000 random arguments with 0 < x, y < 20.0
* on a VAX, the maximum observed error was 1.79 ulps (units 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 <errno.h>
#include "mathimpl.h"
vc(ln2hi, 6.9314718055829871446E-1 ,7217,4031,0000,f7d0, 0, .B17217F7D00000)
vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
vc(invln2, 1.4426950408889634148E0 ,aa3b,40b8,17f1,295c, 1, .B8AA3B295C17F1)
vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65)
ic(ln2hi, 6.9314718036912381649E-1, -1, 1.62E42FEE00000)
ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
ic(invln2, 1.4426950408889633870E0, 0, 1.71547652B82FE)
ic(sqrt2, 1.4142135623730951455E0, 0, 1.6A09E667F3BCD)
#ifdef vccast
#define ln2hi vccast(ln2hi)
#define ln2lo vccast(ln2lo)
#define invln2 vccast(invln2)
#define sqrt2 vccast(sqrt2)
#endif
const static double zero=0.0, half=1.0/2.0, one=1.0, two=2.0, negone= -1.0;
static double pow_p();
double pow(x,y)
double x,y;
{
double t;
if (y==zero) return(one);
else if(y==one
#if !defined(vax)&&!defined(tahoe)
||x!=x
#endif /* !defined(vax)&&!defined(tahoe) */
) return( x ); /* if x is NaN or y=1 */
#if !defined(vax)&&!defined(tahoe)
else if(y!=y) return( y ); /* if y is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
else if(!finite(y)) /* if y is INF */
if((t=copysign(x,one))==one) return(zero/zero);
else if(t>one) return((y>zero)?y:zero);
else return((y<zero)?-y:zero);
else if(y==two) return(x*x);
else if(y==negone) return(one/x);
/* sign(x) = 1 */
else if(copysign(one,x)==one) return(pow_p(x,y));
/* sign(x)= -1 */
/* if y is an even integer */
else if ( (t=drem(y,two)) == zero) return( pow_p(-x,y) );
/* if y is an odd integer */
else if (copysign(t,one) == one) return( -pow_p(-x,y) );
/* Henceforth y is not an integer */
else if(x==zero) /* x is -0 */
return((y>zero)?-x:one/(-x));
else { /* return NaN */
#if defined(vax)||defined(tahoe)
return (infnan(EDOM)); /* NaN */
#else /* defined(vax)||defined(tahoe) */
return(zero/zero);
#endif /* defined(vax)||defined(tahoe) */
}
}
#ifndef mc68881
/* pow_p(x,y) return x**y for x with sign=1 and finite y */
static double pow_p(x,y)
double x,y;
{
double c,s,t,z,tx,ty;
#ifdef tahoe
double tahoe_tmp;
#endif /* tahoe */
float sx,sy;
long k=0;
int n,m;
if(x==zero||!finite(x)) { /* if x is +INF or +0 */
#if defined(vax)||defined(tahoe)
return((y>zero)?x:infnan(ERANGE)); /* if y<zero, return +INF */
#else /* defined(vax)||defined(tahoe) */
return((y>zero)?x:one/x);
#endif /* defined(vax)||defined(tahoe) */
}
if(x==1.0) return(x); /* if x=1.0, return 1 since y is finite */
/* reduce x to z in [sqrt(1/2)-1, sqrt(2)-1] */
z=scalb(x,-(n=logb(x)));
#if !defined(vax)&&!defined(tahoe) /* IEEE double; subnormal number */
if(n <= -1022) {n += (m=logb(z)); z=scalb(z,-m);}
#endif /* !defined(vax)&&!defined(tahoe) */
if(z >= sqrt2 ) {n += 1; z *= half;} z -= one ;
/* log(x) = nlog2+log(1+z) ~ nlog2 + t + tx */
s=z/(two+z); c=z*z*half; tx=s*(c+log__L(s*s));
t= z-(c-tx); tx += (z-t)-c;
/* if y*log(x) is neither too big nor too small */
if((s=logb(y)+logb(n+t)) < 12.0)
if(s>-60.0) {
/* compute y*log(x) ~ mlog2 + t + c */
s=y*(n+invln2*t);
m=s+copysign(half,s); /* m := nint(y*log(x)) */
k=y;
if((double)k==y) { /* if y is an integer */
k = m-k*n;
sx=t; tx+=(t-sx); }
else { /* if y is not an integer */
k =m;
tx+=n*ln2lo;
sx=(c=n*ln2hi)+t; tx+=(c-sx)+t; }
/* end of checking whether k==y */
sy=y; ty=y-sy; /* y ~ sy + ty */
#ifdef tahoe
s = (tahoe_tmp = sx)*sy-k*ln2hi;
#else /* tahoe */
s=(double)sx*sy-k*ln2hi; /* (sy+ty)*(sx+tx)-kln2 */
#endif /* tahoe */
z=(tx*ty-k*ln2lo);
tx=tx*sy; ty=sx*ty;
t=ty+z; t+=tx; t+=s;
c= -((((t-s)-tx)-ty)-z);
/* return exp(y*log(x)) */
t += exp__E(t,c); return(scalb(one+t,m));
}
/* end of if log(y*log(x)) > -60.0 */
else
/* exp(+- tiny) = 1 with inexact flag */
{ln2hi+ln2lo; return(one);}
else if(copysign(one,y)*(n+invln2*t) <zero)
/* exp(-(big#)) underflows to zero */
return(scalb(one,-5000));
else
/* exp(+(big#)) overflows to INF */
return(scalb(one, 5000));
}
#endif /* mc68881 */

107
gnu/glibc/glibc-1.03/math/bsd/common_source/sinh.c Normal file
View File

@@ -0,0 +1,107 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)sinh.c 5.6 (Berkeley) 10/9/90";
#endif /* not lint */
/* SINH(X)
* RETURN THE HYPERBOLIC SINE OF X
* DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 3/7/85, 3/24/85, 4/16/85.
*
* Required system supported functions :
* copysign(x,y)
* scalb(x,N)
*
* Required kernel functions:
* expm1(x) ...return exp(x)-1
*
* Method :
* 1. reduce x to non-negative by sinh(-x) = - sinh(x).
* 2.
*
* expm1(x) + expm1(x)/(expm1(x)+1)
* 0 <= x <= lnovfl : sinh(x) := --------------------------------
* 2
* lnovfl <= x <= lnovfl+ln2 : sinh(x) := expm1(x)/2 (avoid overflow)
* lnovfl+ln2 < x < INF : overflow to INF
*
*
* Special cases:
* sinh(x) is x if x is +INF, -INF, or NaN.
* only sinh(0)=0 is exact for finite argument.
*
* Accuracy:
* sinh(x) returns the exact hyperbolic sine of x nearly rounded. In
* a test run with 1,024,000 random arguments on a VAX, the maximum
* observed error was 1.93 ulps (units 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 "mathimpl.h"
vc(mln2hi, 8.8029691931113054792E1 ,0f33,43b0,2bdb,c7e2, 7, .B00F33C7E22BDB)
vc(mln2lo,-4.9650192275318476525E-16 ,1b60,a70f,582a,279e, -50,-.8F1B60279E582A)
vc(lnovfl, 8.8029691931113053016E1 ,0f33,43b0,2bda,c7e2, 7, .B00F33C7E22BDA)
ic(mln2hi, 7.0978271289338397310E2, 10, 1.62E42FEFA39EF)
ic(mln2lo, 2.3747039373786107478E-14, -45, 1.ABC9E3B39803F)
ic(lnovfl, 7.0978271289338397310E2, 9, 1.62E42FEFA39EF)
#ifdef vccast
#define mln2hi vccast(mln2hi)
#define mln2lo vccast(mln2lo)
#define lnovfl vccast(lnovfl)
#endif
#if defined(vax)||defined(tahoe)
static max = 126 ;
#else /* defined(vax)||defined(tahoe) */
static max = 1023 ;
#endif /* defined(vax)||defined(tahoe) */
double sinh(x)
double x;
{
static const double one=1.0, half=1.0/2.0 ;
double t, sign;
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
sign=copysign(one,x);
x=copysign(x,one);
if(x<lnovfl)
{t=expm1(x); return(copysign((t+t/(one+t))*half,sign));}
else if(x <= lnovfl+0.7)
/* subtract x by ln(2^(max+1)) and return 2^max*exp(x)
to avoid unnecessary overflow */
return(copysign(scalb(one+expm1((x-mln2hi)-mln2lo),max),sign));
else /* sinh(+-INF) = +-INF, sinh(+-big no.) overflow to +-INF */
return( expm1(x)*sign );
}

87
gnu/glibc/glibc-1.03/math/bsd/common_source/tanh.c Normal file
View File

@@ -0,0 +1,87 @@
/*
* Copyright (c) 1985 Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms are permitted provided
* that: (1) source distributions retain this entire copyright notice and
* comment, and (2) distributions including binaries display the following
* acknowledgement: ``This product includes software developed by the
* University of California, Berkeley and its contributors'' in the
* documentation or other materials provided with the distribution and in
* all advertising materials mentioning features or use of this software.
* Neither the name of the University nor the names of its contributors may
* be used to endorse or promote products derived from this software without
* specific prior written permission.
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
#ifndef lint
static char sccsid[] = "@(#)tanh.c 5.5 (Berkeley) 10/9/90";
#endif /* not lint */
/* TANH(X)
* RETURN THE HYPERBOLIC TANGENT OF X
* DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 2/11/85, 3/7/85, 3/24/85.
*
* Required system supported functions :
* copysign(x,y)
* finite(x)
*
* Required kernel function:
* expm1(x) ...exp(x)-1
*
* Method :
* 1. reduce x to non-negative by tanh(-x) = - tanh(x).
* 2.
* 0 < x <= 1.e-10 : tanh(x) := x
* -expm1(-2x)
* 1.e-10 < x <= 1 : tanh(x) := --------------
* expm1(-2x) + 2
* 2
* 1 <= x <= 22.0 : tanh(x) := 1 - ---------------
* expm1(2x) + 2
* 22.0 < x <= INF : tanh(x) := 1.
*
* Note: 22 was chosen so that fl(1.0+2/(expm1(2*22)+2)) == 1.
*
* Special cases:
* tanh(NaN) is NaN;
* only tanh(0)=0 is exact for finite argument.
*
* Accuracy:
* tanh(x) returns the exact hyperbolic tangent of x nealy rounded.
* In a test run with 1,024,000 random arguments on a VAX, the maximum
* observed error was 2.22 ulps (units in the last place).
*/
#include "mathimpl.h"
double tanh(x)
double x;
{
static double one=1.0, two=2.0, small = 1.0e-10, big = 1.0e10;
double expm1(), t, copysign(), sign;
int finite();
#if !defined(vax)&&!defined(tahoe)
if(x!=x) return(x); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
sign=copysign(one,x);
x=copysign(x,one);
if(x < 22.0)
if( x > one )
return(copysign(one-two/(expm1(x+x)+two),sign));
else if ( x > small )
{t= -expm1(-(x+x)); return(copysign(t/(two-t),sign));}
else /* raise the INEXACT flag for non-zero x */
{big+x; return(copysign(x,sign));}
else if(finite(x))
return (sign+1.0E-37); /* raise the INEXACT flag */
else
return(sign); /* x is +- INF */
}