X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcell.lisp;h=a5114eb7541b81d92a00eafe0f33d9bc65397686;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=b7687f7e44c5c7fed78de21a7a449de92f648662;hpb=79a8e51bf4b06a5bd57bc90233605f98fee3b041;p=sbcl.git

diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index b7687f7..a5114eb 100644
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -530,7 +530,7 @@
   (: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))))
 
@@ -563,7 +563,7 @@
   (: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)
     (move result value)))
@@ -626,7 +626,7 @@
   (: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))))
 
@@ -659,11 +659,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))))
+    (move result value)))
 
 (define-vop (raw-instance-set-c/single)
   (:translate %raw-instance-set/single)
@@ -682,8 +681,7 @@
     (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))))
+    (move result value)))
 
 (define-vop (raw-instance-init/single)
   (:args (object :scs (descriptor-reg))
@@ -705,7 +703,7 @@
   (: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))))
 
@@ -738,11 +736,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))))
+    (move result value)))
 
 (define-vop (raw-instance-set-c/double)
   (:translate %raw-instance-set/double)
@@ -761,8 +758,7 @@
     (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))))
+    (move result value)))
 
 (define-vop (raw-instance-init/double)
   (:args (object :scs (descriptor-reg))
@@ -784,12 +780,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 index tmp))))
 
 (define-vop (raw-instance-ref-c/complex-single)
   (:translate %raw-instance-ref/complex-single)
@@ -805,10 +798,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 index tmp))))
 
 (define-vop (raw-instance-set/complex-single)
   (:translate %raw-instance-set/complex-single)
@@ -823,18 +813,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 index tmp) value)))
 
 (define-vop (raw-instance-set-c/complex-single)
   (:translate %raw-instance-set/complex-single)
@@ -852,16 +834,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 index tmp) value)))
 
 (define-vop (raw-instance-init/complex-single)
   (:args (object :scs (descriptor-reg))
@@ -869,10 +843,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 index instance-length) value)))
 
 (define-vop (raw-instance-ref/complex-double)
   (:translate %raw-instance-ref/complex-double)
@@ -886,12 +857,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 index tmp -8))))
 
 (define-vop (raw-instance-ref-c/complex-double)
   (:translate %raw-instance-ref/complex-double)
@@ -907,10 +875,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 index tmp -8))))
 
 (define-vop (raw-instance-set/complex-double)
   (:translate %raw-instance-set/complex-double)
@@ -925,18 +890,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 index tmp -8) value)))
 
 (define-vop (raw-instance-set-c/complex-double)
   (:translate %raw-instance-set/complex-double)
@@ -954,16 +911,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 index tmp -8) value)))
 
 (define-vop (raw-instance-init/complex-double)
   (:args (object :scs (descriptor-reg))
@@ -971,7 +920,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 index instance-length -8) value)))