1 | /* |
2 | * IBM Accurate Mathematical Library |
3 | * written by International Business Machines Corp. |
4 | * Copyright (C) 2001-2018 Free Software Foundation, Inc. |
5 | * |
6 | * This program is free software; you can redistribute it and/or modify |
7 | * it under the terms of the GNU Lesser General Public License as published by |
8 | * the Free Software Foundation; either version 2.1 of the License, or |
9 | * (at your option) any later version. |
10 | * |
11 | * This program is distributed in the hope that it will be useful, |
12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | * GNU Lesser General Public License for more details. |
15 | * |
16 | * You should have received a copy of the GNU Lesser General Public License |
17 | * along with this program; if not, see <http://www.gnu.org/licenses/>. |
18 | */ |
19 | /*********************************************************************/ |
20 | /* */ |
21 | /* MODULE_NAME:ulog.c */ |
22 | /* */ |
23 | /* FUNCTION:ulog */ |
24 | /* */ |
25 | /* FILES NEEDED: dla.h endian.h mpa.h mydefs.h ulog.h */ |
26 | /* ulog.tbl */ |
27 | /* */ |
28 | /* An ultimate log routine. Given an IEEE double machine number x */ |
29 | /* it computes the rounded (to nearest) value of log(x). */ |
30 | /* Assumption: Machine arithmetic operations are performed in */ |
31 | /* round to nearest mode of IEEE 754 standard. */ |
32 | /* */ |
33 | /*********************************************************************/ |
34 | |
35 | |
36 | #include "endian.h" |
37 | #include <dla.h> |
38 | #include "mpa.h" |
39 | #include "MathLib.h" |
40 | #include <math.h> |
41 | #include <math_private.h> |
42 | |
43 | #ifndef SECTION |
44 | # define SECTION |
45 | #endif |
46 | |
47 | /*********************************************************************/ |
48 | /* An ultimate log routine. Given an IEEE double machine number x */ |
49 | /* it computes the rounded (to nearest) value of log(x). */ |
50 | /*********************************************************************/ |
51 | double |
52 | SECTION |
53 | __ieee754_log (double x) |
54 | { |
55 | int i, j, n, ux, dx; |
56 | double dbl_n, u, p0, q, r0, w, nln2a, luai, lubi, lvaj, lvbj, |
57 | sij, ssij, ttij, A, B, B0, polI, polII, t8, a, aa, b, bb, c; |
58 | #ifndef DLA_FMS |
59 | double t1, t2, t3, t4, t5; |
60 | #endif |
61 | number num; |
62 | |
63 | #include "ulog.tbl" |
64 | #include "ulog.h" |
65 | |
66 | /* Treating special values of x ( x<=0, x=INF, x=NaN etc.). */ |
67 | |
68 | num.d = x; |
69 | ux = num.i[HIGH_HALF]; |
70 | dx = num.i[LOW_HALF]; |
71 | n = 0; |
72 | if (__glibc_unlikely (ux < 0x00100000)) |
73 | { |
74 | if (__glibc_unlikely (((ux & 0x7fffffff) | dx) == 0)) |
75 | return MHALF / 0.0; /* return -INF */ |
76 | if (__glibc_unlikely (ux < 0)) |
77 | return (x - x) / 0.0; /* return NaN */ |
78 | n -= 54; |
79 | x *= two54.d; /* scale x */ |
80 | num.d = x; |
81 | } |
82 | if (__glibc_unlikely (ux >= 0x7ff00000)) |
83 | return x + x; /* INF or NaN */ |
84 | |
85 | /* Regular values of x */ |
86 | |
87 | w = x - 1; |
88 | if (__glibc_likely (fabs (w) > U03)) |
89 | goto case_03; |
90 | |
91 | /* log (1) is +0 in all rounding modes. */ |
92 | if (w == 0.0) |
93 | return 0.0; |
94 | |
95 | /*--- The case abs(x-1) < 0.03 */ |
96 | |
97 | t8 = MHALF * w; |
98 | EMULV (t8, w, a, aa, t1, t2, t3, t4, t5); |
99 | EADD (w, a, b, bb); |
100 | /* Evaluate polynomial II */ |
101 | polII = b7.d + w * b8.d; |
102 | polII = b6.d + w * polII; |
103 | polII = b5.d + w * polII; |
104 | polII = b4.d + w * polII; |
105 | polII = b3.d + w * polII; |
106 | polII = b2.d + w * polII; |
107 | polII = b1.d + w * polII; |
108 | polII = b0.d + w * polII; |
109 | polII *= w * w * w; |
110 | c = (aa + bb) + polII; |
111 | |
112 | /* Here b contains the high part of the result, and c the low part. |
113 | Maximum error is b * 2.334e-19, so accuracy is >61 bits. |
114 | Therefore max ULP error of b + c is ~0.502. */ |
115 | return b + c; |
116 | |
117 | /*--- The case abs(x-1) > 0.03 */ |
118 | case_03: |
119 | |
120 | /* Find n,u such that x = u*2**n, 1/sqrt(2) < u < sqrt(2) */ |
121 | n += (num.i[HIGH_HALF] >> 20) - 1023; |
122 | num.i[HIGH_HALF] = (num.i[HIGH_HALF] & 0x000fffff) | 0x3ff00000; |
123 | if (num.d > SQRT_2) |
124 | { |
125 | num.d *= HALF; |
126 | n++; |
127 | } |
128 | u = num.d; |
129 | dbl_n = (double) n; |
130 | |
131 | /* Find i such that ui=1+(i-75)/2**8 is closest to u (i= 0,1,2,...,181) */ |
132 | num.d += h1.d; |
133 | i = (num.i[HIGH_HALF] & 0x000fffff) >> 12; |
134 | |
135 | /* Find j such that vj=1+(j-180)/2**16 is closest to v=u/ui (j= 0,...,361) */ |
136 | num.d = u * Iu[i].d + h2.d; |
137 | j = (num.i[HIGH_HALF] & 0x000fffff) >> 4; |
138 | |
139 | /* Compute w=(u-ui*vj)/(ui*vj) */ |
140 | p0 = (1 + (i - 75) * DEL_U) * (1 + (j - 180) * DEL_V); |
141 | q = u - p0; |
142 | r0 = Iu[i].d * Iv[j].d; |
143 | w = q * r0; |
144 | |
145 | /* Evaluate polynomial I */ |
146 | polI = w + (a2.d + a3.d * w) * w * w; |
147 | |
148 | /* Add up everything */ |
149 | nln2a = dbl_n * LN2A; |
150 | luai = Lu[i][0].d; |
151 | lubi = Lu[i][1].d; |
152 | lvaj = Lv[j][0].d; |
153 | lvbj = Lv[j][1].d; |
154 | EADD (luai, lvaj, sij, ssij); |
155 | EADD (nln2a, sij, A, ttij); |
156 | B0 = (((lubi + lvbj) + ssij) + ttij) + dbl_n * LN2B; |
157 | B = polI + B0; |
158 | |
159 | /* Here A contains the high part of the result, and B the low part. |
160 | Maximum abs error is 6.095e-21 and min log (x) is 0.0295 since x > 1.03. |
161 | Therefore max ULP error of A + B is ~0.502. */ |
162 | return A + B; |
163 | } |
164 | |
165 | #ifndef __ieee754_log |
166 | strong_alias (__ieee754_log, __log_finite) |
167 | #endif |
168 | |