Skip to content
This repository has been archived by the owner on Feb 11, 2021. It is now read-only.

Latest commit

 

History

History
340 lines (321 loc) · 11.7 KB

e_pow.h

File metadata and controls

340 lines (321 loc) · 11.7 KB
 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
/* @(#)e_pow.c 5.1 93/09/24 */
/*
* ====================================================
* Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
*
* Developed at SunPro, a Sun Microsystems, Inc. business.
* Permission to use, copy, modify, and distribute this
* software is freely granted, provided that this notice
* is preserved.
* ====================================================
*/
#if defined(LIBM_SCCS) && !defined(lint)
static char rcsid[] = "$NetBSD: e_pow.c,v 1.9 1995/05/12 04:57:32 jtc Exp $";
#endif
/* __ieee754_pow(x,y) return x**y
*
* n
* Method: Let x = 2 * (1+f)
* 1. Compute and return log2(x) in two pieces:
* log2(x) = w1 + w2,
* where w1 has 53-24 = 29 bit trailing zeros.
* 2. Perform y*log2(x) = n+y' by simulating muti-precision
* arithmetic, where |y'|<=0.5.
* 3. Return x**y = 2**n*exp(y'*log2)
*
* Special cases:
* 1. (anything) ** 0 is 1
* 2. (anything) ** 1 is itself
* 3. (anything) ** NAN is NAN
* 4. NAN ** (anything except 0) is NAN
* 5. +-(|x| > 1) ** +INF is +INF
* 6. +-(|x| > 1) ** -INF is +0
* 7. +-(|x| < 1) ** +INF is +0
* 8. +-(|x| < 1) ** -INF is +INF
* 9. +-1 ** +-INF is NAN
* 10. +0 ** (+anything except 0, NAN) is +0
* 11. -0 ** (+anything except 0, NAN, odd integer) is +0
* 12. +0 ** (-anything except 0, NAN) is +INF
* 13. -0 ** (-anything except 0, NAN, odd integer) is +INF
* 14. -0 ** (odd integer) = -( +0 ** (odd integer) )
* 15. +INF ** (+anything except 0,NAN) is +INF
* 16. +INF ** (-anything except 0,NAN) is +0
* 17. -INF ** (anything) = -0 ** (-anything)
* 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer)
* 19. (-anything except 0 and inf) ** (non-integer) is NAN
*
* Accuracy:
* pow(x,y) returns x**y nearly rounded. In particular
* pow(integer,integer)
* always returns the correct integer provided it is
* representable.
*
* Constants :
* The hexadecimal values are the intended ones for the following
* constants. The decimal values may be used, provided that the
* compiler will convert from decimal to binary accurately enough
* to produce the hexadecimal values shown.
*/
/*#include "math.h"*/
#include "math_private.h"
#ifdef __STDC__
static const double
#else
static double
#endif
May 28, 2006
May 28, 2006
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
bp[] = { 1.0, 1.5, }, dp_h[] = {
0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */
dp_l[] = {
0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */
/* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */
L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */
L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */
L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */
L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */
L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */
P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */
lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */
lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */
ovt = 8.0085662595372944372e-0017, /* -(1024-log2(ovfl+.5ulp)) */
cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */
cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */
cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h */
ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */
ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2 */
ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail */
May 28, 2006
May 28, 2006
100
double
May 29, 2006
May 29, 2006
101
__ieee754_pow(double x, double y)
May 28, 2006
May 28, 2006
103
double
May 29, 2006
May 29, 2006
104
__ieee754_pow(x, y)
May 28, 2006
May 28, 2006
105
double x, y;
May 28, 2006
May 28, 2006
108
109
110
111
112
double z, ax, z_h, z_l, p_h, p_l;
double y1, t1, t2, r, s, t, u, v, w;
int32_t i, j, k, yisint, n;
int32_t hx, hy, ix, iy;
u_int32_t lx, ly;
May 29, 2006
May 29, 2006
114
115
EXTRACT_WORDS(hx, lx, x);
EXTRACT_WORDS(hy, ly, y);
May 28, 2006
May 28, 2006
116
117
ix = hx & 0x7fffffff;
iy = hy & 0x7fffffff;
118
119
/* y==zero: x**0 = 1 */
May 28, 2006
May 28, 2006
120
121
if ((iy | ly) == 0)
return one;
122
123
/* +-NaN return x+y */
May 28, 2006
May 28, 2006
124
125
126
if (ix > 0x7ff00000 || ((ix == 0x7ff00000) && (lx != 0)) ||
iy > 0x7ff00000 || ((iy == 0x7ff00000) && (ly != 0)))
return x + y;
127
128
/* determine if y is an odd int when x < 0
May 28, 2006
May 28, 2006
129
130
131
* yisint = 0 ... y is not an integer
* yisint = 1 ... y is an odd int
* yisint = 2 ... y is an even int
May 28, 2006
May 28, 2006
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
yisint = 0;
if (hx < 0) {
if (iy >= 0x43400000)
yisint = 2; /* even integer y */
else if (iy >= 0x3ff00000) {
k = (iy >> 20) - 0x3ff; /* exponent */
if (k > 20) {
j = ly >> (52 - k);
if ((u_int32_t) (j << (52 - k)) == ly)
yisint = 2 - (j & 1);
} else if (ly == 0) {
j = iy >> (20 - k);
if ((j << (20 - k)) == iy)
yisint = 2 - (j & 1);
}
}
}
150
151
/* special value of y */
May 28, 2006
May 28, 2006
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
if (ly == 0) {
if (iy == 0x7ff00000) { /* y is +-inf */
if (((ix - 0x3ff00000) | lx) == 0)
return y - y; /* inf**+-1 is NaN */
else if (ix >= 0x3ff00000) /* (|x|>1)**+-inf = inf,0 */
return (hy >= 0) ? y : zero;
else /* (|x|<1)**-,+inf = inf,0 */
return (hy < 0) ? -y : zero;
}
if (iy == 0x3ff00000) { /* y is +-1 */
if (hy < 0)
return one / x;
else
return x;
}
if (hy == 0x40000000)
return x * x; /* y is 2 */
if (hy == 0x3fe00000) { /* y is 0.5 */
if (hx >= 0) /* x >= +0 */
May 29, 2006
May 29, 2006
171
return __ieee754_sqrt(x);
May 28, 2006
May 28, 2006
172
173
}
}
May 28, 2006
May 28, 2006
175
ax = x < 0 ? -x : x; /*fabs(x); */
176
/* special value of x */
May 28, 2006
May 28, 2006
177
178
179
180
181
182
183
184
185
186
187
188
189
190
if (lx == 0) {
if (ix == 0x7ff00000 || ix == 0 || ix == 0x3ff00000) {
z = ax; /*x is +-0,+-inf,+-1 */
if (hy < 0)
z = one / z; /* z = (1/|x|) */
if (hx < 0) {
if (((ix - 0x3ff00000) | yisint) == 0) {
z = (z - z) / (z - z); /* (-1)**non-int is NaN */
} else if (yisint == 1)
z = -z; /* (x<0)**odd = -(|x|**odd) */
}
return z;
}
}
191
192
/* (x<0)**(non-int) is NaN */
May 28, 2006
May 28, 2006
193
194
if (((((u_int32_t) hx >> 31) - 1) | yisint) == 0)
return (x - x) / (x - x);
May 28, 2006
May 28, 2006
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
if (iy > 0x41e00000) { /* if |y| > 2**31 */
if (iy > 0x43f00000) { /* if |y| > 2**64, must o/uflow */
if (ix <= 0x3fefffff)
return (hy < 0) ? huge * huge : tiny * tiny;
if (ix >= 0x3ff00000)
return (hy > 0) ? huge * huge : tiny * tiny;
}
/* over/underflow if x is not close to one */
if (ix < 0x3fefffff)
return (hy < 0) ? huge * huge : tiny * tiny;
if (ix > 0x3ff00000)
return (hy > 0) ? huge * huge : tiny * tiny;
/* now |1-x| is tiny <= 2**-20, suffice to compute
log(x) by x-x^2/2+x^3/3-x^4/4 */
t = x - 1; /* t has 20 trailing zeros */
w = (t * t) * (0.5 - t * (0.3333333333333333333333 - t * 0.25));
u = ivln2_h * t; /* ivln2_h has 21 sig. bits */
v = t * ivln2_l - w * ivln2;
t1 = u + v;
May 29, 2006
May 29, 2006
216
SET_LOW_WORD(t1, 0);
May 28, 2006
May 28, 2006
217
218
219
220
221
222
223
224
t2 = v - (t1 - u);
} else {
double s2, s_h, s_l, t_h, t_l;
n = 0;
/* take care subnormal number */
if (ix < 0x00100000) {
ax *= two53;
n -= 53;
May 29, 2006
May 29, 2006
225
GET_HIGH_WORD(ix, ax);
May 28, 2006
May 28, 2006
226
227
228
229
230
231
232
233
234
235
236
237
238
239
}
n += ((ix) >> 20) - 0x3ff;
j = ix & 0x000fffff;
/* determine interval */
ix = j | 0x3ff00000; /* normalize ix */
if (j <= 0x3988E)
k = 0; /* |x|<sqrt(3/2) */
else if (j < 0xBB67A)
k = 1; /* |x|<sqrt(3) */
else {
k = 0;
n += 1;
ix -= 0x00100000;
}
May 29, 2006
May 29, 2006
240
SET_HIGH_WORD(ax, ix);
May 28, 2006
May 28, 2006
242
243
244
245
246
/* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
u = ax - bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
v = one / (ax + bp[k]);
s = u * v;
s_h = s;
May 29, 2006
May 29, 2006
247
SET_LOW_WORD(s_h, 0);
May 28, 2006
May 28, 2006
248
249
/* t_h=ax+bp[k] High */
t_h = zero;
May 29, 2006
May 29, 2006
250
SET_HIGH_WORD(t_h, ((ix >> 1) | 0x20000000) + 0x00080000 + (k << 18));
May 28, 2006
May 28, 2006
251
252
253
254
255
256
257
258
259
260
t_l = ax - (t_h - bp[k]);
s_l = v * ((u - s_h * t_h) - s_h * t_l);
/* compute log(ax) */
s2 = s * s;
r = s2 * s2 * (L1 +
s2 * (L2 +
s2 * (L3 + s2 * (L4 + s2 * (L5 + s2 * L6)))));
r += s_l * (s_h + s);
s2 = s_h * s_h;
t_h = 3.0 + s2 + r;
May 29, 2006
May 29, 2006
261
SET_LOW_WORD(t_h, 0);
May 28, 2006
May 28, 2006
262
263
264
265
266
267
t_l = r - ((t_h - 3.0) - s2);
/* u+v = s*(1+...) */
u = s_h * t_h;
v = s_l * t_h + t_l * s;
/* 2/(3log2)*(s+...) */
p_h = u + v;
May 29, 2006
May 29, 2006
268
SET_LOW_WORD(p_h, 0);
May 28, 2006
May 28, 2006
269
270
271
272
273
274
p_l = v - (p_h - u);
z_h = cp_h * p_h; /* cp_h+cp_l = 2/(3*log2) */
z_l = cp_l * p_h + p_l * cp + dp_l[k];
/* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */
t = (double) n;
t1 = (((z_h + z_l) + dp_h[k]) + t);
May 29, 2006
May 29, 2006
275
SET_LOW_WORD(t1, 0);
May 28, 2006
May 28, 2006
276
277
t2 = z_l - (((t1 - t) - dp_h[k]) - z_h);
}
May 28, 2006
May 28, 2006
279
280
281
s = one; /* s (sign of result -ve**odd) = -1 else = 1 */
if (((((u_int32_t) hx >> 31) - 1) | (yisint - 1)) == 0)
s = -one; /* (-ve)**(odd int) */
282
283
/* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
May 28, 2006
May 28, 2006
284
y1 = y;
May 29, 2006
May 29, 2006
285
SET_LOW_WORD(y1, 0);
May 28, 2006
May 28, 2006
286
287
288
p_l = (y - y1) * t1 + y * t2;
p_h = y1 * t1;
z = p_l + p_h;
May 29, 2006
May 29, 2006
289
EXTRACT_WORDS(j, i, z);
May 28, 2006
May 28, 2006
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
if (j >= 0x40900000) { /* z >= 1024 */
if (((j - 0x40900000) | i) != 0) /* if z > 1024 */
return s * huge * huge; /* overflow */
else {
if (p_l + ovt > z - p_h)
return s * huge * huge; /* overflow */
}
} else if ((j & 0x7fffffff) >= 0x4090cc00) { /* z <= -1075 */
if (((j - 0xc090cc00) | i) != 0) /* z < -1075 */
return s * tiny * tiny; /* underflow */
else {
if (p_l <= z - p_h)
return s * tiny * tiny; /* underflow */
}
}
305
306
307
/*
* compute 2**(p_h+p_l)
*/
May 28, 2006
May 28, 2006
308
309
310
311
312
313
314
i = j & 0x7fffffff;
k = (i >> 20) - 0x3ff;
n = 0;
if (i > 0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */
n = j + (0x00100000 >> (k + 1));
k = ((n & 0x7fffffff) >> 20) - 0x3ff; /* new k for n */
t = zero;
May 29, 2006
May 29, 2006
315
SET_HIGH_WORD(t, n & ~(0x000fffff >> k));
May 28, 2006
May 28, 2006
316
317
318
319
320
321
n = ((n & 0x000fffff) | 0x00100000) >> (20 - k);
if (j < 0)
n = -n;
p_h -= t;
}
t = p_l + p_h;
May 29, 2006
May 29, 2006
322
SET_LOW_WORD(t, 0);
May 28, 2006
May 28, 2006
323
324
325
326
327
328
329
330
u = t * lg2_h;
v = (p_l - (t - p_h)) * lg2 + t * lg2_l;
z = u + v;
w = v - (z - u);
t = z * z;
t1 = z - t * (P1 + t * (P2 + t * (P3 + t * (P4 + t * P5))));
r = (z * t1) / (t1 - two) - (w + z * w);
z = one - (r - z);
May 29, 2006
May 29, 2006
331
GET_HIGH_WORD(j, z);
May 28, 2006
May 28, 2006
332
333
j += (n << 20);
if ((j >> 20) <= 0)
May 29, 2006
May 29, 2006
334
z = SDL_NAME(scalbn) (z, n); /* subnormal output */
May 28, 2006
May 28, 2006
335
else
May 29, 2006
May 29, 2006
336
SET_HIGH_WORD(z, j);
May 28, 2006
May 28, 2006
337
return s * z;
May 28, 2006
May 28, 2006
339
340
/* vi: set ts=4 sw=4 expandtab: */