From f6d13b577869229af003c282eb81d65a4a51c713 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 17 Jun 2003 07:02:51 +0000 Subject: [PATCH] 0.8.0.77: * Fixed DATA-VECTOR-SET-C/SIMPLE-BIT-VECTOR with index 0 on X86 (found by Paul Dietz). --- NEWS | 1 + src/compiler/x86/array.lisp | 9 +++++---- tests/compiler.pure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 82970ef..d349adc 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4