[Sbcl-commits] CVS: sbcl/src/compiler/mips array.lisp,1.15,1.16

[Thiemo S. <th...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/mips
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv25684/src/compiler/mips

Modified Files:
	array.lisp 
Log Message:
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.


Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/array.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- array.lisp	17 Dec 2008 14:43:26 -0000	1.15
+++ array.lisp	23 Dec 2008 14:10:23 -0000	1.16
@@ -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)