134126Sbostic /* 2*56955Sbostic * Copyright (c) 1992 Regents of the University of California. 334126Sbostic * All rights reserved. 434126Sbostic * 542657Sbostic * %sccs.include.redist.c% 624601Szliu */ 724601Szliu 824601Szliu #ifndef lint 9*56955Sbostic static char sccsid[] = "@(#)log.c 5.7 (Berkeley) 12/02/92"; 1034126Sbostic #endif /* not lint */ 1124601Szliu 12*56955Sbostic #include <math.h> 13*56955Sbostic #include <errno.h> 14*56955Sbostic 15*56955Sbostic #include "log_table.h" 16*56955Sbostic #include "dmath.h" 17*56955Sbostic 18*56955Sbostic /* Table-driven natural logarithm. 1924601Szliu * 20*56955Sbostic * This code was derived, with minor modifications, from: 21*56955Sbostic * Peter Tang, "Table-Driven Implementation of the 22*56955Sbostic * Logarithm in IEEE Floating-Point arithmetic." ACM Trans. 23*56955Sbostic * Math Software, vol 16. no 4, pp 378-400, Dec 1990). 2424601Szliu * 25*56955Sbostic * Calculates log(2^m*F*(1+f/F)), |f/j| <= 1/256, 26*56955Sbostic * where F = j/128 for j an integer in [0, 128]. 2724601Szliu * 28*56955Sbostic * log(2^m) = log2_hi*m + log2_tail*m 29*56955Sbostic * since m is an integer, the dominant term is exact. 30*56955Sbostic * m has at most 10 digits (for subnormal numbers), 31*56955Sbostic * and log2_hi has 11 trailing zero bits. 3224601Szliu * 33*56955Sbostic * log(F) = logF_hi[j] + logF_lo[j] is in tabular form in log_table.h 34*56955Sbostic * logF_hi[] + 512 is exact. 3524601Szliu * 36*56955Sbostic * log(1+f/F) = 2*f/(2*F + f) + 1/12 * (2*f/(2*F + f))**3 + ... 37*56955Sbostic * the leading term is calculated to extra precision in two 38*56955Sbostic * parts, the larger of which adds exactly to the dominant 39*56955Sbostic * m and F terms. 40*56955Sbostic * There are two cases: 41*56955Sbostic * 1. when m, j are non-zero (m | j), use absolute 42*56955Sbostic * precision for the leading term. 43*56955Sbostic * 2. when m = j = 0, |1-x| < 1/256, and log(x) ~= (x-1). 44*56955Sbostic * In this case, use a relative precision of 24 bits. 45*56955Sbostic * (This is done differently in the original paper) 4624601Szliu * 4724601Szliu * Special cases: 48*56955Sbostic * 0 return signalling -Inf 49*56955Sbostic * neg return signalling NaN 50*56955Sbostic * +Inf return +Inf 51*56955Sbostic */ 5224601Szliu 53*56955Sbostic #if defined(vax) || defined(tahoe) 54*56955Sbostic #define _IEEE 0 55*56955Sbostic #define TRUNC(x) (double) (float) (x) 56*56955Sbostic #else 57*56955Sbostic #define _IEEE 1 58*56955Sbostic #define TRUNC(x) *(((int *) &x) + 1) &= 0xf8000000 59*56955Sbostic #define infnan(x) 0.0 60*56955Sbostic #endif 6124601Szliu 62*56955Sbostic double 63*56955Sbostic #ifdef _ANSI_SOURCE 64*56955Sbostic log(double x) 65*56955Sbostic #else 66*56955Sbostic log(x) double x; 67*56955Sbostic #endif 68*56955Sbostic { 69*56955Sbostic int m, j; 70*56955Sbostic double F, f, g, q, u, u2, v, zero = 0.0, one = 1.0; 71*56955Sbostic double logb(), ldexp(); 72*56955Sbostic volatile double u1; 7335679Sbostic 74*56955Sbostic /* Catch special cases */ 75*56955Sbostic if (x <= 0) 76*56955Sbostic if (_IEEE && x == zero) /* log(0) = -Inf */ 77*56955Sbostic return (-one/zero); 78*56955Sbostic else if (_IEEE) /* log(neg) = NaN */ 79*56955Sbostic return (zero/zero); 80*56955Sbostic else if (x == zero) /* NOT REACHED IF _IEEE */ 81*56955Sbostic return (infnan(-ERANGE)); 82*56955Sbostic else 83*56955Sbostic return (infnan(EDOM)); 84*56955Sbostic else if (!finite(x)) 85*56955Sbostic if (_IEEE) /* x = NaN, Inf */ 86*56955Sbostic return (x+x); 87*56955Sbostic else 88*56955Sbostic return (infnan(ERANGE)); 89*56955Sbostic 90*56955Sbostic /* Argument reduction: 1 <= g < 2; x/2^m = g; */ 91*56955Sbostic /* y = F*(1 + f/F) for |f| <= 2^-8 */ 9235679Sbostic 93*56955Sbostic m = logb(x); 94*56955Sbostic g = ldexp(x, -m); 95*56955Sbostic if (_IEEE && m == -1022) { 96*56955Sbostic j = logb(g), m += j; 97*56955Sbostic g = ldexp(g, -j); 98*56955Sbostic } 99*56955Sbostic j = N*(g-1) + .5; 100*56955Sbostic F = (1.0/N) * j + 1; /* F*128 is an integer in [128, 512] */ 101*56955Sbostic f = g - F; 10235679Sbostic 103*56955Sbostic /* Approximate expansion for log(1+f/F) ~= u + q */ 104*56955Sbostic g = 1/(2*F+f); 105*56955Sbostic u = 2*f*g; 106*56955Sbostic v = u*u; 107*56955Sbostic q = u*v*(A1 + v*(A2 + v*(A3 + v*A4))); 10835679Sbostic 109*56955Sbostic /* case 1: u1 = u rounded to 2^-43 absolute. Since u < 2^-8, 110*56955Sbostic * u1 has at most 35 bits, and F*u1 is exact, as F has < 8 bits. 111*56955Sbostic * It also adds exactly to |m*log2_hi + log_F_head[j] | < 750 112*56955Sbostic */ 113*56955Sbostic if (m | j) 114*56955Sbostic u1 = u + 513, u1 -= 513; 11524601Szliu 116*56955Sbostic /* case 2: |1-x| < 1/256. The m- and j- dependent terms are zero; 117*56955Sbostic * u1 = u to 24 bits. 118*56955Sbostic */ 119*56955Sbostic else 120*56955Sbostic u1 = u, TRUNC(u1); 121*56955Sbostic u2 = (2.0*(f - F*u1) - u1*f) * g; 122*56955Sbostic /* u1 + u2 = 2f/(2F+f) to extra precision. */ 12324601Szliu 124*56955Sbostic /* log(x) = log(2^m*F*(1+f/F)) = */ 125*56955Sbostic /* (m*log2_hi+logF_head[j]+u1) + (m*log2_lo+logF_tail[j]+q); */ 126*56955Sbostic /* (exact) + (tiny) */ 12724601Szliu 128*56955Sbostic u1 += m*logF_head[N] + logF_head[j]; /* exact */ 129*56955Sbostic u2 = (u2 + logF_tail[j]) + q; /* tiny */ 130*56955Sbostic u2 += logF_tail[N]*m; 131*56955Sbostic return (u1 + u2); 132*56955Sbostic } 13324601Szliu 134*56955Sbostic /* Extra precision variant, returning 135*56955Sbostic * struct {double a, b;}; log(x) = a+b to 63 bits, with 136*56955Sbostic * a is rounded to 26 bits. 137*56955Sbostic */ 138*56955Sbostic struct Double 139*56955Sbostic #ifdef _ANSI_SOURCE 140*56955Sbostic log__D(double x) 141*56955Sbostic #else 142*56955Sbostic log__D(x) double x; 143*56955Sbostic #endif 144*56955Sbostic { 145*56955Sbostic int m, j; 146*56955Sbostic double F, f, g, q, u, v, u2; 147*56955Sbostic double logb(), ldexp(); 148*56955Sbostic volatile double u1; 149*56955Sbostic struct Double r; 15024601Szliu 151*56955Sbostic /* Argument reduction: 1 <= g < 2; x/2^m = g; */ 152*56955Sbostic /* y = F*(1 + f/F) for |f| <= 2^-8 */ 15324601Szliu 154*56955Sbostic m = logb(x); 155*56955Sbostic g = ldexp(x, -m); 156*56955Sbostic if (_IEEE && m == -1022) { 157*56955Sbostic j = logb(g), m += j; 158*56955Sbostic g = ldexp(g, -j); 15924601Szliu } 160*56955Sbostic j = N*(g-1) + .5; 161*56955Sbostic F = (1.0/N) * j + 1; 162*56955Sbostic f = g - F; 16324601Szliu 164*56955Sbostic g = 1/(2*F+f); 165*56955Sbostic u = 2*f*g; 166*56955Sbostic v = u*u; 167*56955Sbostic q = u*v*(A1 + v*(A2 + v*(A3 + v*A4))); 168*56955Sbostic if (m | j) 169*56955Sbostic u1 = u + 513, u1 -= 513; 170*56955Sbostic else 171*56955Sbostic u1 = u, TRUNC(u1); 172*56955Sbostic u2 = (2.0*(f - F*u1) - u1*f) * g; 17324601Szliu 174*56955Sbostic u1 += m*logF_head[N] + logF_head[j]; 17524601Szliu 176*56955Sbostic u2 += logF_tail[j]; u2 += q; 177*56955Sbostic u2 += logF_tail[N]*m; 178*56955Sbostic r.a = u1 + u2; /* Only difference is here */ 179*56955Sbostic TRUNC(r.a); 180*56955Sbostic r.b = (u1 - r.a) + u2; 181*56955Sbostic return (r); 18224601Szliu } 183