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.

diff --git a/NEWS b/NEWS
index a36521c..75ded23 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (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.19.7"
+"0.8.19.8"