1.0.27.40: host-invariant string constant coalescing

[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 213c900..e82cdd4 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))
@@ -59,11 +59,9 @@
   (:results (result :scs (descriptor-reg any-reg)))
   (:generator 5
      (move rax old)
-     #!+sb-thread
-     (inst lock)
      (inst cmpxchg (make-ea :qword :base object
                             :disp (- (* offset n-word-bytes) lowtag))
-           new)
+           new :lock)
      (move result rax)))
 \f
 ;;;; symbol hacking VOPs
@@ -95,13 +93,12 @@
               new)
         (inst cmp rax no-tls-value-marker-widetag)
         (inst jmp :ne check)
-        (move rax old)
-        (inst lock))
+        (move rax old))
       (inst cmpxchg (make-ea :qword :base symbol
                              :disp (- (* symbol-value-slot n-word-bytes)
                                       other-pointer-lowtag)
                              :scale 1)
-            new)
+            new :lock)
       (emit-label check)
       (move result rax)
       (inst cmp result unbound-marker-widetag)
@@ -214,19 +211,17 @@
   (:policy :fast-safe)
   (:generator 4
     (move result value)
-    (inst lock)
     (inst add (make-ea :qword :base object
                        :disp (- (* symbol-value-slot n-word-bytes)
                                 other-pointer-lowtag))
-          value)))
+          value :lock)))
 
 #!+sb-thread
 (define-vop (boundp)
   (:translate boundp)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg)))
-  (:conditional)
-  (:info target not-p)
+  (:conditional :ne)
   (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value)
   (:generator 9
     (let ((check-unbound-label (gen-label)))
@@ -237,21 +232,18 @@
       (inst jmp :ne check-unbound-label)
       (loadw value object symbol-value-slot other-pointer-lowtag)
       (emit-label check-unbound-label)
-      (inst cmp value unbound-marker-widetag)
-      (inst jmp (if not-p :e :ne) target))))
+      (inst cmp value unbound-marker-widetag))))
 
 #!-sb-thread
 (define-vop (boundp)
   (:translate boundp)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg)))
-  (:conditional)
-  (:info target not-p)
+  (:conditional :ne)
   (:generator 9
     (inst cmp (make-ea-for-object-slot object symbol-value-slot
                                        other-pointer-lowtag)
-          unbound-marker-widetag)
-    (inst jmp (if not-p :e :ne) target)))
+          unbound-marker-widetag)))
 
 
 (define-vop (symbol-hash)
@@ -525,19 +517,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 +612,28 @@
   (: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-atomic-incf-c/word)
+  (:translate %raw-instance-atomic-incf/word)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+         (diff :scs (signed-reg) :target result))
+  (:arg-types * (:constant (load/store-index #.n-word-bytes
+                                             #.instance-pointer-lowtag
+                                             #.instance-slots-offset))
+              signed-num)
   (:info index)
   (:temporary (:sc unsigned-reg) tmp)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types unsigned-num)
   (: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 xadd (make-ea-for-raw-slot object index tmp) diff :lock)
+    (move result diff)))
 
 (define-vop (raw-instance-ref/single)
   (:translate %raw-instance-ref/single)
@@ -690,17 +707,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 +789,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 +888,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 +990,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))))