From: Paul Khuong <pvk@pvk.ca>
Date: Tue, 12 Oct 2010 05:10:07 +0000 (+0000)
Subject: 1.0.43.47: Unfix ASH of constant shift on x86oids
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0c00c2fd86be43b18d2e42b1e4e05bed653168ec;p=sbcl.git

1.0.43.47: Unfix ASH of constant shift on x86oids

 * The fixnum=>fixnum VOPs for ASH used to explicitly handle shifts greater
   than the word length by computing a zero instead.  These should be
   constant-folded away in IR1 now.

 * 1.0.43.45 incidentally fixed lp #309063 (which is what the fix above
   was used for). Add a test case, update NEWS, and note the optimizations
   committed in 1.0.43.{42,43,47}.
---

diff --git a/NEWS b/NEWS
index 3ee72d0..6946f85 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,14 @@ changes relative to sbcl-1.0.43:
   * enhancement: ATOMIC-INCF now supports AREF of (SIMPLE-ARRAY SB-EXT:WORD (*))
     as a place.
   * enhancement: ASDF has been updated to 2.009.
+  * optimization: constant-folding exploits numeric and character types, in
+    addition member types.
+  * optimization: numeric, character and member types that are inhabited by
+    exactly one value are tested with EQL.
+  * optimization: more conditional branches are eliminated during IR1.
+    Branches are simplified before performing if/if-conversion, and simple
+    equivalent branches (that only read the same constant or variable) are
+    merged.
   * bug fix: compiler failed to derive the result-type of MAKE-ARRAY as
     (AND VECTOR (NOT SIMPLE-ARRAY)) when appropriate. (lp#309130)
   * bug fix: (THE (VALUES ...)) in LOAD-TIME-VALUE caused a compiler-error.
@@ -41,6 +49,8 @@ changes relative to sbcl-1.0.43:
     and issued pointles code-deletion notes for it, :PREFIX, and :SUFFIX.
   * bug fix: the compiler didn't utilize the proclaimed ftype for functions
     also declared NOTINLINE. (lp#655581)
+  * bug fix: the compiler could attempt to emit constant left shifts of 
+    greater value than n-word-bits. (lp#309063)
 
 changes in sbcl-1.0.43 relative to sbcl-1.0.42:
   * incompatible change: FD-STREAMS no longer participate in the serve-event
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index cfe4ad4..cc41f3d 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -667,6 +667,8 @@
                                        (location= number result)))))
   (:result-types tagged-num)
   (:note "inline ASH")
+  (:variant nil)
+  (:variant-vars modularp)
   (:generator 2
     (cond ((and (= amount 1) (not (location= number result)))
            (inst lea result (make-ea :qword :base number :index number)))
@@ -685,8 +687,11 @@
                         (inst sar result (- amount))
                         (inst and result (lognot fixnum-tag-mask)))))
                  ((plusp amount)
+                  (unless modularp
+                    (aver (not "Impossible: fixnum ASH should not be called with
+constant shift greater than word length")))
                   (if (sc-is result any-reg)
-                      (inst xor result result)
+                      (zeroize result)
                       (inst mov result 0)))
                  (t (inst sar result 63)
                     (inst and result (lognot fixnum-tag-mask))))))))
@@ -1367,6 +1372,7 @@
 
 (define-vop (fast-ash-left-smod61-c/fixnum=>fixnum
              fast-ash-c/fixnum=>fixnum)
+  (:variant :modular)
   (:translate ash-left-smod61))
 (define-vop (fast-ash-left-smod61/fixnum=>fixnum
              fast-ash-left/fixnum=>fixnum))
diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 4abd9c6..be39dbd 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -597,6 +597,8 @@
                                        (location= number result)))))
   (:result-types tagged-num)
   (:note "inline ASH")
+  (:variant nil)
+  (:variant-vars modularp)
   (:generator 2
     (cond ((and (= amount 1) (not (location= number result)))
            (inst lea result (make-ea :dword :base number :index number)))
@@ -615,8 +617,11 @@
                         (inst sar result (- amount))
                         (inst and result (lognot fixnum-tag-mask)))))
                  ((plusp amount)
+                  (unless modularp
+                    (aver (not "Impossible: fixnum ASH should not be called with
+constant shift greater than word length")))
                   (if (sc-is result any-reg)
-                      (inst xor result result)
+                      (zeroize result)
                       (inst mov result 0)))
                  (t (inst sar result 31)
                     (inst and result (lognot fixnum-tag-mask))))))))
@@ -1325,6 +1330,7 @@
 
 (define-vop (fast-ash-left-smod30-c/fixnum=>fixnum
              fast-ash-c/fixnum=>fixnum)
+  (:variant :modular)
   (:translate ash-left-smod30))
 
 (define-vop (fast-ash-left-smod30/fixnum=>fixnum
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 5435c43..b2c287c 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3590,3 +3590,9 @@
     ;; Compile time should not explode just because there's a big constant
     ;; object in the source.
     (assert (> 10 (abs (- (- t1 t0) (- t2 t1)))))))
+
+(with-test (:name :bug-309063)
+  (let ((fun (compile nil `(lambda (x)
+                             (declare (type (integer 0 0) x))
+                             (ash x 100)))))
+    (assert (zerop (funcall fun 0)))))
diff --git a/version.lisp-expr b/version.lisp-expr
index b1d24d0..ac9f45a 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.43.46"
+"1.0.43.47"