1.0.9.59: Fix ash/smod61 on x86-64 for constant large shifts.

	Thanks to Paul Khuong for the translation.

diff --git a/NEWS b/NEWS
index 33cdc48..447969d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -30,7 +30,8 @@ changes in sbcl-1.0.10 relative to sbcl-1.0.9:
   * bug fix: copy propagation interfered with parallel assignment
     semantics in local calls. (reported by Paul Khuong)
   * bug fix: the signed modular fixnum shift compiled to wrong code on
-    x86.  (spotted by a slight modification to some of PFD's tests)
+    x86 and x86-64.  (spotted by a slight modification to some of
+    PFD's random tests)
 
 changes in sbcl-1.0.9 relative to sbcl-1.0.8:
   * minor incompatible change: SB-SYS:OUTPUT-RAW-BYTES is deprecated.

diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index 3e55ac2..1f63042 100644 (file)
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -600,19 +600,20 @@
            (inst lea result (make-ea :qword :index number :scale 8)))
           (t
            (move result number)
-           (cond ((plusp amount)
-                  ;; We don't have to worry about overflow because of the
-                  ;; result type restriction.
-                  (inst shl result amount))
-                 (t
-                  ;; Since the shift instructions take the shift amount
-                  ;; modulo 64 we must special case amounts of 64 and more.
-                  ;; Because fixnums have only 61 bits, the result is 0 or
-                  ;; -1 for all amounts of 60 or more, so use this as the
-                  ;; limit instead.
-                  (inst sar result (min (- n-word-bits n-fixnum-tag-bits 1)
-                                        (- amount)))
-                  (inst and result (lognot fixnum-tag-mask))))))))
+           (cond ((< -64 amount 64)
+                  ;; this code is used both in ASH and ASH-SMOD61, so
+                  ;; be careful
+                  (if (plusp amount)
+                      (inst shl result amount)
+                      (progn
+                        (inst sar result (- amount))
+                        (inst and result (lognot fixnum-tag-mask)))))
+                 ((plusp amount)
+                  (if (sc-is result any-reg)
+                      (inst xor result result)
+                      (inst mov result 0)))
+                 (t (inst sar result 63)
+                    (inst and result (lognot fixnum-tag-mask))))))))
 
 (define-vop (fast-ash-left/fixnum=>fixnum)
   (:translate ash)

diff --git a/version.lisp-expr b/version.lisp-expr
index 1564240..2774615 100644 (file)
--- 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.9.58"
+"1.0.9.59"