From 315ea23408772763fc0f141d51bf5038269f0b7c Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Fri, 26 Sep 2014 20:20:54 -0700
Subject: [PATCH] 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.
---
 src/code/float.lisp              |  2 +-
 src/general-info/release-20f.txt |  4 ++
 tests/float.lisp                 | 73 ++++++++++++++++++++++++++++++++
 3 files changed, 78 insertions(+), 1 deletion(-)

diff --git a/src/code/float.lisp b/src/code/float.lisp
index cace1a464..3ac65127e 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 0327f5bbb..4fd57e3aa 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 55b901334..71cdeb83e 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)))))
 
-- 
GitLab