xref: /csrg-svn/lib/libm/common_source/pow.c (revision 61309)
134126Sbostic /*
2*61309Sbostic  * Copyright (c) 1985, 1993
3*61309Sbostic  *	The Regents of the University of California.  All rights reserved.
434126Sbostic  *
542657Sbostic  * %sccs.include.redist.c%
624605Szliu  */
724605Szliu 
824605Szliu #ifndef lint
9*61309Sbostic static char sccsid[] = "@(#)pow.c	8.1 (Berkeley) 06/04/93";
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.
1756954Sbostic  * 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:
2656954Sbostic  *	exp__D(a,c)			exp(a + c) for |a| << |c|
2756954Sbostic  *	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;
4556954Sbostic  *	+(anything > 1) ** +INF is +INF;
4656954Sbostic  *	-(anything > 1) ** +INF is NaN;
4724605Szliu  *	+-(anything > 1) ** -INF is +0;
4824605Szliu  *	+-(anything < 1) ** +INF is +0;
4956954Sbostic  *	+(anything < 1) ** -INF is +INF;
5056954Sbostic  *	-(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>
8256954Sbostic #include <math.h>
8356954Sbostic 
8435679Sbostic #include "mathimpl.h"
8524605Szliu 
8656954Sbostic #if (defined(vax) || defined(tahoe))
8757157Smcilroy #define TRUNC(x)	x = (double) (float) x
8857157Smcilroy #define _IEEE		0
8956954Sbostic #else
9057157Smcilroy #define _IEEE		1
9157157Smcilroy #define endian		(((*(int *) &one)) ? 1 : 0)
9257157Smcilroy #define TRUNC(x) 	*(((int *) &x)+endian) &= 0xf8000000
9357157Smcilroy #define infnan(x)	0.0
9456954Sbostic #endif		/* vax or tahoe */
9524605Szliu 
9656954Sbostic const static double zero=0.0, one=1.0, two=2.0, negone= -1.0;
9735679Sbostic 
9856954Sbostic static double pow_P __P((double, double));
9935679Sbostic 
pow(x,y)10024605Szliu double pow(x,y)
10124605Szliu double x,y;
10224605Szliu {
10335679Sbostic 	double t;
10456954Sbostic 	if (y==zero)
10556954Sbostic 		return (one);
10656954Sbostic 	else if (y==one || (_IEEE && x != x))
10756954Sbostic 		return (x);		/* if x is NaN or y=1 */
10856954Sbostic 	else if (_IEEE && y!=y)		/* if y is NaN */
10956954Sbostic 		return (y);
11056954Sbostic 	else if (!finite(y))		/* if y is INF */
11156954Sbostic 		if ((t=fabs(x))==one)	/* +-1 ** +-INF is NaN */
11256954Sbostic 			return (y - y);
11356954Sbostic 		else if (t>one)
11456954Sbostic 			return ((y<0)? zero : ((x<zero)? y-y : y));
11556954Sbostic 		else
11656954Sbostic 			return ((y>0)? zero : ((x<0)? y-y : -y));
11756954Sbostic 	else if (y==two)
11856954Sbostic 		return (x*x);
11956954Sbostic 	else if (y==negone)
12056954Sbostic 		return (one/x);
12156954Sbostic     /* x > 0, x == +0 */
12256954Sbostic 	else if (copysign(one, x) == one)
12356954Sbostic 		return (pow_P(x, y));
12424605Szliu 
12524605Szliu     /* sign(x)= -1 */
12624605Szliu 	/* if y is an even integer */
12756954Sbostic 	else if ( (t=drem(y,two)) == zero)
12856954Sbostic 		return (pow_P(-x, y));
12924605Szliu 
13024605Szliu 	/* if y is an odd integer */
13156954Sbostic 	else if (copysign(t,one) == one)
13256954Sbostic 		return (-pow_P(-x, y));
13324605Szliu 
13424605Szliu 	/* Henceforth y is not an integer */
13556954Sbostic 	else if (x==zero)	/* x is -0 */
13656954Sbostic 		return ((y>zero)? -x : one/(-x));
13756954Sbostic 	else if (_IEEE)
13856954Sbostic 		return (zero/zero);
13956954Sbostic 	else
14056954Sbostic 		return (infnan(EDOM));
14124605Szliu }
14256954Sbostic /* kernel function for x >= 0 */
14356954Sbostic static double
14456954Sbostic #ifdef _ANSI_SOURCE
pow_P(double x,double y)14556954Sbostic pow_P(double x, double y)
14656954Sbostic #else
14756954Sbostic pow_P(x, y) double x, y;
14856954Sbostic #endif
14924605Szliu {
15057452Sbostic 	struct Double s, t, __log__D();
15157452Sbostic 	double  __exp__D(), huge = 1e300, tiny = 1e-300;
15224605Szliu 
15359659Shibler 	if (x == zero)
15459659Shibler 		if (y > zero)
15559659Shibler 			return (zero);
15659659Shibler 		else if (_IEEE)
15759659Shibler 			return (huge*huge);
15859659Shibler 		else
15959659Shibler 			return (infnan(ERANGE));
16059659Shibler 	if (x == one)
16156954Sbostic 		return (one);
16259659Shibler 	if (!finite(x))
16359659Shibler 		if (y < zero)
16459659Shibler 			return (zero);
16559659Shibler 		else if (_IEEE)
16659659Shibler 			return (huge*huge);
16759659Shibler 		else
16859659Shibler 			return (infnan(ERANGE));
16956954Sbostic 	if (y >= 7e18)		/* infinity */
17056954Sbostic 		if (x < 1)
17156954Sbostic 			return(tiny*tiny);
17256954Sbostic 		else if (_IEEE)
17356954Sbostic 			return (huge*huge);
17456954Sbostic 		else
17556954Sbostic 			return (infnan(ERANGE));
17624605Szliu 
17756954Sbostic 	/* Return exp(y*log(x)), using simulated extended */
17856954Sbostic 	/* precision for the log and the multiply.	  */
17924605Szliu 
18057452Sbostic 	s = __log__D(x);
18156954Sbostic 	t.a = y;
18256954Sbostic 	TRUNC(t.a);
18356954Sbostic 	t.b = y - t.a;
18456954Sbostic 	t.b = s.b*y + t.b*s.a;
18556954Sbostic 	t.a *= s.a;
18656954Sbostic 	s.a = t.a + t.b;
18756954Sbostic 	s.b = (t.a - s.a) + t.b;
18857452Sbostic 	return (__exp__D(s.a, s.b));
18924605Szliu }
190