From: Christophe Rhodes Date: Mon, 15 Sep 2003 13:14:54 +0000 (+0000) Subject: 0.8.3.66: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=02b6f6dfb38d99bcc3181035eb0681e6bb96b939;p=sbcl.git 0.8.3.66: Fix Alpha data corruption bug ... as with MIPS case a couple of months ago, index goes forwards through a string, not backwards. ... include a test case (how did that happen?) --- diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 283cf22..790d69e 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -379,7 +379,7 @@ (:result-types ,el-type) (:temporary (:sc non-descriptor-reg) temp) (:temporary (:sc non-descriptor-reg) temp1) - (:generator 5 + (:generator 4 ,@(ecase size (:byte (if signed @@ -472,32 +472,38 @@ (:temporary (:sc non-descriptor-reg) temp2) (:results (result :scs ,scs)) (:result-types ,el-type) - (:generator 5 + (:generator 4 ,@(ecase size (:byte - `((inst lda temp (- (* ,offset n-word-bytes) - (* index ,scale) ,lowtag) + `((inst lda temp (- (+ (* ,offset n-word-bytes) + (* index ,scale)) + ,lowtag) object) - (inst ldq_u temp1 (- (* ,offset n-word-bytes) - (* index ,scale) ,lowtag) + (inst ldq_u temp1 (- (+ (* ,offset n-word-bytes) + (* index ,scale)) + ,lowtag) object) (inst insbl value temp temp2) (inst mskbl temp1 temp temp1) (inst bis temp1 temp2 temp1) - (inst stq_u temp1 (- (* ,offset n-word-bytes) - (* index ,scale) ,lowtag) object))) + (inst stq_u temp1 (- (+ (* ,offset n-word-bytes) + (* index ,scale)) + ,lowtag) object))) (:short - `((inst lda temp (- (* ,offset n-word-bytes) - (* index ,scale) ,lowtag) + `((inst lda temp (- (+ (* ,offset n-word-bytes) + (* index ,scale)) + ,lowtag) object) - (inst ldq_u temp1 (- (* ,offset n-word-bytes) - (* index ,scale) ,lowtag) + (inst ldq_u temp1 (- (+ (* ,offset n-word-bytes) + (* index ,scale)) + ,lowtag) object) (inst mskwl temp1 temp temp1) (inst inswl value temp temp2) (inst bis temp1 temp2 temp) - (inst stq_u temp (- (* ,offset n-word-bytes) - (* index ,scale) ,lowtag) object)))) + (inst stq_u temp (- (+ (* ,offset n-word-bytes) + (* index ,scale)) + ,lowtag) object)))) (move value result)))))) (defmacro sb!sys::with-pinned-objects ((&rest objects) &body body) diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index 023e170..3eafab5 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -145,3 +145,13 @@ ;;; Bug reported by Kalle Olavi Niemitalo for CMUCL through Debian BTS (let ((array (make-array nil :initial-contents nil))) (assert (eql (aref array) nil))) + +(let ((f (compile nil '(lambda () + (let ((a (make-array '(4) + :element-type 'base-char + :initial-element #\z))) + (setf (aref a 0) #\a) + (setf (aref a 1) #\b) + (setf (aref a 2) #\c) + a))))) + (assert (= (length (funcall f)) 4))) diff --git a/version.lisp-expr b/version.lisp-expr index 2742376..333f29c 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.3.65" +"0.8.3.66"