From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 26 Sep 2008 16:24:01 +0000 (+0000)
Subject: 1.0.20.31: tweaking LOG
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=14e646e1fe2525f3375a0fa2b3770473ebf97e93;p=sbcl.git

1.0.20.31: tweaking LOG

 * In case of (LOG INTEGER DOUBLE) and (LOG DOUBLE INTEGER), don't use
   intermediate single precision values.

 * Fix unoptimized (LOG X 0.0d0) => 0.0d0, and (LOG DOUBLE 0) => 0.0d0
   (both were 0.0f0).
---

diff --git a/NEWS b/NEWS
index 18ffd73..daf653c 100644
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,10 @@
     owned by other threads anymore.
   * bug fix: FIND on lists called KEY outside the specified
     subsequence. (reported by budden)
+  * bug fix: LOG doesn't use single-float intermediate results when
+    given mixed integer and double-float arguments, leading to better
+    precision. (reported by Bob Felts)
+  * bug fix: LOG with base zero returned values of inconsistent type.
 
 changes in sbcl-1.0.20 relative to 1.0.19:
   * minor incompatible change: OPTIMIZE qualities
diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 65c96f1..79be34a 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -335,11 +335,19 @@
   "Return the logarithm of NUMBER in the base BASE, which defaults to e."
   (if base-p
       (cond
-        ((zerop base) 0f0) ; FIXME: type
+        ((zerop base)
+         (if (or (typep number 'double-float) (typep base 'double-float))
+             0.0d0
+             0.0f0))
         ((and (typep number '(integer (0) *))
               (typep base '(integer (0) *)))
          (coerce (/ (log2 number) (log2 base)) 'single-float))
-        (t (/ (log number) (log base))))
+        ((or (and (typep number 'integer) (typep base 'double-float))
+             (and (typep number 'double-float) (typep base 'integer)))
+         ;; No single float intermediate result
+         (/ (log2 number) (log base 2.0d0)))
+        (t
+         (/ (log number) (log base))))
       (number-dispatch ((number number))
         (((foreach fixnum bignum))
          (if (minusp number)
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index 7acc048..5140bbd 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -202,3 +202,30 @@
       (test (not (> nan nan)))
       (test (not (> -1.0 nan)))
       (test (not (> nan 1.0))))))
+
+(with-test (:name :log-int/double-accuracy)
+  ;; we used to use single precision for intermediate results
+  (assert (eql 2567.6046442221327d0
+               (log (loop for n from 1 to 1000 for f = 1 then (* f n)
+                          finally (return f))
+                    10d0))))
+
+(with-test (:name :log-base-zero-return-type)
+  (assert (eql 0.0f0 (log 123 (eval 0))))
+  (assert (eql 0.0d0 (log 123.0d0 (eval 0))))
+  (assert (eql 0.0d0 (log 123 (eval 0.0d0))))
+  (let ((f (compile nil '(lambda (x y)
+                          (declare (optimize speed))
+                          (etypecase x
+                            (single-float
+                             (etypecase y
+                               (single-float (log x y))
+                               (double-float (log x y))))
+                            (double-float
+                             (etypecase y
+                               (single-float (log x y))
+                               (double-float (log x y)))))))))
+    (assert (eql 0.0f0 (funcall f 123.0 0.0)))
+    (assert (eql 0.0d0 (funcall f 123.0d0 0.0)))
+    (assert (eql 0.0d0 (funcall f 123.0d0 0.0d0)))
+    (assert (eql 0.0d0 (funcall f 123.0 0.0d0)))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 8402b33..30863b0 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.20.30"
+"1.0.20.31"