1.0.26.2: alloc_code_object facelift

[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 5a4b846..e82cdd4 100644 (file)
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -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)
@@ -624,6 +616,25 @@
   (: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 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)
   (:policy :fast-safe)