X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcell.lisp;h=5a4b846ede97ee9f1baa0186718affbdd222d2fd;hb=9627f5a03e642fa950e1557fef17c506dfd386a6;hp=2a02340276fd9b50bd5f8fba5fb727ff085bbede;hpb=c6538bf61955a67d0145aa3e6c937f6dd03f9e51;p=sbcl.git

diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index 2a02340..5a4b846 100644
--- 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)
@@ -607,6 +616,14 @@
     (inst mov (make-ea-for-raw-slot object index tmp) value)
     (move result value)))
 
+(define-vop (raw-instance-init/word)
+  (:args (object :scs (descriptor-reg))
+         (value :scs (unsigned-reg)))
+  (:arg-types * unsigned-num)
+  (:info instance-length index)
+  (:generator 4
+    (inst mov (make-ea-for-raw-slot object index instance-length) value)))
+
 (define-vop (raw-instance-ref/single)
   (:translate %raw-instance-ref/single)
   (:policy :fast-safe)
@@ -678,6 +695,14 @@
    (unless (location= result value)
      (inst movss result value))))
 
+(define-vop (raw-instance-init/single)
+  (:args (object :scs (descriptor-reg))
+         (value :scs (single-reg)))
+  (:arg-types * single-float)
+  (:info instance-length index)
+  (:generator 4
+    (inst movss (make-ea-for-raw-slot object index instance-length) value)))
+
 (define-vop (raw-instance-ref/double)
   (:translate %raw-instance-ref/double)
   (:policy :fast-safe)
@@ -749,6 +774,14 @@
    (unless (location= result value)
      (inst movsd result value))))
 
+(define-vop (raw-instance-init/double)
+  (:args (object :scs (descriptor-reg))
+         (value :scs (double-reg)))
+  (:arg-types * double-float)
+  (:info instance-length index)
+  (:generator 4
+    (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)
   (:policy :fast-safe)
@@ -840,6 +873,17 @@
       (unless (location= value-imag result-imag)
         (inst movss result-imag value-imag)))))
 
+(define-vop (raw-instance-init/complex-single)
+  (:args (object :scs (descriptor-reg))
+         (value :scs (complex-single-reg)))
+  (:arg-types * complex-single-float)
+  (:info instance-length index)
+  (:generator 4
+    (let ((value-real (complex-single-reg-real-tn value)))
+      (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 instance-length 4) value-imag))))
+
 (define-vop (raw-instance-ref/complex-double)
   (:translate %raw-instance-ref/complex-double)
   (:policy :fast-safe)
@@ -930,3 +974,14 @@
       (inst movsd (make-ea-for-raw-slot object index tmp) value-imag)
       (unless (location= value-imag result-imag)
         (inst movsd result-imag value-imag)))))
+
+(define-vop (raw-instance-init/complex-double)
+  (:args (object :scs (descriptor-reg))
+         (value :scs (complex-double-reg)))
+  (:arg-types * complex-double-float)
+  (:info instance-length index)
+  (:generator 4
+    (let ((value-real (complex-double-reg-real-tn value)))
+      (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 instance-length) value-imag))))