xref: /original-bsd/lib/libm/common_source/log.c (revision 2622b709)
1 /*
2  * Copyright (c) 1985 Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.redist.c%
6  *
7  * All recipients should regard themselves as participants in an ongoing
8  * research project and hence should feel obligated to report their
9  * experiences (good or bad) with these elementary function codes, using
10  * the sendbug(8) program, to the authors.
11  */
12 
13 #ifndef lint
14 static char sccsid[] = "@(#)log.c	5.5 (Berkeley) 06/01/90";
15 #endif /* not lint */
16 
17 /* LOG(X)
18  * RETURN THE LOGARITHM OF x
19  * DOUBLE PRECISION (VAX D FORMAT 56 bits or IEEE DOUBLE 53 BITS)
20  * CODED IN C BY K.C. NG, 1/19/85;
21  * REVISED BY K.C. NG on 2/7/85, 3/7/85, 3/24/85, 4/16/85.
22  *
23  * Required system supported functions:
24  *	scalb(x,n)
25  *	copysign(x,y)
26  *	logb(x)
27  *	finite(x)
28  *
29  * Required kernel function:
30  *	log__L(z)
31  *
32  * Method :
33  *	1. Argument Reduction: find k and f such that
34  *			x = 2^k * (1+f),
35  *	   where  sqrt(2)/2 < 1+f < sqrt(2) .
36  *
37  *	2. Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
38  *		 = 2s + 2/3 s**3 + 2/5 s**5 + .....,
39  *	   log(1+f) is computed by
40  *
41  *	     		log(1+f) = 2s + s*log__L(s*s)
42  *	   where
43  *		log__L(z) = z*(L1 + z*(L2 + z*(... (L6 + z*L7)...)))
44  *
45  *	   See log__L() for the values of the coefficients.
46  *
47  *	3. Finally,  log(x) = k*ln2 + log(1+f).  (Here n*ln2 will be stored
48  *	   in two floating point number: n*ln2hi + n*ln2lo, n*ln2hi is exact
49  *	   since the last 20 bits of ln2hi is 0.)
50  *
51  * Special cases:
52  *	log(x) is NaN with signal if x < 0 (including -INF) ;
53  *	log(+INF) is +INF; log(0) is -INF with signal;
54  *	log(NaN) is that NaN with no signal.
55  *
56  * Accuracy:
57  *	log(x) returns the exact log(x) nearly rounded. In a test run with
58  *	1,536,000 random arguments on a VAX, the maximum observed error was
59  *	.826 ulps (units in the last place).
60  *
61  * Constants:
62  * The hexadecimal values are the intended ones for the following constants.
63  * The decimal values may be used, provided that the compiler will convert
64  * from decimal to binary accurately enough to produce the hexadecimal values
65  * shown.
66  */
67 
68 #include <errno.h>
69 #include "mathimpl.h"
70 
71 vc(ln2hi, 6.9314718055829871446E-1  ,7217,4031,0000,f7d0,   0, .B17217F7D00000)
72 vc(ln2lo, 1.6465949582897081279E-12 ,bcd5,2ce7,d9cc,e4f1, -39, .E7BCD5E4F1D9CC)
73 vc(sqrt2, 1.4142135623730950622E0   ,04f3,40b5,de65,33f9,   1, .B504F333F9DE65)
74 
75 ic(ln2hi, 6.9314718036912381649E-1,   -1, 1.62E42FEE00000)
76 ic(ln2lo, 1.9082149292705877000E-10, -33, 1.A39EF35793C76)
77 ic(sqrt2, 1.4142135623730951455E0,     0, 1.6A09E667F3BCD)
78 
79 #ifdef vccast
80 #define	ln2hi	vccast(ln2hi)
81 #define	ln2lo	vccast(ln2lo)
82 #define	sqrt2	vccast(sqrt2)
83 #endif
84 
85 
86 double log(x)
87 double x;
88 {
89 	const static double zero=0.0, negone= -1.0, half=1.0/2.0;
90 	double s,z,t;
91 	int k,n;
92 
93 #if !defined(vax)&&!defined(tahoe)
94 	if(x!=x) return(x);	/* x is NaN */
95 #endif	/* !defined(vax)&&!defined(tahoe) */
96 	if(finite(x)) {
97 	   if( x > zero ) {
98 
99 	   /* argument reduction */
100 	      k=logb(x);   x=scalb(x,-k);
101 	      if(k == -1022) /* subnormal no. */
102 		   {n=logb(x); x=scalb(x,-n); k+=n;}
103 	      if(x >= sqrt2 ) {k += 1; x *= half;}
104 	      x += negone ;
105 
106 	   /* compute log(1+x)  */
107               s=x/(2+x); t=x*x*half;
108 	      z=k*ln2lo+s*(t+log__L(s*s));
109 	      x += (z - t) ;
110 
111 	      return(k*ln2hi+x);
112 	   }
113 	/* end of if (x > zero) */
114 
115 	   else {
116 #if defined(vax)||defined(tahoe)
117 		if ( x == zero )
118 		    return (infnan(-ERANGE));	/* -INF */
119 		else
120 		    return (infnan(EDOM));	/* NaN */
121 #else	/* defined(vax)||defined(tahoe) */
122 		/* zero argument, return -INF with signal */
123 		if ( x == zero )
124 		    return( negone/zero );
125 
126 		/* negative argument, return NaN with signal */
127 		else
128 		    return ( zero / zero );
129 #endif	/* defined(vax)||defined(tahoe) */
130 	    }
131 	}
132     /* end of if (finite(x)) */
133     /* NOTREACHED if defined(vax)||defined(tahoe) */
134 
135     /* log(-INF) is NaN with signal */
136 	else if (x<0)
137 	    return(zero/zero);
138 
139     /* log(+INF) is +INF */
140 	else return(x);
141 
142 }
143