1.0.17.7: smaller and faster raw slot initialization on x86oids

 * Since %MAKE-STRUCTURE-INSTANCE knows exactly how long the instance
   will be, RAW-INSTANCE-INIT/* VOPs don't need to fetch the length at
   all, but can receive it as a direct argument.

 * Use (* INDEX N-WORD-BYTES) in MAKE-EA-FOR-RAW-SLOT instead of
   (FIXNUMIZE INDEX) -- same result, but the intention becomes clear.

diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp
index 19527a6..5df3845 100644 (file)
--- a/src/compiler/generic/vm-ir2tran.lisp
+++ b/src/compiler/generic/vm-ir2tran.lisp
@@ -53,7 +53,7 @@
          res)
     (move-lvar-result node block locs lvar)))
 
-(defun emit-inits (node block name object lowtag inits args)
+(defun emit-inits (node block name object lowtag instance-length inits args)
   (let ((unbound-marker-tn nil)
         (funcallable-instance-tramp-tn nil))
     (dolist (init inits)
@@ -72,7 +72,7 @@
                                          `(,(sb!kernel::raw-slot-data-raw-type rsd)
                                             (vop ,(sb!kernel::raw-slot-data-init-vop rsd)
                                                  node block
-                                                 object arg-tn slot)))
+                                                 object arg-tn instance-length slot)))
                                        #!+raw-instance-init-vops
                                        sb!kernel::*raw-slot-data-list*
                                        #!-raw-instance-init-vops
@@ -123,7 +123,7 @@
          (locs (lvar-result-tns lvar (list *backend-t-primitive-type*)))
          (result (first locs)))
     (emit-fixed-alloc node block name words type lowtag result lvar)
-    (emit-inits node block name result lowtag inits args)
+    (emit-inits node block name result lowtag words inits args)
     (move-lvar-result node block locs lvar)))
 
 (defoptimizer ir2-convert-variable-allocation
@@ -136,7 +136,7 @@
           (emit-fixed-alloc node block name words type lowtag result lvar))
         (vop var-alloc node block (lvar-tn node block extra) name words
              type lowtag result))
-    (emit-inits node block name result lowtag inits args)
+    (emit-inits node block name result lowtag nil inits args)
     (move-lvar-result node block locs lvar)))
 
 (defoptimizer ir2-convert-structure-allocation
@@ -150,7 +150,7 @@
            (c-slot-specs (lvar-value slot-specs))
            (words (+ (sb!kernel::dd-instance-length c-dd) words)))
       (emit-fixed-alloc node block name words type lowtag result lvar)
-      (emit-inits node block name result lowtag `((:dd . ,c-dd) ,@c-slot-specs) args)
+      (emit-inits node block name result lowtag words `((:dd . ,c-dd) ,@c-slot-specs) args)
       (move-lvar-result node block locs lvar))))
 
 ;;; :SET-TRANS (in objdef.lisp DEFINE-PRIMITIVE-OBJECT) doesn't quite

diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index 213c900..5a4b846 100644 (file)
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -19,7 +19,7 @@
   (:ignore name)
   (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
-    (loadw result object offset lowtag)))
+   (loadw result object offset lowtag)))
 
 (define-vop (set-slot)
   (:args (object :scs (descriptor-reg))
@@ -525,19 +525,28 @@
 
 (defun make-ea-for-raw-slot (object index instance-length
                              &optional (adjustment 0))
-  (etypecase index
-    (tn
-     (make-ea :qword :base object :index instance-length
-              :disp (+ (* (1- instance-slots-offset) n-word-bytes)
-                       (- instance-pointer-lowtag)
-                       adjustment)))
-    (integer
-     (make-ea :qword :base object :index instance-length
-              :scale 8
-              :disp (+ (* (1- instance-slots-offset) n-word-bytes)
-                       (- instance-pointer-lowtag)
-                       adjustment
-                       (- (fixnumize index)))))))
+  (if (integerp instance-length)
+      ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
+      ;; at compile time.
+      (make-ea :qword
+               :base object
+               :disp (+ (* (- instance-length instance-slots-offset index)
+                           n-word-bytes)
+                        (- instance-pointer-lowtag)
+                        adjustment))
+      (etypecase index
+        (tn
+         (make-ea :qword :base object :index instance-length
+                  :disp (+ (* (1- instance-slots-offset) n-word-bytes)
+                           (- instance-pointer-lowtag)
+                           adjustment)))
+        (integer
+         (make-ea :qword :base object :index instance-length
+                  :scale 8
+                  :disp (+ (* (1- instance-slots-offset) n-word-bytes)
+                           (- instance-pointer-lowtag)
+                           adjustment
+                           (* index (- n-word-bytes))))))))
 
 (define-vop (raw-instance-ref/word)
   (:translate %raw-instance-ref/word)
@@ -611,12 +620,9 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (unsigned-reg)))
   (:arg-types * unsigned-num)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 4
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
-    (inst mov (make-ea-for-raw-slot object index tmp) value)))
+    (inst mov (make-ea-for-raw-slot object index instance-length) value)))
 
 (define-vop (raw-instance-ref/single)
   (:translate %raw-instance-ref/single)
@@ -690,17 +696,12 @@
      (inst movss result value))))
 
 (define-vop (raw-instance-init/single)
-  (:translate %raw-instance-set/single)
-  (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
          (value :scs (single-reg)))
   (:arg-types * single-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 4
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
-    (inst movss (make-ea-for-raw-slot object index tmp) value)))
+    (inst movss (make-ea-for-raw-slot object index instance-length) value)))
 
 (define-vop (raw-instance-ref/double)
   (:translate %raw-instance-ref/double)
@@ -777,12 +778,9 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (double-reg)))
   (:arg-types * double-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 4
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
-    (inst movsd (make-ea-for-raw-slot object index tmp) value)))
+    (inst movsd (make-ea-for-raw-slot object index instance-length) value)))
 
 (define-vop (raw-instance-ref/complex-single)
   (:translate %raw-instance-ref/complex-single)
@@ -879,15 +877,12 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (complex-single-reg)))
   (:arg-types * complex-single-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 4
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
     (let ((value-real (complex-single-reg-real-tn value)))
-      (inst movss (make-ea-for-raw-slot object index tmp) value-real))
+      (inst movss (make-ea-for-raw-slot object index instance-length) value-real))
     (let ((value-imag (complex-single-reg-imag-tn value)))
-      (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag))))
+      (inst movss (make-ea-for-raw-slot object index instance-length 4) value-imag))))
 
 (define-vop (raw-instance-ref/complex-double)
   (:translate %raw-instance-ref/complex-double)
@@ -984,12 +979,9 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (complex-double-reg)))
   (:arg-types * complex-double-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 4
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
     (let ((value-real (complex-double-reg-real-tn value)))
-      (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real))
+      (inst movsd (make-ea-for-raw-slot object index instance-length -8) value-real))
     (let ((value-imag (complex-double-reg-imag-tn value)))
-      (inst movsd (make-ea-for-raw-slot object index tmp) value-imag))))
+      (inst movsd (make-ea-for-raw-slot object index instance-length) value-imag))))

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index 73cfc6f..168cad8 100644 (file)
--- a/src/compiler/x86/cell.lisp
+++ b/src/compiler/x86/cell.lisp
@@ -503,24 +503,32 @@
 ;;;; raw instance slot accessors
 
 (defun make-ea-for-raw-slot (object index instance-length n-words)
-  (flet ((make-ea-using-value (value)
-           (make-ea :dword :base object
-                    :index instance-length
-                    :scale 4
-                    :disp (- (* (- instance-slots-offset n-words)
-                                n-word-bytes)
-                             instance-pointer-lowtag
-                             (fixnumize value)))))
-    (if (typep index 'tn)
-        (sc-case index
-          (any-reg (make-ea :dword
-                            :base object
-                            :index instance-length
-                            :disp (- (* (- instance-slots-offset n-words)
-                                        n-word-bytes)
-                                     instance-pointer-lowtag)))
-          (immediate (make-ea-using-value (tn-value index))))
-        (make-ea-using-value index))))
+  (if (integerp instance-length)
+      ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
+      ;; at compile time.
+      (make-ea :dword
+               :base object
+               :disp (- (* (- instance-length instance-slots-offset index (1- n-words))
+                           n-word-bytes)
+                        instance-pointer-lowtag))
+      (flet ((make-ea-using-value (value)
+               (make-ea :dword :base object
+                        :index instance-length
+                        :scale 4
+                        :disp (- (* (- instance-slots-offset n-words)
+                                    n-word-bytes)
+                                 instance-pointer-lowtag
+                                 (* value n-word-bytes)))))
+        (if (typep index 'tn)
+            (sc-case index
+              (any-reg (make-ea :dword
+                                :base object
+                                :index instance-length
+                                :disp (- (* (- instance-slots-offset n-words)
+                                            n-word-bytes)
+                                         instance-pointer-lowtag)))
+              (immediate (make-ea-using-value (tn-value index))))
+            (make-ea-using-value index)))))
 
 (define-vop (raw-instance-ref/word)
   (:translate %raw-instance-ref/word)
@@ -561,12 +569,9 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (unsigned-reg)))
   (:arg-types * unsigned-num)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 5
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
-    (inst mov (make-ea-for-raw-slot object index tmp 1) value)))
+    (inst mov (make-ea-for-raw-slot object index instance-length 1) value)))
 
 (define-vop (raw-instance-ref/single)
   (:translate %raw-instance-ref/single)
@@ -619,13 +624,10 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (single-reg)))
   (:arg-types * single-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 5
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
     (with-tn@fp-top (value)
-      (inst fst (make-ea-for-raw-slot object index tmp 1)))))
+      (inst fst (make-ea-for-raw-slot object index instance-length 1)))))
 
 (define-vop (raw-instance-ref/double)
   (:translate %raw-instance-ref/double)
@@ -678,13 +680,10 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (double-reg)))
   (:arg-types * double-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 5
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
     (with-tn@fp-top (value)
-      (inst fstd (make-ea-for-raw-slot object index tmp 2)))))
+      (inst fstd (make-ea-for-raw-slot object index instance-length 2)))))
 
 (define-vop (raw-instance-ref/complex-single)
   (:translate %raw-instance-ref/complex-single)
@@ -756,17 +755,14 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (complex-single-reg)))
   (:arg-types * complex-single-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 5
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
     (let ((value-real (complex-single-reg-real-tn value)))
       (with-tn@fp-top (value-real)
-        (inst fst (make-ea-for-raw-slot object index tmp 2))))
+        (inst fst (make-ea-for-raw-slot object index instance-length 2))))
     (let ((value-imag (complex-single-reg-imag-tn value)))
       (with-tn@fp-top (value-imag)
-        (inst fst (make-ea-for-raw-slot object index tmp 1))))))
+        (inst fst (make-ea-for-raw-slot object index instance-length 1))))))
 
 (define-vop (raw-instance-ref/complex-double)
   (:translate %raw-instance-ref/complex-double)
@@ -838,14 +834,11 @@
   (:args (object :scs (descriptor-reg))
          (value :scs (complex-double-reg)))
   (:arg-types * complex-double-float)
-  (:info index)
-  (:temporary (:sc unsigned-reg) tmp)
+  (:info instance-length index)
   (:generator 20
-    (loadw tmp object 0 instance-pointer-lowtag)
-    (inst shr tmp n-widetag-bits)
     (let ((value-real (complex-double-reg-real-tn value)))
       (with-tn@fp-top (value-real)
-        (inst fstd (make-ea-for-raw-slot object index tmp 4))))
+        (inst fstd (make-ea-for-raw-slot object index instance-length 4))))
     (let ((value-imag (complex-double-reg-imag-tn value)))
       (with-tn@fp-top (value-imag)
-        (inst fstd (make-ea-for-raw-slot object index tmp 2))))))
+        (inst fstd (make-ea-for-raw-slot object index instance-length 2))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 15686ab..11ae740 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.17.6"
+"1.0.17.7"