1.0.9.45: cleaner & thread-safe pv-table interning

[sbcl.git] / src / compiler / x86 / macros.lisp

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 7df414a..fe0469b 100644 (file)
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -46,6 +46,12 @@
     `(unless (location= ,n-dst ,n-src)
        (inst mov ,n-dst ,n-src))))
 
+(defmacro align-stack-pointer (tn)
+  #!-darwin (declare (ignore tn))
+  #!+darwin
+  ;; 16 byte alignment.
+  `(inst and ,tn #xfffffff0))
+
 (defmacro make-ea-for-object-slot (ptr slot lowtag &optional (size :dword))
   `(make-ea ,size :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
 
@@ -66,14 +72,22 @@
 
 (defmacro popw (ptr &optional (slot 0) (lowtag 0))
   `(inst pop (make-ea-for-object-slot ,ptr ,slot ,lowtag)))
+
+(defmacro make-ea-for-vector-data (object &key (size :dword) (offset 0)
+                                   index (scale (ash (width-bits size) -3)))
+  `(make-ea ,size :base ,object :index ,index :scale ,scale
+            :disp (- (+ (* vector-data-offset n-word-bytes)
+                        (* ,offset ,scale))
+                     other-pointer-lowtag)))
 \f
 ;;;; macros to generate useful values
 
 (defmacro load-symbol (reg symbol)
   `(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol))))
 
-(defmacro make-ea-for-symbol-value (symbol)
-  `(make-ea :dword
+(defmacro make-ea-for-symbol-value (symbol &optional (width :dword))
+  (declare (type symbol symbol))
+  `(make-ea ,width
     :disp (+ nil-value
            (static-symbol-offset ',symbol)
            (ash symbol-value-slot word-shift)
@@ -87,6 +101,7 @@
 
 #!+sb-thread
 (defmacro make-ea-for-symbol-tls-index (symbol)
+  (declare (type symbol symbol))
   `(make-ea :dword
     :disp (+ nil-value
            (static-symbol-offset ',symbol)
@@ -145,7 +160,8 @@
               (make-ea :byte :base ,n-source :disp ,n-offset)))
       (:big-endian
        `(inst mov ,n-target
-              (make-ea :byte :base ,n-source :disp (+ ,n-offset 3)))))))
+              (make-ea :byte :base ,n-source
+                             :disp (+ ,n-offset (1- n-word-bytes))))))))
 \f
 ;;;; allocation helpers
 
@@ -264,13 +280,13 @@
 ;;; Allocate an other-pointer object of fixed SIZE with a single word
 ;;; header having the specified WIDETAG value. The result is placed in
 ;;; RESULT-TN.
-(defmacro with-fixed-allocation ((result-tn widetag size &optional inline)
+(defmacro with-fixed-allocation ((result-tn widetag size &optional inline stack-allocate-p)
                                  &body forms)
   (unless forms
     (bug "empty &body in WITH-FIXED-ALLOCATION"))
-  (once-only ((result-tn result-tn) (size size))
-    `(pseudo-atomic
-      (allocation ,result-tn (pad-data-block ,size) ,inline)
+  (once-only ((result-tn result-tn) (size size) (stack-allocate-p stack-allocate-p))
+    `(maybe-pseudo-atomic ,stack-allocate-p
+      (allocation ,result-tn (pad-data-block ,size) ,inline ,stack-allocate-p)
       (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag)
               ,result-tn)
       (inst lea ,result-tn
@@ -367,21 +383,10 @@
 (defmacro pseudo-atomic (&rest forms)
   (with-unique-names (label)
     `(let ((,label (gen-label)))
-       ;; FIXME: The MAKE-EA noise should become a MACROLET macro
-       ;; or something. (perhaps SVLB, for static variable low
-       ;; byte)
-       (inst or (make-ea :byte :disp (+ nil-value
-                                        (static-symbol-offset
-                                         '*pseudo-atomic-bits*)
-                                        (ash symbol-value-slot word-shift)
-                                        (- other-pointer-lowtag)))
+       (inst or (make-ea-for-symbol-value *pseudo-atomic-bits* :byte)
              (fixnumize 1))
        ,@forms
-       (inst xor (make-ea :byte :disp (+ nil-value
-                                         (static-symbol-offset
-                                          '*pseudo-atomic-bits*)
-                                         (ash symbol-value-slot word-shift)
-                                         (- other-pointer-lowtag)))
+       (inst xor (make-ea-for-symbol-value *pseudo-atomic-bits* :byte)
              (fixnumize 1))
        (inst jmp :z ,label)
        ;; if PAI was set, interrupts were disabled at the same
@@ -391,6 +396,42 @@
 \f
 ;;;; indexed references
 
+(defmacro define-full-compare-and-swap
+    (name type offset lowtag scs el-type &optional translate)
+  `(progn
+     (define-vop (,name)
+         ,@(when translate `((:translate ,translate)))
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg) :to :eval)
+              (index :scs (any-reg immediate unsigned-reg) :to :result)
+              (old-value :scs ,scs :target eax)
+              (new-value :scs ,scs))
+       (:arg-types ,type tagged-num ,el-type ,el-type)
+       (:temporary (:sc descriptor-reg :offset eax-offset
+                        :from (:argument 2) :to :result :target value)  eax)
+       (:results (value :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 5
+         (move eax old-value)
+         #!+sb-thread
+         (inst lock)
+         (let ((ea (sc-case index
+                     (immediate
+                      (make-ea :dword :base object
+                               :disp (- (* (+ ,offset (tn-value index))
+                                           n-word-bytes)
+                                        ,lowtag)))
+                     (unsigned-reg
+                      (make-ea :dword :base object :index index :scale 4
+                               :disp (- (* ,offset n-word-bytes)
+                                        ,lowtag)))
+                     (t
+                      (make-ea :dword :base object :index index
+                               :disp (- (* ,offset n-word-bytes)
+                                        ,lowtag))))))
+           (inst cmpxchg ea new-value))
+         (move value eax)))))
+
 (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate)
   `(progn
      (define-vop (,name)