n_pow.c revision 1.1 1 1.1 ragge /* $NetBSD: n_pow.c,v 1.1 1995/10/10 23:37:02 ragge 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.1 ragge static char sccsid[] = "@(#)pow.c 8.1 (Berkeley) 6/4/93";
37 1.1 ragge #endif /* not lint */
38 1.1 ragge
39 1.1 ragge /* POW(X,Y)
40 1.1 ragge * RETURN X**Y
41 1.1 ragge * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS)
42 1.1 ragge * CODED IN C BY K.C. NG, 1/8/85;
43 1.1 ragge * REVISED BY K.C. NG on 7/10/85.
44 1.1 ragge * KERNEL pow_P() REPLACED BY P. McILROY 7/22/92.
45 1.1 ragge * Required system supported functions:
46 1.1 ragge * scalb(x,n)
47 1.1 ragge * logb(x)
48 1.1 ragge * copysign(x,y)
49 1.1 ragge * finite(x)
50 1.1 ragge * drem(x,y)
51 1.1 ragge *
52 1.1 ragge * Required kernel functions:
53 1.1 ragge * exp__D(a,c) exp(a + c) for |a| << |c|
54 1.1 ragge * struct d_double dlog(x) r.a + r.b, |r.b| < |r.a|
55 1.1 ragge *
56 1.1 ragge * Method
57 1.1 ragge * 1. Compute and return log(x) in three pieces:
58 1.1 ragge * log(x) = n*ln2 + hi + lo,
59 1.1 ragge * where n is an integer.
60 1.1 ragge * 2. Perform y*log(x) by simulating muti-precision arithmetic and
61 1.1 ragge * return the answer in three pieces:
62 1.1 ragge * y*log(x) = m*ln2 + hi + lo,
63 1.1 ragge * where m is an integer.
64 1.1 ragge * 3. Return x**y = exp(y*log(x))
65 1.1 ragge * = 2^m * ( exp(hi+lo) ).
66 1.1 ragge *
67 1.1 ragge * Special cases:
68 1.1 ragge * (anything) ** 0 is 1 ;
69 1.1 ragge * (anything) ** 1 is itself;
70 1.1 ragge * (anything) ** NaN is NaN;
71 1.1 ragge * NaN ** (anything except 0) is NaN;
72 1.1 ragge * +(anything > 1) ** +INF is +INF;
73 1.1 ragge * -(anything > 1) ** +INF is NaN;
74 1.1 ragge * +-(anything > 1) ** -INF is +0;
75 1.1 ragge * +-(anything < 1) ** +INF is +0;
76 1.1 ragge * +(anything < 1) ** -INF is +INF;
77 1.1 ragge * -(anything < 1) ** -INF is NaN;
78 1.1 ragge * +-1 ** +-INF is NaN and signal INVALID;
79 1.1 ragge * +0 ** +(anything except 0, NaN) is +0;
80 1.1 ragge * -0 ** +(anything except 0, NaN, odd integer) is +0;
81 1.1 ragge * +0 ** -(anything except 0, NaN) is +INF and signal DIV-BY-ZERO;
82 1.1 ragge * -0 ** -(anything except 0, NaN, odd integer) is +INF with signal;
83 1.1 ragge * -0 ** (odd integer) = -( +0 ** (odd integer) );
84 1.1 ragge * +INF ** +(anything except 0,NaN) is +INF;
85 1.1 ragge * +INF ** -(anything except 0,NaN) is +0;
86 1.1 ragge * -INF ** (odd integer) = -( +INF ** (odd integer) );
87 1.1 ragge * -INF ** (even integer) = ( +INF ** (even integer) );
88 1.1 ragge * -INF ** -(anything except integer,NaN) is NaN with signal;
89 1.1 ragge * -(x=anything) ** (k=integer) is (-1)**k * (x ** k);
90 1.1 ragge * -(anything except 0) ** (non-integer) is NaN with signal;
91 1.1 ragge *
92 1.1 ragge * Accuracy:
93 1.1 ragge * pow(x,y) returns x**y nearly rounded. In particular, on a SUN, a VAX,
94 1.1 ragge * and a Zilog Z8000,
95 1.1 ragge * pow(integer,integer)
96 1.1 ragge * always returns the correct integer provided it is representable.
97 1.1 ragge * In a test run with 100,000 random arguments with 0 < x, y < 20.0
98 1.1 ragge * on a VAX, the maximum observed error was 1.79 ulps (units in the
99 1.1 ragge * last place).
100 1.1 ragge *
101 1.1 ragge * Constants :
102 1.1 ragge * The hexadecimal values are the intended ones for the following constants.
103 1.1 ragge * The decimal values may be used, provided that the compiler will convert
104 1.1 ragge * from decimal to binary accurately enough to produce the hexadecimal values
105 1.1 ragge * shown.
106 1.1 ragge */
107 1.1 ragge
108 1.1 ragge #include <errno.h>
109 1.1 ragge #include <math.h>
110 1.1 ragge
111 1.1 ragge #include "mathimpl.h"
112 1.1 ragge
113 1.1 ragge #if (defined(vax) || defined(tahoe))
114 1.1 ragge #define TRUNC(x) x = (double) (float) x
115 1.1 ragge #define _IEEE 0
116 1.1 ragge #else
117 1.1 ragge #define _IEEE 1
118 1.1 ragge #define endian (((*(int *) &one)) ? 1 : 0)
119 1.1 ragge #define TRUNC(x) *(((int *) &x)+endian) &= 0xf8000000
120 1.1 ragge #define infnan(x) 0.0
121 1.1 ragge #endif /* vax or tahoe */
122 1.1 ragge
123 1.1 ragge const static double zero=0.0, one=1.0, two=2.0, negone= -1.0;
124 1.1 ragge
125 1.1 ragge static double pow_P __P((double, double));
126 1.1 ragge
127 1.1 ragge double pow(x,y)
128 1.1 ragge double x,y;
129 1.1 ragge {
130 1.1 ragge double t;
131 1.1 ragge if (y==zero)
132 1.1 ragge return (one);
133 1.1 ragge else if (y==one || (_IEEE && x != x))
134 1.1 ragge return (x); /* if x is NaN or y=1 */
135 1.1 ragge else if (_IEEE && y!=y) /* if y is NaN */
136 1.1 ragge return (y);
137 1.1 ragge else if (!finite(y)) /* if y is INF */
138 1.1 ragge if ((t=fabs(x))==one) /* +-1 ** +-INF is NaN */
139 1.1 ragge return (y - y);
140 1.1 ragge else if (t>one)
141 1.1 ragge return ((y<0)? zero : ((x<zero)? y-y : y));
142 1.1 ragge else
143 1.1 ragge return ((y>0)? zero : ((x<0)? y-y : -y));
144 1.1 ragge else if (y==two)
145 1.1 ragge return (x*x);
146 1.1 ragge else if (y==negone)
147 1.1 ragge return (one/x);
148 1.1 ragge /* x > 0, x == +0 */
149 1.1 ragge else if (copysign(one, x) == one)
150 1.1 ragge return (pow_P(x, y));
151 1.1 ragge
152 1.1 ragge /* sign(x)= -1 */
153 1.1 ragge /* if y is an even integer */
154 1.1 ragge else if ( (t=drem(y,two)) == zero)
155 1.1 ragge return (pow_P(-x, y));
156 1.1 ragge
157 1.1 ragge /* if y is an odd integer */
158 1.1 ragge else if (copysign(t,one) == one)
159 1.1 ragge return (-pow_P(-x, y));
160 1.1 ragge
161 1.1 ragge /* Henceforth y is not an integer */
162 1.1 ragge else if (x==zero) /* x is -0 */
163 1.1 ragge return ((y>zero)? -x : one/(-x));
164 1.1 ragge else if (_IEEE)
165 1.1 ragge return (zero/zero);
166 1.1 ragge else
167 1.1 ragge return (infnan(EDOM));
168 1.1 ragge }
169 1.1 ragge /* kernel function for x >= 0 */
170 1.1 ragge static double
171 1.1 ragge #ifdef _ANSI_SOURCE
172 1.1 ragge pow_P(double x, double y)
173 1.1 ragge #else
174 1.1 ragge pow_P(x, y) double x, y;
175 1.1 ragge #endif
176 1.1 ragge {
177 1.1 ragge struct Double s, t, __log__D();
178 1.1 ragge double __exp__D(), huge = 1e300, tiny = 1e-300;
179 1.1 ragge
180 1.1 ragge if (x == zero)
181 1.1 ragge if (y > zero)
182 1.1 ragge return (zero);
183 1.1 ragge else if (_IEEE)
184 1.1 ragge return (huge*huge);
185 1.1 ragge else
186 1.1 ragge return (infnan(ERANGE));
187 1.1 ragge if (x == one)
188 1.1 ragge return (one);
189 1.1 ragge if (!finite(x))
190 1.1 ragge if (y < zero)
191 1.1 ragge return (zero);
192 1.1 ragge else if (_IEEE)
193 1.1 ragge return (huge*huge);
194 1.1 ragge else
195 1.1 ragge return (infnan(ERANGE));
196 1.1 ragge if (y >= 7e18) /* infinity */
197 1.1 ragge if (x < 1)
198 1.1 ragge return(tiny*tiny);
199 1.1 ragge else if (_IEEE)
200 1.1 ragge return (huge*huge);
201 1.1 ragge else
202 1.1 ragge return (infnan(ERANGE));
203 1.1 ragge
204 1.1 ragge /* Return exp(y*log(x)), using simulated extended */
205 1.1 ragge /* precision for the log and the multiply. */
206 1.1 ragge
207 1.1 ragge s = __log__D(x);
208 1.1 ragge t.a = y;
209 1.1 ragge TRUNC(t.a);
210 1.1 ragge t.b = y - t.a;
211 1.1 ragge t.b = s.b*y + t.b*s.a;
212 1.1 ragge t.a *= s.a;
213 1.1 ragge s.a = t.a + t.b;
214 1.1 ragge s.b = (t.a - s.a) + t.b;
215 1.1 ragge return (__exp__D(s.a, s.b));
216 1.1 ragge }
217