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*57452Sbostic static char sccsid[] = "@(#)pow.c 5.10 (Berkeley) 01/10/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 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 14556954Sbostic pow_P(double x, double y) 14656954Sbostic #else 14756954Sbostic pow_P(x, y) double x, y; 14856954Sbostic #endif 14924605Szliu { 150*57452Sbostic struct Double s, t, __log__D(); 151*57452Sbostic double __exp__D(), huge = 1e300, tiny = 1e-300; 15224605Szliu 15356954Sbostic if (x == 1) 15456954Sbostic return (one); 15556954Sbostic if (y >= 7e18) /* infinity */ 15656954Sbostic if (x < 1) 15756954Sbostic return(tiny*tiny); 15856954Sbostic else if (_IEEE) 15956954Sbostic return (huge*huge); 16056954Sbostic else 16156954Sbostic return (infnan(ERANGE)); 16224605Szliu 16356954Sbostic /* Return exp(y*log(x)), using simulated extended */ 16456954Sbostic /* precision for the log and the multiply. */ 16524605Szliu 166*57452Sbostic s = __log__D(x); 16756954Sbostic t.a = y; 16856954Sbostic TRUNC(t.a); 16956954Sbostic t.b = y - t.a; 17056954Sbostic t.b = s.b*y + t.b*s.a; 17156954Sbostic t.a *= s.a; 17256954Sbostic s.a = t.a + t.b; 17356954Sbostic s.b = (t.a - s.a) + t.b; 174*57452Sbostic return (__exp__D(s.a, s.b)); 17524605Szliu } 176