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

@@ -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

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,15 +356,15 @@
                        (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*
 					       (:little-endian 0)
 					       (: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...

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)))))
+
+

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"