From b2c2a4e56cde254cc6c73b43704189b4b54ac834 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 3 Sep 2003 14:13:35 +0000 Subject: [PATCH] 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... --- NEWS | 2 ++ src/compiler/ppc/arith.lisp | 16 +++++----------- tests/arith.impure.lisp | 25 +++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 33 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index 1774726..17c266a 100644 --- 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 --- 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))) - - ;;;; 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 --- 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)) + +(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)) + (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 3d5c056..338d658 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".) -"0.8.3.30" +"0.8.3.31" -- 1.7.10.4