(defmacro load-binding-stack-pointer (reg)
#!+sb-thread
`(inst mov ,reg (make-ea :qword :base thread-base-tn
- :disp (* 8 thread-binding-stack-pointer-slot)))
+ :disp (* n-word-bytes thread-binding-stack-pointer-slot)))
#!-sb-thread
`(load-symbol-value ,reg *binding-stack-pointer*))
(defmacro store-binding-stack-pointer (reg)
#!+sb-thread
`(inst mov (make-ea :qword :base thread-base-tn
- :disp (* 8 thread-binding-stack-pointer-slot))
+ :disp (* n-word-bytes thread-binding-stack-pointer-slot))
,reg)
#!-sb-thread
`(store-symbol-value ,reg *binding-stack-pointer*))
(n-offset offset))
(ecase *backend-byte-order*
(:little-endian
- `(inst mov ,n-target
+ `(inst movzx ,n-target
(make-ea :byte :base ,n-source :disp ,n-offset)))
(:big-endian
- `(inst mov ,n-target
+ `(inst movzx ,n-target
(make-ea :byte :base ,n-source
:disp (+ ,n-offset (1- n-word-bytes))))))))
\f
#!+sb-thread
(defmacro %clear-pseudo-atomic ()
'(inst mov (make-ea :qword :base thread-base-tn
- :disp (* 8 thread-pseudo-atomic-bits-slot))
+ :disp (* n-word-bytes thread-pseudo-atomic-bits-slot))
0))
+#!+sb-safepoint
+(defun emit-safepoint ()
+ (inst test al-tn (make-ea :byte
+ :disp (make-fixup "gc_safepoint_page" :foreign))))
+
#!+sb-thread
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
`(let ((,label (gen-label)))
(inst mov (make-ea :qword
:base thread-base-tn
- :disp (* 8 thread-pseudo-atomic-bits-slot))
+ :disp (* n-word-bytes thread-pseudo-atomic-bits-slot))
rbp-tn)
,@forms
(inst xor (make-ea :qword
:base thread-base-tn
- :disp (* 8 thread-pseudo-atomic-bits-slot))
+ :disp (* n-word-bytes thread-pseudo-atomic-bits-slot))
rbp-tn)
(inst jmp :z ,label)
;; if PAI was set, interrupts were disabled at the same time
;; using the process signal mask.
(inst break pending-interrupt-trap)
- (emit-label ,label))))
+ (emit-label ,label)
+ #!+sb-safepoint
+ ;; In this case, when allocation thinks a GC should be done, it
+ ;; does not mark PA as interrupted, but schedules a safepoint
+ ;; trap instead. Let's take the opportunity to trigger that
+ ;; safepoint right now.
+ (emit-safepoint))))
#!-sb-thread
collection."
(if objects
(let ((pins (make-gensym-list (length objects)))
- (wpo (block-gensym "WPO")))
+ (wpo (sb!xc:gensym "WITH-PINNED-OBJECTS-THUNK")))
;; BODY is stuffed in a function to preserve the lexical
;; environment.
`(flet ((,wpo () (progn ,@body)))