n_pow.c revision 1.6 1 1.6 matt /* $NetBSD: n_pow.c,v 1.6 2002/06/15 00:10:18 matt Exp $ */
2 1.1 ragge /*
3 1.1 ragge * Copyright (c) 1985, 1993
4 1.1 ragge * The Regents of the University of California. All rights reserved.
5 1.1 ragge *
6 1.1 ragge * Redistribution and use in source and binary forms, with or without
7 1.1 ragge * modification, are permitted provided that the following conditions
8 1.1 ragge * are met:
9 1.1 ragge * 1. Redistributions of source code must retain the above copyright
10 1.1 ragge * notice, this list of conditions and the following disclaimer.
11 1.1 ragge * 2. Redistributions in binary form must reproduce the above copyright
12 1.1 ragge * notice, this list of conditions and the following disclaimer in the
13 1.1 ragge * documentation and/or other materials provided with the distribution.
14 1.1 ragge * 3. All advertising materials mentioning features or use of this software
15 1.1 ragge * must display the following acknowledgement:
16 1.1 ragge * This product includes software developed by the University of
17 1.1 ragge * California, Berkeley and its contributors.
18 1.1 ragge * 4. Neither the name of the University nor the names of its contributors
19 1.1 ragge * may be used to endorse or promote products derived from this software
20 1.1 ragge * without specific prior written permission.
21 1.1 ragge *
22 1.1 ragge * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
23 1.1 ragge * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24 1.1 ragge * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25 1.1 ragge * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
26 1.1 ragge * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27 1.1 ragge * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28 1.1 ragge * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29 1.1 ragge * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 1.1 ragge * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
31 1.1 ragge * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
32 1.1 ragge * SUCH DAMAGE.
33 1.1 ragge */
34 1.1 ragge
35 1.1 ragge #ifndef lint
36 1.2 ragge #if 0
37 1.1 ragge static char sccsid[] = "@(#)pow.c 8.1 (Berkeley) 6/4/93";
38 1.2 ragge #endif
39 1.1 ragge #endif /* not lint */
40 1.1 ragge
41 1.4 simonb /* POW(X,Y)
42 1.4 simonb * RETURN X**Y
43 1.1 ragge * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
44 1.4 simonb * CODED IN C BY K.C. NG, 1/8/85;
45 1.1 ragge * REVISED BY K.C. NG on 7/10/85.
46 1.1 ragge * KERNEL pow_P() REPLACED BY P. McILROY 7/22/92.
47 1.1 ragge * Required system supported functions:
48 1.4 simonb * scalb(x,n)
49 1.4 simonb * logb(x)
50 1.4 simonb * copysign(x,y)
51 1.4 simonb * finite(x)
52 1.1 ragge * drem(x,y)
53 1.1 ragge *
54 1.1 ragge * Required kernel functions:
55 1.1 ragge * exp__D(a,c) exp(a + c) for |a| << |c|
56 1.1 ragge * struct d_double dlog(x) r.a + r.b, |r.b| < |r.a|
57 1.1 ragge *
58 1.1 ragge * Method
59 1.1 ragge * 1. Compute and return log(x) in three pieces:
60 1.1 ragge * log(x) = n*ln2 + hi + lo,
61 1.1 ragge * where n is an integer.
62 1.4 simonb * 2. Perform y*log(x) by simulating muti-precision arithmetic and
63 1.1 ragge * return the answer in three pieces:
64 1.1 ragge * y*log(x) = m*ln2 + hi + lo,
65 1.1 ragge * where m is an integer.
66 1.1 ragge * 3. Return x**y = exp(y*log(x))
67 1.1 ragge * = 2^m * ( exp(hi+lo) ).
68 1.1 ragge *
69 1.1 ragge * Special cases:
70 1.1 ragge * (anything) ** 0 is 1 ;
71 1.1 ragge * (anything) ** 1 is itself;
72 1.1 ragge * (anything) ** NaN is NaN;
73 1.1 ragge * NaN ** (anything except 0) is NaN;
74 1.1 ragge * +(anything > 1) ** +INF is +INF;
75 1.1 ragge * -(anything > 1) ** +INF is NaN;
76 1.1 ragge * +-(anything > 1) ** -INF is +0;
77 1.1 ragge * +-(anything < 1) ** +INF is +0;
78 1.1 ragge * +(anything < 1) ** -INF is +INF;
79 1.1 ragge * -(anything < 1) ** -INF is NaN;
80 1.1 ragge * +-1 ** +-INF is NaN and signal INVALID;
81 1.1 ragge * +0 ** +(anything except 0, NaN) is +0;
82 1.1 ragge * -0 ** +(anything except 0, NaN, odd integer) is +0;
83 1.1 ragge * +0 ** -(anything except 0, NaN) is +INF and signal DIV-BY-ZERO;
84 1.1 ragge * -0 ** -(anything except 0, NaN, odd integer) is +INF with signal;
85 1.1 ragge * -0 ** (odd integer) = -( +0 ** (odd integer) );
86 1.1 ragge * +INF ** +(anything except 0,NaN) is +INF;
87 1.1 ragge * +INF ** -(anything except 0,NaN) is +0;
88 1.1 ragge * -INF ** (odd integer) = -( +INF ** (odd integer) );
89 1.1 ragge * -INF ** (even integer) = ( +INF ** (even integer) );
90 1.1 ragge * -INF ** -(anything except integer,NaN) is NaN with signal;
91 1.1 ragge * -(x=anything) ** (k=integer) is (-1)**k * (x ** k);
92 1.1 ragge * -(anything except 0) ** (non-integer) is NaN with signal;
93 1.1 ragge *
94 1.1 ragge * Accuracy:
95 1.1 ragge * pow(x,y) returns x**y nearly rounded. In particular, on a SUN, a VAX,
96 1.1 ragge * and a Zilog Z8000,
97 1.1 ragge * pow(integer,integer)
98 1.1 ragge * always returns the correct integer provided it is representable.
99 1.1 ragge * In a test run with 100,000 random arguments with 0 < x, y < 20.0
100 1.4 simonb * on a VAX, the maximum observed error was 1.79 ulps (units in the
101 1.1 ragge * last place).
102 1.1 ragge *
103 1.1 ragge * Constants :
104 1.1 ragge * The hexadecimal values are the intended ones for the following constants.
105 1.1 ragge * The decimal values may be used, provided that the compiler will convert
106 1.1 ragge * from decimal to binary accurately enough to produce the hexadecimal values
107 1.1 ragge * shown.
108 1.1 ragge */
109 1.1 ragge
110 1.1 ragge #include <errno.h>
111 1.1 ragge #include <math.h>
112 1.1 ragge
113 1.1 ragge #include "mathimpl.h"
114 1.1 ragge
115 1.3 matt #if (defined(__vax__) || defined(tahoe))
116 1.1 ragge #define TRUNC(x) x = (double) (float) x
117 1.1 ragge #define _IEEE 0
118 1.1 ragge #else
119 1.1 ragge #define _IEEE 1
120 1.1 ragge #define endian (((*(int *) &one)) ? 1 : 0)
121 1.1 ragge #define TRUNC(x) *(((int *) &x)+endian) &= 0xf8000000
122 1.1 ragge #define infnan(x) 0.0
123 1.3 matt #endif /* __vax__ or tahoe */
124 1.1 ragge
125 1.6 matt static const double zero=0.0, one=1.0, two=2.0, negone= -1.0;
126 1.1 ragge
127 1.6 matt static double pow_P (double, double);
128 1.5 matt
129 1.6 matt float
130 1.6 matt powf(float x, float y)
131 1.5 matt {
132 1.5 matt return pow((double) x, (double) (y));
133 1.5 matt }
134 1.1 ragge
135 1.6 matt double
136 1.6 matt pow(double x, double y)
137 1.1 ragge {
138 1.1 ragge double t;
139 1.1 ragge if (y==zero)
140 1.1 ragge return (one);
141 1.1 ragge else if (y==one || (_IEEE && x != x))
142 1.1 ragge return (x); /* if x is NaN or y=1 */
143 1.1 ragge else if (_IEEE && y!=y) /* if y is NaN */
144 1.1 ragge return (y);
145 1.1 ragge else if (!finite(y)) /* if y is INF */
146 1.1 ragge if ((t=fabs(x))==one) /* +-1 ** +-INF is NaN */
147 1.1 ragge return (y - y);
148 1.1 ragge else if (t>one)
149 1.1 ragge return ((y<0)? zero : ((x<zero)? y-y : y));
150 1.1 ragge else
151 1.1 ragge return ((y>0)? zero : ((x<0)? y-y : -y));
152 1.1 ragge else if (y==two)
153 1.1 ragge return (x*x);
154 1.1 ragge else if (y==negone)
155 1.1 ragge return (one/x);
156 1.1 ragge /* x > 0, x == +0 */
157 1.1 ragge else if (copysign(one, x) == one)
158 1.1 ragge return (pow_P(x, y));
159 1.1 ragge
160 1.1 ragge /* sign(x)= -1 */
161 1.1 ragge /* if y is an even integer */
162 1.1 ragge else if ( (t=drem(y,two)) == zero)
163 1.1 ragge return (pow_P(-x, y));
164 1.1 ragge
165 1.1 ragge /* if y is an odd integer */
166 1.1 ragge else if (copysign(t,one) == one)
167 1.1 ragge return (-pow_P(-x, y));
168 1.1 ragge
169 1.1 ragge /* Henceforth y is not an integer */
170 1.1 ragge else if (x==zero) /* x is -0 */
171 1.1 ragge return ((y>zero)? -x : one/(-x));
172 1.1 ragge else if (_IEEE)
173 1.1 ragge return (zero/zero);
174 1.1 ragge else
175 1.1 ragge return (infnan(EDOM));
176 1.1 ragge }
177 1.6 matt
178 1.1 ragge /* kernel function for x >= 0 */
179 1.1 ragge static double
180 1.1 ragge pow_P(double x, double y)
181 1.1 ragge {
182 1.2 ragge struct Double s, t;
183 1.2 ragge double huge = 1e300, tiny = 1e-300;
184 1.1 ragge
185 1.3 matt if (x == zero) {
186 1.1 ragge if (y > zero)
187 1.1 ragge return (zero);
188 1.1 ragge else if (_IEEE)
189 1.1 ragge return (huge*huge);
190 1.1 ragge else
191 1.1 ragge return (infnan(ERANGE));
192 1.3 matt }
193 1.1 ragge if (x == one)
194 1.1 ragge return (one);
195 1.3 matt if (!finite(x)) {
196 1.1 ragge if (y < zero)
197 1.1 ragge return (zero);
198 1.1 ragge else if (_IEEE)
199 1.1 ragge return (huge*huge);
200 1.1 ragge else
201 1.1 ragge return (infnan(ERANGE));
202 1.3 matt }
203 1.4 simonb if (y >= 7e18) { /* infinity */
204 1.1 ragge if (x < 1)
205 1.1 ragge return(tiny*tiny);
206 1.1 ragge else if (_IEEE)
207 1.1 ragge return (huge*huge);
208 1.1 ragge else
209 1.1 ragge return (infnan(ERANGE));
210 1.3 matt }
211 1.1 ragge
212 1.1 ragge /* Return exp(y*log(x)), using simulated extended */
213 1.1 ragge /* precision for the log and the multiply. */
214 1.1 ragge
215 1.1 ragge s = __log__D(x);
216 1.1 ragge t.a = y;
217 1.1 ragge TRUNC(t.a);
218 1.1 ragge t.b = y - t.a;
219 1.1 ragge t.b = s.b*y + t.b*s.a;
220 1.1 ragge t.a *= s.a;
221 1.1 ragge s.a = t.a + t.b;
222 1.1 ragge s.b = (t.a - s.a) + t.b;
223 1.1 ragge return (__exp__D(s.a, s.b));
224 1.1 ragge }
225