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