10.\7f\7fCVS: ----------------------------------------------------------------------

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

diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index d8026c5..be94d71 100644 (file)
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -175,7 +175,7 @@
          #!-sb-thread
          (make-ea :qword
                   :scale 1 :disp
-                  (make-fixup (extern-alien-name "boxed_region") :foreign)))
+                  (make-fixup "boxed_region" :foreign)))
         ;; thread->alloc_region.end_addr
         (end-addr
          #!+sb-thread
@@ -185,7 +185,7 @@
          #!-sb-thread
          (make-ea :qword
                   :scale 1 :disp
-                  (make-fixup (extern-alien-name "boxed_region") :foreign 8))))
+                  (make-fixup "boxed_region" :foreign 8))))
     (cond (in-elsewhere
            (allocation-tramp alloc-tn size))
           (t
@@ -242,7 +242,16 @@
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun emit-error-break (vop kind code values)
     (let ((vector (gensym)))
-      `((inst int 3)                            ; i386 breakpoint instruction
+      `((progn
+          #!-darwin (inst int 3)                  ; i386 breakpoint instruction
+          ;; On Darwin, we need to use #x0b0f instead of int3 in order
+          ;; to generate a SIGILL instead of a SIGTRAP as darwin/x86
+          ;; doesn't seem to be reliably firing SIGTRAP
+          ;; handlers. Hopefully this will be fixed by Apple at a
+          ;; later date. Do the same on x86-64 as we do on x86 until this gets
+          ;; sorted out.
+          #!+darwin (inst word #x0b0f))
+
         ;; The return PC points here; note the location for the debugger.
         (let ((vop ,vop))
           (when vop
@@ -345,6 +354,30 @@
 \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) :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)
@@ -376,6 +409,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)
@@ -413,6 +482,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