xref: /csrg-svn/lib/libm/common_source/pow.c (revision 56954)
134126Sbostic /*
224605Szliu  * Copyright (c) 1985 Regents of the University of California.
334126Sbostic  * All rights reserved.
434126Sbostic  *
542657Sbostic  * %sccs.include.redist.c%
624605Szliu  */
724605Szliu 
824605Szliu #ifndef lint
9*56954Sbostic static char sccsid[] = "@(#)pow.c	5.8 (Berkeley) 12/02/92";
1034126Sbostic #endif /* not lint */
1124605Szliu 
1224605Szliu /* POW(X,Y)
1324605Szliu  * RETURN X**Y
1424605Szliu  * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
1524605Szliu  * CODED IN C BY K.C. NG, 1/8/85;
1624605Szliu  * REVISED BY K.C. NG on 7/10/85.
17*56954Sbostic  * KERNEL pow_P() REPLACED BY P. McILROY 7/22/92.
1824605Szliu  * Required system supported functions:
1924605Szliu  *      scalb(x,n)
2024605Szliu  *      logb(x)
2124605Szliu  *	copysign(x,y)
2224605Szliu  *	finite(x)
2324605Szliu  *	drem(x,y)
2424605Szliu  *
2524605Szliu  * Required kernel functions:
26*56954Sbostic  *	exp__D(a,c)			exp(a + c) for |a| << |c|
27*56954Sbostic  *	struct d_double dlog(x)		r.a + r.b, |r.b| < |r.a|
2824605Szliu  *
2924605Szliu  * Method
3024605Szliu  *	1. Compute and return log(x) in three pieces:
3124605Szliu  *		log(x) = n*ln2 + hi + lo,
3224605Szliu  *	   where n is an integer.
3324605Szliu  *	2. Perform y*log(x) by simulating muti-precision arithmetic and
3424605Szliu  *	   return the answer in three pieces:
3524605Szliu  *		y*log(x) = m*ln2 + hi + lo,
3624605Szliu  *	   where m is an integer.
3724605Szliu  *	3. Return x**y = exp(y*log(x))
3824605Szliu  *		= 2^m * ( exp(hi+lo) ).
3924605Szliu  *
4024605Szliu  * Special cases:
4124605Szliu  *	(anything) ** 0  is 1 ;
4224605Szliu  *	(anything) ** 1  is itself;
4324605Szliu  *	(anything) ** NaN is NaN;
4424605Szliu  *	NaN ** (anything except 0) is NaN;
45*56954Sbostic  *	+(anything > 1) ** +INF is +INF;
46*56954Sbostic  *	-(anything > 1) ** +INF is NaN;
4724605Szliu  *	+-(anything > 1) ** -INF is +0;
4824605Szliu  *	+-(anything < 1) ** +INF is +0;
49*56954Sbostic  *	+(anything < 1) ** -INF is +INF;
50*56954Sbostic  *	-(anything < 1) ** -INF is NaN;
5124605Szliu  *	+-1 ** +-INF is NaN and signal INVALID;
5224605Szliu  *	+0 ** +(anything except 0, NaN)  is +0;
5324605Szliu  *	-0 ** +(anything except 0, NaN, odd integer)  is +0;
5424605Szliu  *	+0 ** -(anything except 0, NaN)  is +INF and signal DIV-BY-ZERO;
5524605Szliu  *	-0 ** -(anything except 0, NaN, odd integer)  is +INF with signal;
5624605Szliu  *	-0 ** (odd integer) = -( +0 ** (odd integer) );
5724605Szliu  *	+INF ** +(anything except 0,NaN) is +INF;
5824605Szliu  *	+INF ** -(anything except 0,NaN) is +0;
5924605Szliu  *	-INF ** (odd integer) = -( +INF ** (odd integer) );
6024605Szliu  *	-INF ** (even integer) = ( +INF ** (even integer) );
6124605Szliu  *	-INF ** -(anything except integer,NaN) is NaN with signal;
6224605Szliu  *	-(x=anything) ** (k=integer) is (-1)**k * (x ** k);
6324605Szliu  *	-(anything except 0) ** (non-integer) is NaN with signal;
6424605Szliu  *
6524605Szliu  * Accuracy:
6624605Szliu  *	pow(x,y) returns x**y nearly rounded. In particular, on a SUN, a VAX,
6724605Szliu  *	and a Zilog Z8000,
6824605Szliu  *			pow(integer,integer)
6924605Szliu  *	always returns the correct integer provided it is representable.
7024605Szliu  *	In a test run with 100,000 random arguments with 0 < x, y < 20.0
7124605Szliu  *	on a VAX, the maximum observed error was 1.79 ulps (units in the
7224605Szliu  *	last place).
7324605Szliu  *
7424605Szliu  * Constants :
7524605Szliu  * The hexadecimal values are the intended ones for the following constants.
7624605Szliu  * The decimal values may be used, provided that the compiler will convert
7724605Szliu  * from decimal to binary accurately enough to produce the hexadecimal values
7824605Szliu  * shown.
7924605Szliu  */
8024605Szliu 
8124605Szliu #include <errno.h>
82*56954Sbostic #include <math.h>
83*56954Sbostic 
8435679Sbostic #include "mathimpl.h"
8524605Szliu 
86*56954Sbostic #if (defined(vax) || defined(tahoe))
87*56954Sbostic 		x = (double) (float) x
88*56954Sbostic #	define _IEEE	0
89*56954Sbostic #else
90*56954Sbostic #	define _IEEE	1
91*56954Sbostic #	define TRUNC(x)  *(((int *) &x)+1)  &= 0xf8000000
92*56954Sbostic #	define infnan(x) ((x == EDOM)? zero/zero : ((x < 0) ? -one/zero : one/zero))
93*56954Sbostic #endif		/* vax or tahoe */
9424605Szliu 
95*56954Sbostic const static double zero=0.0, one=1.0, two=2.0, negone= -1.0;
9635679Sbostic 
97*56954Sbostic static double pow_P __P((double, double));
9835679Sbostic 
9924605Szliu double pow(x,y)
10024605Szliu double x,y;
10124605Szliu {
10235679Sbostic 	double t;
103*56954Sbostic 	if (y==zero)
104*56954Sbostic 		return (one);
105*56954Sbostic 	else if (y==one || (_IEEE && x != x))
106*56954Sbostic 		return (x);		/* if x is NaN or y=1 */
107*56954Sbostic 	else if (_IEEE && y!=y)		/* if y is NaN */
108*56954Sbostic 		return (y);
109*56954Sbostic 	else if (!finite(y))		/* if y is INF */
110*56954Sbostic 		if ((t=fabs(x))==one)	/* +-1 ** +-INF is NaN */
111*56954Sbostic 			return (y - y);
112*56954Sbostic 		else if (t>one)
113*56954Sbostic 			return ((y<0)? zero : ((x<zero)? y-y : y));
114*56954Sbostic 		else
115*56954Sbostic 			return ((y>0)? zero : ((x<0)? y-y : -y));
116*56954Sbostic 	else if (y==two)
117*56954Sbostic 		return (x*x);
118*56954Sbostic 	else if (y==negone)
119*56954Sbostic 		return (one/x);
120*56954Sbostic     /* x > 0, x == +0 */
121*56954Sbostic 	else if (copysign(one, x) == one)
122*56954Sbostic 		return (pow_P(x, y));
12324605Szliu 
12424605Szliu     /* sign(x)= -1 */
12524605Szliu 	/* if y is an even integer */
126*56954Sbostic 	else if ( (t=drem(y,two)) == zero)
127*56954Sbostic 		return (pow_P(-x, y));
12824605Szliu 
12924605Szliu 	/* if y is an odd integer */
130*56954Sbostic 	else if (copysign(t,one) == one)
131*56954Sbostic 		return (-pow_P(-x, y));
13224605Szliu 
13324605Szliu 	/* Henceforth y is not an integer */
134*56954Sbostic 	else if (x==zero)	/* x is -0 */
135*56954Sbostic 		return ((y>zero)? -x : one/(-x));
136*56954Sbostic 	else if (_IEEE)
137*56954Sbostic 		return (zero/zero);
138*56954Sbostic 	else
139*56954Sbostic 		return (infnan(EDOM));
14024605Szliu }
141*56954Sbostic /* kernel function for x >= 0 */
142*56954Sbostic static double
143*56954Sbostic #ifdef _ANSI_SOURCE
144*56954Sbostic pow_P(double x, double y)
145*56954Sbostic #else
146*56954Sbostic pow_P(x, y) double x, y;
147*56954Sbostic #endif
14824605Szliu {
149*56954Sbostic 	struct Double s, t, log__D();
150*56954Sbostic 	double  exp__D(), huge = 1e300, tiny = 1e-300;
15124605Szliu 
152*56954Sbostic 	if (x == 1)
153*56954Sbostic 		return (one);
154*56954Sbostic 	if (y >= 7e18)		/* infinity */
155*56954Sbostic 		if (x < 1)
156*56954Sbostic 			return(tiny*tiny);
157*56954Sbostic 		else if (_IEEE)
158*56954Sbostic 			return (huge*huge);
159*56954Sbostic 		else
160*56954Sbostic 			return (infnan(ERANGE));
16124605Szliu 
162*56954Sbostic 	/* Return exp(y*log(x)), using simulated extended */
163*56954Sbostic 	/* precision for the log and the multiply.	  */
16424605Szliu 
165*56954Sbostic 	s = log__D(x);
166*56954Sbostic 	t.a = y;
167*56954Sbostic 	TRUNC(t.a);
168*56954Sbostic 	t.b = y - t.a;
169*56954Sbostic 	t.b = s.b*y + t.b*s.a;
170*56954Sbostic 	t.a *= s.a;
171*56954Sbostic 	s.a = t.a + t.b;
172*56954Sbostic 	s.b = (t.a - s.a) + t.b;
173*56954Sbostic 	return (exp__D(s.a, s.b));
17424605Szliu }
175