stack-allocatable fill-initialized specialized arrays, take 2

[sbcl.git] / src / compiler / x86-64 / cell.lisp

diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index b7687f7..a27dc19 100644 (file)
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -47,6 +47,8 @@
         ;; Else, value not immediate.
         (storew value object offset lowtag))))
 
+(define-vop (init-slot set-slot))
+
 (define-vop (compare-and-swap-slot)
   (:args (object :scs (descriptor-reg) :to :eval)
          (old :scs (descriptor-reg any-reg) :target rax)
@@ -237,7 +239,7 @@
     ;; it is a fixnum.  The lowtag selection magic that is required to
     ;; ensure this is explained in the comment in objdef.lisp
     (loadw res symbol symbol-hash-slot other-pointer-lowtag)
-    (inst and res (lognot #b111))))
+    (inst and res (lognot fixnum-tag-mask))))
 \f
 ;;;; fdefinition (FDEFN) objects
 
@@ -452,6 +454,12 @@
 
 (define-vop (closure-init slot-set)
   (:variant closure-info-offset fun-pointer-lowtag))
+
+(define-vop (closure-init-from-fp)
+  (:args (object :scs (descriptor-reg)))
+  (:info offset)
+  (:generator 4
+    (storew rbp-tn object (+ closure-info-offset offset) fun-pointer-lowtag)))
 \f
 ;;;; value cell hackery
 
@@ -494,8 +502,8 @@
 \f
 ;;;; raw instance slot accessors
 
-(defun make-ea-for-raw-slot (object index instance-length
-                             &optional (adjustment 0))
+(defun make-ea-for-raw-slot (object instance-length
+                             &key (index nil) (adjustment 0) (scale 1))
   (if (integerp instance-length)
       ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length
       ;; at compile time.
@@ -506,8 +514,8 @@
                         (- instance-pointer-lowtag)
                         adjustment))
       (etypecase index
-        (tn
-         (make-ea :qword :base object :index instance-length
+        (null
+         (make-ea :qword :base object :index instance-length :scale scale
                   :disp (+ (* (1- instance-slots-offset) n-word-bytes)
                            (- instance-pointer-lowtag)
                            adjustment)))
@@ -530,9 +538,9 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (inst mov value (make-ea-for-raw-slot object index tmp))))
+    (inst mov value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
 
 (define-vop (raw-instance-ref-c/word)
   (:translate %raw-instance-ref/word)
@@ -548,7 +556,7 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst mov value (make-ea-for-raw-slot object index tmp))))
+    (inst mov value (make-ea-for-raw-slot object tmp :index index))))
 
 (define-vop (raw-instance-set/word)
   (:translate %raw-instance-set/word)
@@ -563,9 +571,9 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (inst mov (make-ea-for-raw-slot object index tmp) value)
+    (inst mov (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
     (move result value)))
 
 (define-vop (raw-instance-set-c/word)
@@ -584,7 +592,7 @@
   (: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 tmp :index index) value)
     (move result value)))
 
 (define-vop (raw-instance-init/word)
@@ -593,17 +601,17 @@
   (:arg-types * unsigned-num)
   (:info instance-length index)
   (:generator 4
-    (inst mov (make-ea-for-raw-slot object index instance-length) value)))
+    (inst mov (make-ea-for-raw-slot object instance-length :index index) value)))
 
 (define-vop (raw-instance-atomic-incf-c/word)
   (:translate %raw-instance-atomic-incf/word)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
-         (diff :scs (signed-reg) :target result))
+         (diff :scs (unsigned-reg) :target result))
   (:arg-types * (:constant (load/store-index #.n-word-bytes
                                              #.instance-pointer-lowtag
                                              #.instance-slots-offset))
-              signed-num)
+              unsigned-num)
   (:info index)
   (:temporary (:sc unsigned-reg) tmp)
   (:results (result :scs (unsigned-reg)))
@@ -611,7 +619,7 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst xadd (make-ea-for-raw-slot object index tmp) diff :lock)
+    (inst xadd (make-ea-for-raw-slot object tmp :index index) diff :lock)
     (move result diff)))
 
 (define-vop (raw-instance-ref/single)
@@ -626,9 +634,9 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (inst movss value (make-ea-for-raw-slot object index tmp))))
+    (inst movss value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
 
 (define-vop (raw-instance-ref-c/single)
   (:translate %raw-instance-ref/single)
@@ -644,7 +652,7 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst movss value (make-ea-for-raw-slot object index tmp))))
+    (inst movss value (make-ea-for-raw-slot object tmp :index index))))
 
 (define-vop (raw-instance-set/single)
   (:translate %raw-instance-set/single)
@@ -659,11 +667,10 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (inst movss (make-ea-for-raw-slot object index tmp) value)
-   (unless (location= result value)
-     (inst movss result value))))
+    (inst movss (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
+    (move result value)))
 
 (define-vop (raw-instance-set-c/single)
   (:translate %raw-instance-set/single)
@@ -681,9 +688,8 @@
   (: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)
-   (unless (location= result value)
-     (inst movss result value))))
+    (inst movss (make-ea-for-raw-slot object tmp :index index) value)
+    (move result value)))
 
 (define-vop (raw-instance-init/single)
   (:args (object :scs (descriptor-reg))
@@ -691,7 +697,7 @@
   (:arg-types * single-float)
   (:info instance-length index)
   (:generator 4
-    (inst movss (make-ea-for-raw-slot object index instance-length) value)))
+    (inst movss (make-ea-for-raw-slot object instance-length :index index) value)))
 
 (define-vop (raw-instance-ref/double)
   (:translate %raw-instance-ref/double)
@@ -705,9 +711,9 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (inst movsd value (make-ea-for-raw-slot object index tmp))))
+    (inst movsd value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
 
 (define-vop (raw-instance-ref-c/double)
   (:translate %raw-instance-ref/double)
@@ -723,7 +729,7 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst movsd value (make-ea-for-raw-slot object index tmp))))
+    (inst movsd value (make-ea-for-raw-slot object tmp :index index))))
 
 (define-vop (raw-instance-set/double)
   (:translate %raw-instance-set/double)
@@ -738,11 +744,10 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (inst movsd (make-ea-for-raw-slot object index tmp) value)
-   (unless (location= result value)
-     (inst movsd result value))))
+    (inst movsd (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)
+    (move result value)))
 
 (define-vop (raw-instance-set-c/double)
   (:translate %raw-instance-set/double)
@@ -760,9 +765,8 @@
   (: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)
-   (unless (location= result value)
-     (inst movsd result value))))
+    (inst movsd (make-ea-for-raw-slot object tmp :index index) value)
+    (move result value)))
 
 (define-vop (raw-instance-init/double)
   (:args (object :scs (descriptor-reg))
@@ -770,7 +774,7 @@
   (:arg-types * double-float)
   (:info instance-length index)
   (:generator 4
-    (inst movsd (make-ea-for-raw-slot object index instance-length) value)))
+    (inst movsd (make-ea-for-raw-slot object instance-length :index index) value)))
 
 (define-vop (raw-instance-ref/complex-single)
   (:translate %raw-instance-ref/complex-single)
@@ -784,12 +788,9 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (let ((real-tn (complex-single-reg-real-tn value)))
-      (inst movss real-tn (make-ea-for-raw-slot object index tmp)))
-    (let ((imag-tn (complex-single-reg-imag-tn value)))
-      (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4)))))
+    (inst movq value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))))))
 
 (define-vop (raw-instance-ref-c/complex-single)
   (:translate %raw-instance-ref/complex-single)
@@ -805,10 +806,7 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (let ((real-tn (complex-single-reg-real-tn value)))
-      (inst movss real-tn (make-ea-for-raw-slot object index tmp)))
-    (let ((imag-tn (complex-single-reg-imag-tn value)))
-      (inst movss imag-tn (make-ea-for-raw-slot object index tmp 4)))))
+    (inst movq value (make-ea-for-raw-slot object tmp :index index))))
 
 (define-vop (raw-instance-set/complex-single)
   (:translate %raw-instance-set/complex-single)
@@ -823,18 +821,10 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (let ((value-real (complex-single-reg-real-tn value))
-          (result-real (complex-single-reg-real-tn result)))
-      (inst movss (make-ea-for-raw-slot object index tmp) value-real)
-      (unless (location= value-real result-real)
-        (inst movss result-real value-real)))
-    (let ((value-imag (complex-single-reg-imag-tn value))
-          (result-imag (complex-single-reg-imag-tn result)))
-      (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag)
-      (unless (location= value-imag result-imag)
-        (inst movss result-imag value-imag)))))
+    (move result value)
+    (inst movq (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits))) value)))
 
 (define-vop (raw-instance-set-c/complex-single)
   (:translate %raw-instance-set/complex-single)
@@ -852,16 +842,8 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (let ((value-real (complex-single-reg-real-tn value))
-          (result-real (complex-single-reg-real-tn result)))
-      (inst movss (make-ea-for-raw-slot object index tmp) value-real)
-      (unless (location= value-real result-real)
-        (inst movss result-real value-real)))
-    (let ((value-imag (complex-single-reg-imag-tn value))
-          (result-imag (complex-single-reg-imag-tn result)))
-      (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag)
-      (unless (location= value-imag result-imag)
-        (inst movss result-imag value-imag)))))
+    (move result value)
+    (inst movq (make-ea-for-raw-slot object tmp :index index) value)))
 
 (define-vop (raw-instance-init/complex-single)
   (:args (object :scs (descriptor-reg))
@@ -869,10 +851,7 @@
   (: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))))
