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