From: Christophe Rhodes Date: Mon, 15 Sep 2003 11:31:56 +0000 (+0000) Subject: 0.8.3.65: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=32d188868633a7c7db73da03f20ee5a107ed6f31;p=sbcl.git 0.8.3.65: More alpha backend stuff ... fix ASH ... -31 bug; ... fix LOGCOUNT bug found while investigating ASH bug. --- diff --git a/NEWS b/NEWS index 64cff56..9b4cd01 100644 --- a/NEWS +++ b/NEWS @@ -2031,6 +2031,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: * fixed bug 285: TRUNCATE on bignum arguments, and indeed bignum arithmetic in general, is now much more reliable on the PPC platform. + * bug fix: LOGCOUNT on (UNSIGNED-BYTE 64) objects on the Alpha platform + now returs the right answer. * 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/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index 5b07201..4dcde7d 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -24,7 +24,7 @@ (define-vop (signed-unop) (:args (x :scs (signed-reg))) (:results (res :scs (signed-reg))) - (:note "inline (signed-byte 32) arithmetic") + (:note "inline (signed-byte 64) arithmetic") (:arg-types signed-num) (:result-types signed-num) (:policy :fast-safe)) @@ -70,7 +70,7 @@ (:arg-types unsigned-num unsigned-num) (:results (r :scs (unsigned-reg))) (:result-types unsigned-num) - (:note "inline (unsigned-byte 32) arithmetic") + (:note "inline (unsigned-byte 64) arithmetic") (:effects) (:affected) (:policy :fast-safe)) @@ -81,7 +81,7 @@ (:arg-types signed-num signed-num) (:results (r :scs (signed-reg))) (:result-types signed-num) - (:note "inline (signed-byte 32) arithmetic") + (:note "inline (signed-byte 64) arithmetic") (:effects) (:affected) (:policy :fast-safe)) @@ -156,13 +156,13 @@ ;;;; shifting -(define-vop (fast-ash) +(define-vop (fast-ash/unsigned=>unsigned) (:note "inline ASH") - (:args (number :scs (signed-reg unsigned-reg) :to :save) + (:args (number :scs (unsigned-reg) :to :save) (amount :scs (signed-reg))) - (:arg-types (:or signed-num unsigned-num) signed-num) - (:results (result :scs (signed-reg unsigned-reg))) - (:result-types (:or signed-num unsigned-num)) + (:arg-types unsigned-num signed-num) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) (:translate ash) (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) @@ -170,47 +170,78 @@ (:generator 3 (inst bge amount positive) (inst subq zero-tn amount ndesc) - (inst cmplt ndesc 31 temp) - (sc-case number - (signed-reg (inst sra number ndesc result)) - (unsigned-reg (inst srl number ndesc result))) + (inst cmplt ndesc 64 temp) + (inst srl number ndesc result) + ;; FIXME: this looks like a candidate for a conditional move -- + ;; CSR, 2003-09-10 (inst bne temp done) - (sc-case number - (signed-reg (inst sra number 31 result)) - (unsigned-reg (inst srl number 31 result))) + (move zero-tn result) (inst br zero-tn done) POSITIVE - ;; The result-type assures us that this shift will not overflow. (inst sll number amount result) DONE)) -(define-vop (fast-ash-c) +(define-vop (fast-ash/signed=>signed) + (:note "inline ASH") + (:args (number :scs (signed-reg) :to :save) + (amount :scs (signed-reg))) + (:arg-types signed-num signed-num) + (:results (result :scs (signed-reg))) + (:result-types signed-num) + (:translate ash) + (:policy :fast-safe) + (:temporary (:sc non-descriptor-reg) ndesc) + (:temporary (:sc non-descriptor-reg :to :eval) temp) + (:generator 3 + (inst bge amount positive) + (inst subq zero-tn amount ndesc) + (inst cmplt ndesc 63 temp) + (inst sra number ndesc result) + (inst bne temp done) + (inst sra number 63 result) + (inst br zero-tn done) + + POSITIVE + (inst sll number amount result) + + DONE)) + +(define-vop (fast-ash-c/signed=>signed) (:policy :fast-safe) (:translate ash) (:note nil) - (:args (number :scs (signed-reg unsigned-reg))) + (:args (number :scs (signed-reg))) (:info count) - (:arg-types (:or signed-num unsigned-num) (:constant integer)) - (:results (result :scs (signed-reg unsigned-reg))) - (:result-types (:or signed-num unsigned-num)) + (:arg-types signed-num (:constant integer)) + (:results (result :scs (signed-reg))) + (:result-types signed-num) (:generator 1 - (cond ((< count 0) - ;; It is a right shift. - (sc-case number - (signed-reg (inst sra number (- count) result)) - (unsigned-reg (inst srl number (- count) result)))) - ((> count 0) - ;; It is a left shift. - (inst sll number count result)) - (t - ;; Count=0? Shouldn't happen, but it's easy: - (move number result))))) + (cond + ((< count 0) (inst sra number (- count) result)) + ((> count 0) (inst sll number count result)) + (t (bug "identity ASH not transformed away"))))) -(define-vop (signed-byte-32-len) +(define-vop (fast-ash-c/unsigned=>unsigned) + (:policy :fast-safe) + (:translate ash) + (:note nil) + (:args (number :scs (unsigned-reg))) + (:info count) + (:arg-types unsigned-num (:constant integer)) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (:generator 1 + (cond + ((< count -63) (move zero-tn result)) + ((< count 0) (inst sra number (- count) result)) + ((> count 0) (inst sll number count result)) + (t (bug "identity ASH not transformed away"))))) + +(define-vop (signed-byte-64-len) (:translate integer-length) - (:note "inline (signed-byte 32) integer-length") + (:note "inline (signed-byte 64) integer-length") (:policy :fast-safe) (:args (arg :scs (signed-reg) :to (:argument 1))) (:arg-types signed-num) @@ -220,16 +251,16 @@ (:generator 30 (inst not arg shift) (inst cmovge arg arg shift) - (inst subq zero-tn 4 res) + (inst subq zero-tn (fixnumize 1) res) (inst sll shift 1 shift) LOOP (inst addq res (fixnumize 1) res) (inst srl shift 1 shift) (inst bne shift loop))) -(define-vop (unsigned-byte-32-count) +(define-vop (unsigned-byte-64-count) (:translate logcount) - (:note "inline (unsigned-byte 32) logcount") + (:note "inline (unsigned-byte 64) logcount") (:policy :fast-safe) (:args (arg :scs (unsigned-reg) :target num)) (:arg-types unsigned-num) @@ -238,31 +269,38 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0) :target res) num) (:temporary (:scs (non-descriptor-reg)) mask temp) - (:generator 30 - (inst li #x55555555 mask) + (:generator 60 + ;; FIXME: now this looks expensive, what with these 64bit loads. + ;; Maybe a loop and count would be faster? -- CSR, 2003-09-10 + (inst li #x5555555555555555 mask) (inst srl arg 1 temp) (inst and arg mask num) (inst and temp mask temp) (inst addq num temp num) - (inst li #x33333333 mask) + (inst li #x3333333333333333 mask) (inst srl num 2 temp) (inst and num mask num) (inst and temp mask temp) (inst addq num temp num) - (inst li #x0f0f0f0f mask) + (inst li #x0f0f0f0f0f0f0f0f mask) (inst srl num 4 temp) (inst and num mask num) (inst and temp mask temp) (inst addq num temp num) - (inst li #x00ff00ff mask) + (inst li #x00ff00ff00ff00ff mask) (inst srl num 8 temp) (inst and num mask num) (inst and temp mask temp) (inst addq num temp num) - (inst li #x0000ffff mask) + (inst li #x0000ffff0000ffff mask) (inst srl num 16 temp) (inst and num mask num) (inst and temp mask temp) + (inst addq num temp num) + (inst li #x00000000ffffffff mask) + (inst srl num 32 temp) + (inst and num mask num) + (inst and temp mask temp) (inst addq num temp res))) ;;;; multiplying @@ -309,7 +347,7 @@ (:args (x :scs (signed-reg)) (y :scs (signed-reg))) (:arg-types signed-num signed-num) - (:note "inline (signed-byte 32) comparison")) + (:note "inline (signed-byte 64) comparison")) (define-vop (fast-conditional-c/signed fast-conditional/signed) (:args (x :scs (signed-reg))) @@ -320,7 +358,7 @@ (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num) - (:note "inline (unsigned-byte 32) comparison")) + (:note "inline (unsigned-byte 64) comparison")) (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) (:args (x :scs (unsigned-reg))) diff --git a/tests/arith.impure.lisp b/tests/arith.impure.lisp index 27948bd..e4c7e7d 100644 --- a/tests/arith.impure.lisp +++ b/tests/arith.impure.lisp @@ -73,7 +73,6 @@ (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)) @@ -83,14 +82,20 @@ (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)) + +(defun 64-bit-logcount (x) + (declare (optimize speed) (type (unsigned-byte 54) x)) + (logcount x)) +(assert (= (64-bit-logcount (1- (ash 1 24))) 24)) +(assert (= (64-bit-logcount (1- (ash 1 32))) 32)) +(assert (= (64-bit-logcount (1- (ash 1 48))) 48)) +(assert (= (64-bit-logcount (1- (ash 1 54))) 54)) (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index b02eef1..2742376 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.64" +"0.8.3.65"