+    (inst movq (make-ea-for-raw-slot object instance-length :index index) value)))
 
 (define-vop (raw-instance-ref/complex-double)
   (:translate %raw-instance-ref/complex-double)
@@ -886,12 +865,9 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (let ((real-tn (complex-double-reg-real-tn value)))
-      (inst movsd real-tn (make-ea-for-raw-slot object index tmp -8)))
-    (let ((imag-tn (complex-double-reg-imag-tn value)))
-      (inst movsd imag-tn (make-ea-for-raw-slot object index tmp)))))
+    (inst movdqu value (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8))))
 
 (define-vop (raw-instance-ref-c/complex-double)
   (:translate %raw-instance-ref/complex-double)
@@ -907,10 +883,7 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (let ((real-tn (complex-double-reg-real-tn value)))
-      (inst movsd real-tn (make-ea-for-raw-slot object index tmp -8)))
-    (let ((imag-tn (complex-double-reg-imag-tn value)))
-      (inst movsd imag-tn (make-ea-for-raw-slot object index tmp)))))
+    (inst movdqu value (make-ea-for-raw-slot object tmp :index index :adjustment -8))))
 
 (define-vop (raw-instance-set/complex-double)
   (:translate %raw-instance-set/complex-double)
@@ -925,18 +898,10 @@
   (:generator 5
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (inst shl tmp 3)
+    (inst shl tmp n-fixnum-tag-bits)
     (inst sub tmp index)
-    (let ((value-real (complex-double-reg-real-tn value))
-          (result-real (complex-double-reg-real-tn result)))
-      (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real)
-      (unless (location= value-real result-real)
-        (inst movsd result-real value-real)))
-    (let ((value-imag (complex-double-reg-imag-tn value))
-          (result-imag (complex-double-reg-imag-tn result)))
-      (inst movsd (make-ea-for-raw-slot object index tmp) value-imag)
-      (unless (location= value-imag result-imag)
-        (inst movsd result-imag value-imag)))))
+    (move result value)
+    (inst movdqu (make-ea-for-raw-slot object tmp :scale (ash 1 (- word-shift n-fixnum-tag-bits)) :adjustment -8) value)))
 
 (define-vop (raw-instance-set-c/complex-double)
   (:translate %raw-instance-set/complex-double)
@@ -954,16 +919,8 @@
   (:generator 4
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
-    (let ((value-real (complex-double-reg-real-tn value))
-          (result-real (complex-double-reg-real-tn result)))
-      (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real)
-      (unless (location= value-real result-real)
-        (inst movsd result-real value-real)))
-    (let ((value-imag (complex-double-reg-imag-tn value))
-          (result-imag (complex-double-reg-imag-tn result)))
-      (inst movsd (make-ea-for-raw-slot object index tmp) value-imag)
-      (unless (location= value-imag result-imag)
-        (inst movsd result-imag value-imag)))))
+    (move result value)
+    (inst movdqu (make-ea-for-raw-slot object tmp :index index :adjustment -8) value)))
 
 (define-vop (raw-instance-init/complex-double)
   (:args (object :scs (descriptor-reg))
@@ -971,7 +928,4 @@
   (: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))))
+    (inst movdqu (make-ea-for-raw-slot object instance-length :index index :adjustment -8) value)))