[unix-history] / usr / src / lib / libm / common_source / exp.c

/* 
 * Copyright (c) 1985 Regents of the University of California.
 * 
 * Use and reproduction of this software are granted  in  accordance  with
 * the terms and conditions specified in  the  Berkeley  Software  License
 * Agreement (in particular, this entails acknowledgement of the programs'
 * source, and inclusion of this notice) with the additional understanding
 * that  all  recipients  should regard themselves as participants  in  an
 * ongoing  research  project and hence should  feel  obligated  to report
 * their  experiences (good or bad) with these elementary function  codes,
 * using "sendbug 4bsd-bugs@BERKELEY", to the authors.
 */

#ifndef lint
static char sccsid[] =
"@(#)exp.c	4.3 (Berkeley) 8/21/85; 1.6 (ucb.elefunt) %G%";
#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.
 */

#if (defined(VAX)||defined(TAHOE))	/* VAX D format */
/* static double */
/* ln2hi  =  6.9314718055829871446E-1    , Hex  2^  0   *  .B17217F7D00000 */
/* ln2lo  =  1.6465949582897081279E-12   , Hex  2^-39   *  .E7BCD5E4F1D9CC */
/* lnhuge =  9.4961163736712506989E1     , Hex  2^  7   *  .BDEC1DA73E9010 */
/* lntiny = -9.5654310917272452386E1     , Hex  2^  7   * -.BF4F01D72E33AF */
/* invln2 =  1.4426950408889634148E0     ; Hex  2^  1   *  .B8AA3B295C17F1 */
/* p1     =  1.6666666666666602251E-1    , Hex  2^-2    *  .AAAAAAAAAAA9F1 */
/* p2     = -2.7777777777015591216E-3    , Hex  2^-8    * -.B60B60B5F5EC94 */
/* p3     =  6.6137563214379341918E-5    , Hex  2^-13   *  .8AB355792EF15F */
/* p4     = -1.6533902205465250480E-6    , Hex  2^-19   * -.DDEA0E2E935F84 */
/* p5     =  4.1381367970572387085E-8    , Hex  2^-24   *  .B1BB4B95F52683 */
static long     ln2hix[] = { 0x72174031, 0x0000f7d0};
static long     ln2lox[] = { 0xbcd52ce7, 0xd9cce4f1};
static long    lnhugex[] = { 0xec1d43bd, 0x9010a73e};
static long    lntinyx[] = { 0x4f01c3bf, 0x33afd72e};
static long    invln2x[] = { 0xaa3b40b8, 0x17f1295c};
static long        p1x[] = { 0xaaaa3f2a, 0xa9f1aaaa};
static long        p2x[] = { 0x0b60bc36, 0xec94b5f5};
static long        p3x[] = { 0xb355398a, 0xf15f792e};
static long        p4x[] = { 0xea0eb6dd, 0x5f842e93};
static long        p5x[] = { 0xbb4b3431, 0x268395f5};
#define    ln2hi    (*(double*)ln2hix)
#define    ln2lo    (*(double*)ln2lox)
#define   lnhuge    (*(double*)lnhugex)
#define   lntiny    (*(double*)lntinyx)
#define   invln2    (*(double*)invln2x)
#define       p1    (*(double*)p1x)
#define       p2    (*(double*)p2x)
#define       p3    (*(double*)p3x)
#define       p4    (*(double*)p4x)
#define       p5    (*(double*)p5x)

#else	/* IEEE double */
static double
p1     =  1.6666666666666601904E-1    , /*Hex  2^-3    *  1.555555555553E */
p2     = -2.7777777777015593384E-3    , /*Hex  2^-9    * -1.6C16C16BEBD93 */
p3     =  6.6137563214379343612E-5    , /*Hex  2^-14   *  1.1566AAF25DE2C */
p4     = -1.6533902205465251539E-6    , /*Hex  2^-20   * -1.BBD41C5D26BF1 */
p5     =  4.1381367970572384604E-8    , /*Hex  2^-25   *  1.6376972BEA4D0 */
ln2hi  =  6.9314718036912381649E-1    , /*Hex  2^ -1   *  1.62E42FEE00000 */
ln2lo  =  1.9082149292705877000E-10   , /*Hex  2^-33   *  1.A39EF35793C76 */
lnhuge =  7.1602103751842355450E2     , /*Hex  2^  9   *  1.6602B15B7ECF2 */
lntiny = -7.5137154372698068983E2     , /*Hex  2^  9   * -1.77AF8EBEAE354 */
invln2 =  1.4426950408889633870E0     ; /*Hex  2^  0   *  1.71547652B82FE */
#endif

