0.8.0.77:

        * Fixed DATA-VECTOR-SET-C/SIMPLE-BIT-VECTOR with index 0 on
          X86 (found by Paul Dietz).

diff --git a/NEWS b/NEWS
index 82970ef..d349adc 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1873,6 +1873,7 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0:
        otherwise, it creates a new class.
     ** SLOT-UNBOUND now correctly initalizes the CELL-ERROR-NAME slot
        of the UNBOUND-SLOT condition to the name of the slot.
+    ** (SETF (AREF bv 0) ...) did not work for bit vectors.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp
index 7228e6d..50f1717 100644 (file)
--- a/src/compiler/x86/array.lisp
+++ b/src/compiler/x86/array.lisp
@@ -271,10 +271,11 @@
               (unsigned-reg
                (let ((shift (* extra ,bits)))
                  (unless (zerop shift)
-                   (inst ror old shift)
-                   (inst and old (lognot ,(1- (ash 1 bits))))
-                   (inst or old value)
-                   (inst rol old shift)))))
+                   (inst ror old shift))
+                  (inst and old (lognot ,(1- (ash 1 bits))))
+                  (inst or old value)
+                 (unless (zerop shift)
+                    (inst rol old shift)))))
             (inst mov (make-ea :dword :base object
                                :disp (- (* (+ word vector-data-offset)
                                            n-word-bytes)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 60e30b6..043de60 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -445,3 +445,14 @@
                               '(lambda ()
                                 (declare (notinline mapcar))
                                 (1+ (mapcar #'print '(1 2 3)))))))
+
+;; bug found by Paul Dietz: (SETF AREF) for bit vectors with constant
+;; index was effectless
+(let ((f (compile nil '(lambda (a v)
+                        (declare (type simple-bit-vector a) (type bit v))
+                        (declare (optimize (speed 3) (safety 0)))
+                        (setf (aref a 0) v)
+                        a))))
+  (let ((y (make-array 2 :element-type 'bit :initial-element 0)))
+    (assert (equal y #*00))
+    (funcall f y 1)

diff --git a/version.lisp-expr b/version.lisp-expr
index 2bafa9f..bdb6f26 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.0.76"
+"0.8.0.77"