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 (file)
--- 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 (file)
--- 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 (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.3.65"
+"0.8.3.66"