double exp(x)
double x;
{
	double scalb(), copysign(), z,hi,lo,c;
	int k,finite();

#if (!defined(VAX)&&!defined(TAHOE))
	if(x!=x) return(x);	/* x is NaN */
#endif
	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);
}
Commit	Line	Data
f28ff572 ZAL	1	/*
	2	* Copyright (c) 1985 Regents of the University of California.
	3	*
	4	* Use and reproduction of this software are granted in accordance with
	5	* the terms and conditions specified in the Berkeley Software License
	6	* Agreement (in particular, this entails acknowledgement of the programs'
	7	* source, and inclusion of this notice) with the additional understanding
	8	* that all recipients should regard themselves as participants in an
	9	* ongoing research project and hence should feel obligated to report
	10	* their experiences (good or bad) with these elementary function codes,
	11	* using "sendbug 4bsd-bugs@BERKELEY", to the authors.
	12	*/
	13
	14	#ifndef lint
a62df508	15	static char sccsid[] =
e0085737	16	"@(#)exp.c 4.3 (Berkeley) 8/21/85; 1.6 (ucb.elefunt) %G%";
f28ff572 ZAL	17	#endif not lint
	18
	19	/* EXP(X)
	20	* RETURN THE EXPONENTIAL OF X
	21	* DOUBLE PRECISION (IEEE 53 bits, VAX D FORMAT 56 BITS)
	22	* CODED IN C BY K.C. NG, 1/19/85;
3569b77e	23	* REVISED BY K.C. NG on 2/6/85, 2/15/85, 3/7/85, 3/24/85, 4/16/85, 6/14/86.
f28ff572 ZAL	24	*
	25	* Required system supported functions:
	26	* scalb(x,n)
	27	* copysign(x,y)
	28	* finite(x)
	29	*
f28ff572 ZAL	30	* Method:
	31	* 1. Argument Reduction: given the input x, find r and integer k such
	32	* that
	33	* x = kln2 + r, \|r\| <= 0.5ln2 .
	34	* r will be represented as r := z+c for better accuracy.
	35	*
3569b77e	36	* 2. Compute exp(r) by
f28ff572	37	*
3569b77e GK	38	* exp(r) = 1 + r + r*R1/(2-R1),
	39	* where
	40	* R1 = x - x^2(p1+x^2(p2+x^2(p3+x^2(p4+p5*x^2)))).
f28ff572	41	*
3569b77e	42	* 3. exp(x) = 2^k * exp(r) .
f28ff572 ZAL	43	*
	44	* Special cases:
	45	* exp(INF) is INF, exp(NaN) is NaN;
	46	* exp(-INF)= 0;
	47	* for finite argument, only exp(0)=1 is exact.
	48	*
	49	* Accuracy:
	50	* exp(x) returns the exponential of x nearly rounded. In a test run
	51	* with 1,156,000 random arguments on a VAX, the maximum observed
3569b77e	52	* error was 0.869 ulps (units in the last place).
f28ff572 ZAL	53	*
	54	* Constants:
	55	* The hexadecimal values are the intended ones for the following constants.
	56	* The decimal values may be used, provided that the compiler will convert
	57	* from decimal to binary accurately enough to produce the hexadecimal values
	58	* shown.
	59	*/
	60
e0085737	61	#if (defined(VAX)\|\|defined(TAHOE)) /* VAX D format */
62b65e15	62	/* static double */
f28ff572 ZAL	63	/* ln2hi = 6.9314718055829871446E-1 , Hex 2^ 0 * .B17217F7D00000 */
	64	/* ln2lo = 1.6465949582897081279E-12 , Hex 2^-39 * .E7BCD5E4F1D9CC */
	65	/* lnhuge = 9.4961163736712506989E1 , Hex 2^ 7 * .BDEC1DA73E9010 */
	66	/* lntiny = -9.5654310917272452386E1 , Hex 2^ 7 * -.BF4F01D72E33AF */
	67	/* invln2 = 1.4426950408889634148E0 ; Hex 2^ 1 * .B8AA3B295C17F1 */
3569b77e GK	68	/* p1 = 1.6666666666666602251E-1 , Hex 2^-2 * .AAAAAAAAAAA9F1 */
	69	/* p2 = -2.7777777777015591216E-3 , Hex 2^-8 * -.B60B60B5F5EC94 */
	70	/* p3 = 6.6137563214379341918E-5 , Hex 2^-13 * .8AB355792EF15F */
	71	/* p4 = -1.6533902205465250480E-6 , Hex 2^-19 * -.DDEA0E2E935F84 */
	72	/* p5 = 4.1381367970572387085E-8 , Hex 2^-24 * .B1BB4B95F52683 */
