[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-09-19-g315ea23

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  315ea23408772763fc0f141d51bf5038269f0b7c (commit)
      from  b35582689da356d07250728b74f22d7c55e81000 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 315ea23408772763fc0f141d51bf5038269f0b7c
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Fri Sep 26 20:20:54 2014 -0700

    Fix incorrect value from INTEGER-DECODE-FLOAT for denormals.
    
    This is a long standing bug where INTEGER-DECODE-FLOAT returned
    incorrect values for denormal double-float numbers.  The lower 32 bits
    of the double were not shifted enough when creating the integer
    result.
    
    As a side-effect, DECODE-FLOAT decodes denormal double-float's
    correctly and SCALE-FLOAT scales denormals correctly too.
    
     * src/code/float.lisp:
       * Shift the lower 32-bit of the fraction one more time to adjust
         for the fact that the upper 20 bits were shifted an extra time.
     * tests/float.lisp:
       * Add several tests for INTEGER-DECODE-FLOAT, SCALE-FLOAT, and
         DECODE-FLOAT.
     * src/general-info/release-20f.txt:
       * Add this bug fix to the notes.

diff --git a/src/code/float.lisp b/src/code/float.lisp
index cace1a4..3ac6512 100644
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -581,7 +581,7 @@
 	      (return))
 	    (setq sig (ash sig 1))
 	    (incf extra-bias))
-	  (values (logior (ash sig 32) (ash low-bits (1- extra-bias)))
+	  (values (logior (ash sig 32) (ash low-bits (1+ extra-bias)))
 		  (truly-the fixnum (- biased extra-bias))
 		  sign)))))
 
diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt
index 0327f5b..4fd57e3 100644
--- a/src/general-info/release-20f.txt
+++ b/src/general-info/release-20f.txt
@@ -123,6 +123,10 @@ New in this release:
     * For linux, motifd is no longer a 64-bit app.
     * (exp 1d0) now returns the correctly rounded value of
       e. Previously, it was off by one bit.
+    * INTEGER-DECODE-FLOAT returns the correct values for denormal
+      doubles. As a side-effect of this fix, DECODE-FLOAT returns the
+      correct values for denormals, and SCALE-FLOAT scales denormals
+      correctly.
 
   * Trac Tickets:
     * Ticket #90 fixed.
diff --git a/tests/float.lisp b/tests/float.lisp
index 55b9013..71cdeb8 100644
--- a/tests/float.lisp
+++ b/tests/float.lisp
@@ -42,4 +42,77 @@
       (assert-equalp k (clog10 x)))))
 
 
+(define-test integer-decode-float.double
+  ;; Generate 100 random denormal values and compare what
+  ;; integer-decode-float returns against what it should return.
+  (dotimes (k 100)
+    (let ((x (random least-positive-normalized-double-float)))
+      (multiple-value-bind (hi lo)
+	  (kernel:double-float-bits x)
+	;; Verify that the exponent is 0, which it must be for a
+	;; denormal number.
+	(assert-equal 0
+		      (ldb vm:double-float-exponent-byte hi)
+		      x)
+	;; Print out the fraction bits, and the bits returned by
+	;; INTEGER-DECODE-FLOAT. We could do this differently, but
+	;; this has the nice side effect of making it easy to see what
+	;; is expected and what went wrong.
+	(let* ((expected (format nil "~b~32,'0b" hi lo))
+	       (actual (format nil "~b" (integer-decode-float x)))
+	       (tail (subseq actual (length expected))))
+	  ;; If everything is working correctly, the beginning of the
+	  ;; actual bits must exactly match the expected bits.
+	  (assert-true (every #'char=
+			      expected
+			      actual)
+			x
+			expected
+			actual)
+	  ;; And finally, the trailing part of the actual bits must be
+	  ;; all zeroes, but this is a denormal number.
+	  (assert-true (every #'(lambda (c)
+				  (char= c #\0))
+			      tail)
+		       x
+		       tail))))))
+
+(define-test scale-float.double
+  ;; As a side-effect of fixing INTEGER-DECODE-FLOAT, SCALE-FLOAT
+  ;; should return the correct values now when scaling
+  ;; denormals. Check a few denormal values.
+  (dotimes (k 100)
+    (let* ((x (random least-positive-normalized-double-float))
+	   (scaled (scale-float x 54))
+	   (mult (* x (scale-float 1d0 54))))
+      ;; The result of SCALE-FLOAT and the multiplication should be
+      ;; exactly equal because the multiplication by 2^54 is exactly
+      ;; representable.
+      (assert-equal scaled
+		    mult
+		    x
+		    scaled
+		    mult)))
+  ;; Add the test caused the investigation of SCALE-FLOAT
+  (let* ((x 1d-310)
+	 (scaled (scale-float x 54))
+	 (mult (* x (scale-float 1d0 54))))
+    (assert-equal scaled
+		    mult
+		    x
+		    scaled
+		    mult)))
+
+(define-test decode-float.double
+  ;; As a side-effect of fixing INTEGER-DECODE-FLOAT, DECODE-FLOAT
+  ;; should return the correct values now. We just spot check one
+  ;; value here.
+  (dotimes (k 100)
+    (let ((x (random least-positive-normalized-double-float)))
+      (multiple-value-bind (f e)
+	  (decode-float x)
+	(assert-equal x
+		      (scale-float f e)
+		      f
+		      e)))))
 

-----------------------------------------------------------------------

Summary of changes:
 src/code/float.lisp              |    2 +-
 src/general-info/release-20f.txt |    4 +++
 tests/float.lisp                 |   73 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 78 insertions(+), 1 deletion(-)


hooks/post-receive
-- 
CMU Common Lisp