1.0.23.66: Calculate array sizes in a more reliable way.

  * The old implementation depended on the array header size being
    an even number of words.

  * Also, another micro-optimization for MIPS.

diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp
index 2f6404c..936e3e5 100644 (file)
--- a/src/compiler/alpha/array.lisp
+++ b/src/compiler/alpha/array.lisp
@@ -22,7 +22,7 @@
   (:temporary (:scs (non-descriptor-reg)) header)
   (:results (result :scs (descriptor-reg)))
   (:generator 13
-    (inst addq rank (+ (* array-dimensions-offset n-word-bytes)
+    (inst addq rank (+ (* (1+ array-dimensions-offset) n-word-bytes)
                        lowtag-mask)
           bytes)
     (inst li (lognot lowtag-mask) header)

diff --git a/src/compiler/hppa/array.lisp b/src/compiler/hppa/array.lisp
index 72b59be..4ae7ef9 100644 (file)
--- a/src/compiler/hppa/array.lisp
+++ b/src/compiler/hppa/array.lisp
@@ -25,7 +25,8 @@
     (pseudo-atomic ()
       (inst move alloc-tn header)
       (inst dep other-pointer-lowtag 31 3 header)
-      (inst addi (* (1+ array-dimensions-offset) n-word-bytes) rank ndescr)
+      (inst addi (+ (* (1+ array-dimensions-offset) n-word-bytes) lowtag-mask)
+            rank ndescr)
       (inst dep 0 31 3 ndescr)
       (inst add alloc-tn ndescr alloc-tn)
       (inst addi (fixnumize (1- array-dimensions-offset)) rank ndescr)

diff --git a/src/compiler/mips/array.lisp b/src/compiler/mips/array.lisp
index 2f501b2..d16ea7e 100644 (file)
--- a/src/compiler/mips/array.lisp
+++ b/src/compiler/mips/array.lisp
@@ -18,18 +18,19 @@
   (:args (type :scs (any-reg))
          (rank :scs (any-reg)))
   (:arg-types positive-fixnum positive-fixnum)
-  (:temporary (:scs (any-reg)) bytes)
-  (:temporary (:scs (non-descriptor-reg)) header)
+  (:temporary (:scs (non-descriptor-reg)) bytes header)
   (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
   (:results (result :scs (descriptor-reg)))
   (:generator 13
-    (inst addu bytes rank (+ (* array-dimensions-offset n-word-bytes)
+    (inst addu bytes rank (+ (* (1+ array-dimensions-offset) n-word-bytes)
                              lowtag-mask))
-    (inst li header (lognot lowtag-mask))
-    (inst and bytes header)
+    (inst srl bytes n-lowtag-bits)
+    (inst sll bytes n-lowtag-bits)
     (inst addu header rank (fixnumize (1- array-dimensions-offset)))
     (inst sll header n-widetag-bits)
-    (inst or header header type)
+    (inst or header type)
+    ;; Remove the extraneous fixnum tag bits because TYPE and RANK
+    ;; were fixnums
     (inst srl header n-fixnum-tag-bits)
     (pseudo-atomic (pa-flag)
       (inst or result alloc-tn other-pointer-lowtag)

diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp
index 7c096ae..0bdeb7d 100644 (file)
--- a/src/compiler/ppc/array.lisp
+++ b/src/compiler/ppc/array.lisp
@@ -28,7 +28,8 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 0
     (pseudo-atomic (pa-flag)
-      (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
+      (inst addi ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes)
+                                lowtag-mask))
       (inst clrrwi ndescr ndescr n-lowtag-bits)
       (allocation header ndescr other-pointer-lowtag
                   :temp-tn gc-temp

diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp
index 4b05ccb..fc49181 100644 (file)
--- a/src/compiler/sparc/array.lisp
+++ b/src/compiler/sparc/array.lisp
@@ -24,7 +24,8 @@
   (:generator 0
     (pseudo-atomic ()
       (inst or header alloc-tn other-pointer-lowtag)
-      (inst add ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
+      (inst add ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes)
+                               lowtag-mask))
       (inst andn ndescr 4)
       (inst add alloc-tn ndescr)
       (inst add ndescr rank (fixnumize (1- array-dimensions-offset)))
@@ -641,4 +642,4 @@
   (:arg-types * tagged-num unsigned-num)
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)
-  (:variant vector-data-offset other-pointer-lowtag))
\ No newline at end of file
+  (:variant vector-data-offset other-pointer-lowtag))

diff --git a/version.lisp-expr b/version.lisp-expr
index 824f239..3711650 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".)
-"1.0.23.65"
+"1.0.23.66"