f28ff572 ZAL	73	static long ln2hix[] = { 0x72174031, 0x0000f7d0};
	74	static long ln2lox[] = { 0xbcd52ce7, 0xd9cce4f1};
	75	static long lnhugex[] = { 0xec1d43bd, 0x9010a73e};
	76	static long lntinyx[] = { 0x4f01c3bf, 0x33afd72e};
	77	static long invln2x[] = { 0xaa3b40b8, 0x17f1295c};
3569b77e GK	78	static long p1x[] = { 0xaaaa3f2a, 0xa9f1aaaa};
	79	static long p2x[] = { 0x0b60bc36, 0xec94b5f5};
	80	static long p3x[] = { 0xb355398a, 0xf15f792e};
	81	static long p4x[] = { 0xea0eb6dd, 0x5f842e93};
	82	static long p5x[] = { 0xbb4b3431, 0x268395f5};
f28ff572 ZAL	83	#define ln2hi ((double)ln2hix)
	84	#define ln2lo ((double)ln2lox)
	85	#define lnhuge ((double)lnhugex)
	86	#define lntiny ((double)lntinyx)
	87	#define invln2 ((double)invln2x)
3569b77e GK	88	#define p1 ((double)p1x)
	89	#define p2 ((double)p2x)
	90	#define p3 ((double)p3x)
	91	#define p4 ((double)p4x)
	92	#define p5 ((double)p5x)
	93
f28ff572	94	#else /* IEEE double */
62b65e15	95	static double
3569b77e GK	96	p1 = 1.6666666666666601904E-1 , /Hex 2^-3 1.555555555553E */
	97	p2 = -2.7777777777015593384E-3 , /Hex 2^-9 -1.6C16C16BEBD93 */
	98	p3 = 6.6137563214379343612E-5 , /Hex 2^-14 1.1566AAF25DE2C */
	99	p4 = -1.6533902205465251539E-6 , /Hex 2^-20 -1.BBD41C5D26BF1 */
	100	p5 = 4.1381367970572384604E-8 , /Hex 2^-25 1.6376972BEA4D0 */
f28ff572 ZAL	101	ln2hi = 6.9314718036912381649E-1 , /Hex 2^ -1 1.62E42FEE00000 */
	102	ln2lo = 1.9082149292705877000E-10 , /Hex 2^-33 1.A39EF35793C76 */
	103	lnhuge = 7.1602103751842355450E2 , /Hex 2^ 9 1.6602B15B7ECF2 */
	104	lntiny = -7.5137154372698068983E2 , /Hex 2^ 9 -1.77AF8EBEAE354 */
	105	invln2 = 1.4426950408889633870E0 ; /Hex 2^ 0 1.71547652B82FE */
	106	#endif
	107
	108	double exp(x)
	109	double x;
	110	{
3569b77e	111	double scalb(), copysign(), z,hi,lo,c;
f28ff572 ZAL	112	int k,finite();
f28ff572 ZAL	113
e0085737	114	#if (!defined(VAX)&&!defined(TAHOE))
f28ff572 ZAL	115	if(x!=x) return(x); /* x is NaN */
	116	#endif
	117	if( x <= lnhuge ) {
	118	if( x >= lntiny ) {
	119
	120	/* argument reduction : x --> x - kln2 /
	121
	122	k=invln2x+copysign(0.5,x); / k=NINT(x/ln2) */
	123
3569b77e GK	124	/* express x-kln2 as hi-lo and let x=hi-lo rounded /
3569b77e GK	125
f28ff572	126	hi=x-k*ln2hi;
3569b77e GK	127	x=hi-(lo=k*ln2lo);
	128
	129	/* return 2^k[1+x+xc/(2+c)] */
	130	z=x*x;
	131	c= x - z(p1+z(p2+z(p3+z(p4+z*p5))));
ee288af7	132	return scalb(1.0+(hi-(lo-(x*c)/(2.0-c))),k);
f28ff572	133
f28ff572 ZAL	134	}
	135	/* end of x > lntiny */
	136
	137	else
	138	/* exp(-big#) underflows to zero */
	139	if(finite(x)) return(scalb(1.0,-5000));
	140
	141	/* exp(-INF) is zero */
	142	else return(0.0);
	143	}
	144	/* end of x < lnhuge */
	145
	146	else
	147	/* exp(INF) is INF, exp(+big#) overflows to INF */
	148	return( finite(x) ? scalb(1.0,5000) : x);
	149	}