From c5159b9f0da46023e65b65a82c911d8d9816dc3e Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 31 Jan 2005 16:57:22 +0000 Subject: [PATCH] 0.8.19.8: Fix bugs in COUNT and EQUAL on bit-vectors with round lengths (Lutz Euler 'Bug in "count" on bit-vectors' sbcl-devel 2005-01-29) ... off by one, sigh; ... tests, but FIXME: haven't tested whether the new code is efficient. --- NEWS | 3 +++ src/compiler/generic/vm-tran.lisp | 9 ++++----- tests/compiler.pure.lisp | 27 +++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 35 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index a36521c..75ded23 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,9 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19: related to the ~@F format directive. * fixed bug: SET-SYNTAX-FROM-CHAR correctly shallow-copies a dispatch table if the from-char is a dispatch macro character. + * fixed bug: COUNT and EQUAL on bit vectors with lengths divisible + by the wordsize no longer ignore the last word. (reported by Lutz + Euler) * fixed some bugs related to Unicode integration: ** portions of multibyte characters at the end of buffers for character-based file input are correctly transferred to the diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 1489bac..7866594 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -317,7 +317,7 @@ (end-1 (+ sb!vm:vector-data-offset (floor (1- length) sb!vm:n-word-bits)))) ((= i end-1) - (let* ((extra (mod length sb!vm:n-word-bits)) + (let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits))) (mask (1- (ash 1 extra))) (numx (logand @@ -335,8 +335,7 @@ (:big-endian '(- sb!vm:n-word-bits extra)))) (%raw-bits y i)))) - (declare (type (mod #.sb!vm:n-word-bits) - extra) + (declare (type (integer 1 #.sb!vm:n-word-bits) extra) (type sb!vm:word mask numx numy)) (= numx numy))) (declare (type index i end-1)) @@ -357,7 +356,7 @@ (truncate (truly-the index (1- length)) sb!vm:n-word-bits)))) ((= index end-1) - (let* ((extra (mod length sb!vm:n-word-bits)) + (let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits))) (mask (1- (ash 1 extra))) (bits (logand (ash mask ,(ecase sb!c:*backend-byte-order* @@ -365,7 +364,7 @@ (:big-endian '(- sb!vm:n-word-bits extra)))) (%raw-bits sequence index)))) - (declare (type (mod #.sb!vm:n-word-bits) extra)) + (declare (type (integer 1 #.sb!vm:n-word-bits) extra)) (declare (type sb!vm:word mask bits)) ;; could consider LOGNOT for the zero case instead of ;; doing the subtraction... diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index b9dacd9..29b6b0c 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1691,3 +1691,30 @@ (funcall f array1) (setf (aref array2 i) v) (assert (equal array1 array2)))))) + +(let ((fn (compile nil '(lambda (x) + (declare (type bit x)) + (declare (optimize speed)) + (let ((b (make-array 64 :element-type 'bit + :initial-element 0))) + (count x b)))))) + (assert (= (funcall fn 0) 64)) + (assert (= (funcall fn 1) 0))) + +(let ((fn (compile nil '(lambda (x y) + (declare (type simple-bit-vector x y)) + (declare (optimize speed)) + (equal x y))))) + (assert (funcall + fn + (make-array 64 :element-type 'bit :initial-element 0) + (make-array 64 :element-type 'bit :initial-element 0))) + (assert (not + (funcall + fn + (make-array 64 :element-type 'bit :initial-element 0) + (let ((b (make-array 64 :element-type 'bit :initial-element 0))) + (setf (sbit b 63) 1) + b))))) + + \ No newline at end of file diff --git a/version.lisp-expr b/version.lisp-expr index 5072090..4d5cc98 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.19.7" +"0.8.19.8" -- 1.7.10.4