[Cmucl-cvs] [git] CMU Common Lisp branch 20f-branch updated. snapshot-2014-09-12-gab0a979

[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, 20f-branch has been updated
       via  ab0a979db83310c64fcbbc13b178d5c31af9f5c9 (commit)
      from  878f7c4337d04265d067a90d29acca0d868cd35d (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 ab0a979db83310c64fcbbc13b178d5c31af9f5c9
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.
    
    Conflicts:
    	tests/float.lisp

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 6fe1f50..454ab99 100644
--- a/tests/float.lisp
+++ b/tests/float.lisp
@@ -10,3 +10,77 @@
 					 (declare (type (double-float (0d0)) x))
 					 (decode-float x)))
 			1d0)))
+
+(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                 |   74 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 79 insertions(+), 1 deletion(-)


hooks/post-receive
-- 
CMU Common Lisp