Preliminary work towards threads on win32

[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 92f83f1..41d91f0 100644 (file)
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -99,14 +99,14 @@
 (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*))
@@ -120,10 +120,10 @@
               (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
@@ -294,27 +294,38 @@
 #!+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
@@ -529,7 +540,7 @@ Useful for e.g. foreign calls where another thread may trigger
 collection."
   (if objects
       (let ((pins (make-gensym-list (length objects)))
-            (wpo (gensym "WITH-PINNED-OBJECTS-THUNK")))
+            (wpo (sb!xc:gensym "WITH-PINNED-OBJECTS-THUNK")))
         ;; BODY is stuffed in a function to preserve the lexical
         ;; environment.
         `(flet ((,wpo () (progn ,@body)))