0.8.3.31:

	Fix ASH bug on PPC
	... add a test for it, which will probably fail on most if not all
		other architectures.  To be continued...

diff --git a/NEWS b/NEWS
index 1774726..17c266a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2016,6 +2016,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
   * bug fix: ROUND and TRUNCATE could, under certain circumstances on
     the PPC platform, lead to stack corruption; this has been fixed.
     (reported by Rainer Joswig)
+  * bug fix: ASH on an (UNSIGNED-BYTE 32) with a shift of -32 or lower
+    no longer ever returns 1 instead of 0.  (thanks to Lars Brinkhoff)
   * optimization: restored some effective method precomputation in
     CLOS (turned off by an ANSI fix in sbcl-0.8.3); the amount of
     precomputation is now tunable.

diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp
index 56910ac..3d59350 100644 (file)
--- a/src/compiler/ppc/arith.lisp
+++ b/src/compiler/ppc/arith.lisp
@@ -18,7 +18,6 @@
   (:effects)
   (:affected))
 
-
 (define-vop (fixnum-unop fast-safe-arith-op)
   (:args (x :scs (any-reg)))
   (:results (res :scs (any-reg)))
@@ -52,8 +51,6 @@
   (:translate lognot)
   (:generator 1
     (inst not res x)))
-
-
 \f
 ;;;; Binary fixnum operations.
 
@@ -83,7 +80,6 @@
   (:result-types signed-num)
   (:note "inline (signed-byte 32) arithmetic"))
 
-
 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
   (:args (x :target r :scs (any-reg zero)))
   (:info y)
@@ -272,7 +268,7 @@
         (inst cmpwi ndesc 31)
         (inst srw result number ndesc)
         (inst ble done)
-        (inst srwi result number 31)
+        (move result zero-tn)
         (inst b done)
 
         (emit-label positive)
@@ -280,14 +276,12 @@
         (inst slw result number amount)
 
         (emit-label done)))
-
       (immediate
        (let ((amount (tn-value amount)))
-        (if (minusp amount)
-            (let ((amount (min 31 (- amount))))
-              (inst srwi result number amount))
-            (inst slwi result number amount)))))))
-
+        (cond
+         ((and (minusp amount) (< amount -31)) (move result zero-tn))
+         ((minusp amount) (inst srwi result number (- amount)))
+         (t (inst slwi result number amount))))))))
 
 (define-vop (fast-ash/signed=>signed)
   (:note "inline ASH")

diff --git a/tests/arith.impure.lisp b/tests/arith.impure.lisp
index e45ab9f..27948bd 100644 (file)
--- a/tests/arith.impure.lisp
+++ b/tests/arith.impure.lisp
@@ -67,5 +67,30 @@
 (assert (= (compiled-logxor -6) -6))
 
 (assert (raises-error? (coerce (expt 10 1000) 'single-float) type-error))
+\f
+(defun are-we-getting-ash-right (x y)
+  (declare (optimize speed)
+          (type (unsigned-byte 32) x)
+          (type (integer -40 0) y))
+  (ash x y))
 
+(defun what-about-with-constants (x)
+  (declare (optimize speed) (type (unsigned-byte 32) x))
+  (ash x -32))
+
+(dotimes (i 41)
+  (assert (= (are-we-getting-ash-right (1- (ash 1 32)) (- i))
+            (if (< i 32)
+                (1- (ash 1 (- 32 i)))
+                0))))
+
+(assert (= (what-about-with-constants (1- (ash 1 32))) 0))
+
+(defun one-more-test-case-to-catch-sparc (x y)
+  (declare (optimize speed (safety 0))
+          (type (unsigned-byte 32) x) (type (integer -40 2) y))
+  (the (unsigned-byte 32) (ash x y)))
+
+(assert (= (one-more-test-case-to-catch-sparc (1- (ash 1 32)) -40) 0))
+\f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 3d5c056..338d658 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".)
-"0.8.3.30"
+"0.8.3.31"