More interleaved raw slot support.

NEWS

@@ -5,7 +5,7 @@ changes relative to sbcl-1.3.4:
   * enhancement: speed up debug info creation for highly nested functions.
     (lp#1563355)
   * enhancement: the interleaved structure slot optimization from
-    release 1.2.6 has been ported to 32-bit ARM.
+    release 1.2.6 has been ported to 32-bit ARM and MIPS.
   * bug fix: better wording in missed optimization note. (lp#1003265)
   * bug fix: interpreted (CAS SVREF) was broken
   * bug fix: support CLISP as build host for ARM (lp#1568256, thanks to Tomas

make-config.sh

@@ -665,7 +665,7 @@ elif [ "$sbcl_arch" = "x86-64" ]; then
     printf ' :float-eql-vops :integer-eql-vop :inline-constants :memory-barrier-vops' >> $ltf
     printf ' :multiply-high-vops :sb-simd-pack :ash-right-vops :symbol-info-vops' >> $ltf
 elif [ "$sbcl_arch" = "mips" ]; then
-    printf ' :cheneygc :linkage-table' >> $ltf
+    printf ' :cheneygc :interleaved-raw-slots :linkage-table' >> $ltf
     printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
     printf ' :alien-callbacks' >> $ltf

src/compiler/mips/cell.lisp

@@ -303,18 +303,11 @@
          (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (unsigned-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types unsigned-num)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset n-word-bytes)
-    (inst addu lip offset object)
-    (inst lw value lip (- (* instance-slots-offset n-word-bytes)
-                          instance-pointer-lowtag))))
+    (inst addu lip object index)
+    (loadw value lip instance-slots-offset instance-pointer-lowtag)))
 
 (define-vop (raw-instance-set/word)
   (:translate %raw-instance-set/word)
@@ -324,18 +317,11 @@
          (value :scs (unsigned-reg) :target result))
   (:arg-types * positive-fixnum unsigned-num)
   (:results (result :scs (unsigned-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types unsigned-num)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset n-word-bytes)
-    (inst addu lip offset object)
-    (inst sw value lip (- (* instance-slots-offset n-word-bytes)
-                          instance-pointer-lowtag))
+    (inst addu lip object index)
+    (storew value lip instance-slots-offset instance-pointer-lowtag)
     (move result value)))
 
 (define-vop (raw-instance-ref/single)
@@ -345,16 +331,10 @@
          (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (single-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types single-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset n-word-bytes)
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (inst lwc1 value lip (- (* instance-slots-offset n-word-bytes)
                             instance-pointer-lowtag))))
 
@@ -366,16 +346,10 @@
          (value :scs (single-reg) :target result))
   (:arg-types * positive-fixnum single-float)
   (:results (result :scs (single-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types single-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset n-word-bytes)
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (inst swc1 value lip (- (* instance-slots-offset n-word-bytes)
                             instance-pointer-lowtag))
     (unless (location= result value)
@@ -388,16 +362,10 @@
          (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (double-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types double-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset (* 2 n-word-bytes))
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
                                instance-pointer-lowtag)))
       (ecase *backend-byte-order*
@@ -417,16 +385,10 @@
          (value :scs (double-reg) :target result))
   (:arg-types * positive-fixnum double-float)
   (:results (result :scs (double-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types double-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset (* 2 n-word-bytes))
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
                                instance-pointer-lowtag)))
       (ecase *backend-byte-order*
@@ -447,16 +409,10 @@
          (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (complex-single-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types complex-single-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset (* 2 n-word-bytes))
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (inst lwc1
           (complex-single-reg-real-tn value)
           lip
@@ -476,16 +432,10 @@
          (value :scs (complex-single-reg) :target result))
   (:arg-types * positive-fixnum complex-single-float)
   (:results (result :scs (complex-single-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types complex-single-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset (* 2 n-word-bytes))
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (let ((value-real (complex-single-reg-real-tn value))
           (result-real (complex-single-reg-real-tn result)))
       (inst swc1
@@ -512,16 +462,10 @@
          (index :scs (any-reg)))
   (:arg-types * positive-fixnum)
   (:results (value :scs (complex-double-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types complex-double-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset (* 4 n-word-bytes))
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)
                                instance-pointer-lowtag)))
       (ecase *backend-byte-order*
@@ -575,16 +519,10 @@
          (value :scs (complex-double-reg) :target result))
   (:arg-types * positive-fixnum complex-double-float)
   (:results (result :scs (complex-double-reg)))
-  (:temporary (:scs (non-descriptor-reg)) offset)
   (:temporary (:scs (interior-reg)) lip)
   (:result-types complex-double-float)
   (:generator 5
-    (loadw offset object 0 instance-pointer-lowtag)
-    (inst srl offset n-widetag-bits)
-    (inst sll offset n-fixnum-tag-bits)
-    (inst subu offset index)
-    (inst subu offset (* 4 n-word-bytes))
-    (inst addu lip offset object)
+    (inst addu lip object index)
     (let ((value-real (complex-double-reg-real-tn value))
           (result-real (complex-double-reg-real-tn result)))
       (let ((immediate-offset (- (* instance-slots-offset n-word-bytes)

src/runtime/purify.c

@@ -815,9 +815,27 @@ pscav(lispobj *addr, long nwords, boolean constant)
                     struct instance *instance = (struct instance *) addr;
                     struct layout *layout
                         = (struct layout *) native_pointer(instance->slots[0]);
-                    long nuntagged = fixnum_value(layout->n_untagged_slots);
                     long nslots = HeaderValue(*addr);
+#ifndef LISP_FEATURE_INTERLEAVED_RAW_SLOTS
+                    long nuntagged = fixnum_value(layout->n_untagged_slots);
                     pscav(addr + 1, nslots - nuntagged, constant);
+#else
+                    int index;
+                    if (layout->untagged_bitmap == 0) {
+                      pscav(addr + 1, nslots, constant);
+                    } else if (fixnump(layout->untagged_bitmap)) {
+                      unsigned long bitmap = fixnum_value(layout->untagged_bitmap);
+                      for (index = 0; index < nslots ; index++, bitmap >>= 1)
+                        if (!(bitmap & 1))
+                          pscav(addr + 1 + index, 1, constant);
+                    } else {
+                      struct bignum * bitmap;
+                      bitmap = (struct bignum*)native_pointer(layout->untagged_bitmap);
+                      for (index = 0; index < nslots ; index++)
+                        if (!positive_bignum_logbitp(index, bitmap))
+                          pscav(addr + 1 + index, 1, constant);
+                    }
+#endif
                     count = CEILING(1 + nslots, 2);
                 }
                 break;