X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=32b3923b908cc517547b26fe7242ff129f6ff6e9;hb=0e7a9105ae992fc4befa37846c42f298e12918c0;hp=c5491131396e34f2ede86b21691e98aa74e27251;hpb=0f234877047c56ca945fe54e9e77a9cc2c8141cb;p=sbcl.git

diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index c549113..32b3923 100644
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -125,7 +125,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 4)))))))
+              (make-ea :byte :base ,n-source
+                             :disp (+ ,n-offset (1- n-word-bytes))))))))
 
 ;;;; allocation helpers
 
@@ -225,13 +226,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
@@ -354,6 +355,30 @@
 
 ;;;; 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) :to :result)
+              (old-value :scs ,scs :target rax)
+              (new-value :scs ,scs))
+       (:arg-types ,type tagged-num ,el-type ,el-type)
+       (:temporary (:sc descriptor-reg :offset rax-offset
+                        :from (:argument 2) :to :result :target value)  rax)
+       (:results (value :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 5
+         (move rax old-value)
+         #!+sb-thread
+         (inst lock)
+         (inst cmpxchg (make-ea :qword :base object :index index
+                                :disp (- (* ,offset n-word-bytes) ,lowtag))
+               new-value)
+         (move value rax)))))
+
 (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate)
   `(progn
      (define-vop (,name)
@@ -385,6 +410,42 @@
                                   :disp (- (* (+ ,offset index) n-word-bytes)
                                            ,lowtag)))))))
 
+(defmacro define-full-reffer+offset (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))
+              (index :scs (any-reg)))
+       (:info offset)
+       (:arg-types ,type tagged-num
+                   (:constant (constant-displacement other-pointer-lowtag
+                                                     n-word-bytes vector-data-offset)))
+       (:results (value :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 3                    ; pw was 5
+         (inst mov value (make-ea :qword :base object :index index
+                                  :disp (- (* (+ ,offset offset) n-word-bytes)
+                                           ,lowtag)))))
+     (define-vop (,(symbolicate name "-C"))
+       ,@(when translate
+           `((:translate ,translate)))
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg)))
+       (:info index offset)
+       (:arg-types ,type
+                   (:constant (load/store-index ,n-word-bytes ,(eval lowtag)
+                                                ,(eval offset)))
+                   (:constant (constant-displacement other-pointer-lowtag
+                                                     n-word-bytes vector-data-offset)))
+       (:results (value :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 2                    ; pw was 5
+         (inst mov value (make-ea :qword :base object
+                                  :disp (- (* (+ ,offset index offset) n-word-bytes)
+                                           ,lowtag)))))))
+
 (defmacro define-full-setter (name type offset lowtag scs el-type &optional translate)
   `(progn
      (define-vop (,name)
@@ -422,6 +483,51 @@
                value)
          (move result value)))))
 
+(defmacro define-full-setter+offset (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))
+              (index :scs (any-reg))
+              (value :scs ,scs :target result))
+       (:info offset)
+       (:arg-types ,type tagged-num
+                   (:constant (constant-displacement other-pointer-lowtag
+                                                     n-word-bytes
+                                                     vector-data-offset))
+                   ,el-type)
+       (:results (result :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 4                    ; was 5
+         (inst mov (make-ea :qword :base object :index index
+                            :disp (- (* (+ ,offset offset) n-word-bytes) ,lowtag))
+               value)
+         (move result value)))
+     (define-vop (,(symbolicate name "-C"))
+       ,@(when translate
+           `((:translate ,translate)))
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg))
+              (value :scs ,scs :target result))
+       (:info index offset)
+       (:arg-types ,type
+                   (:constant (load/store-index ,n-word-bytes ,(eval lowtag)
+                                                ,(eval offset)))
+                   (:constant (constant-displacement other-pointer-lowtag
+                                                     n-word-bytes
+                                                     vector-data-offset))
+                   ,el-type)
+       (:results (result :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 3                    ; was 5
+         (inst mov (make-ea :qword :base object
+                            :disp (- (* (+ ,offset index offset) n-word-bytes)
+                                     ,lowtag))
+               value)
+         (move result value)))))
+
 ;;; helper for alien stuff.
 (def!macro with-pinned-objects ((&rest objects) &body body)
   "Arrange with the garbage collector that the pages occupied by