Specialised VOPs for EQ of fixnum values on x86oids

[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 b7d0ef4..04d7ae5 100644 (file)
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -1,4 +1,4 @@
-;;;; a bunch of handy macros for the x86
+;;;; a bunch of handy macros for x86-64
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -13,21 +13,31 @@
 
 ;;;; instruction-like macros
 
-(defmacro move (dst src)
+;;; This used to be a macro (and still is on the other platforms) but
+;;; the support for SC-dependent move instructions needed here makes
+;;; that expand into so large an expression that the resulting code
+;;; bloat is not justifiable.
+(defun move (dst src)
   #!+sb-doc
   "Move SRC into DST unless they are location=."
-  (once-only ((n-dst dst)
-              (n-src src))
-    `(unless (location= ,n-dst ,n-src)
-       (sc-case ,n-dst
-         ((single-reg complex-single-reg)
-          (aver (xmm-register-p ,n-src))
-          (inst movaps ,n-dst ,n-src))
-         ((double-reg complex-double-reg)
-          (aver (xmm-register-p ,n-src))
-          (inst movapd ,n-dst ,n-src))
-         (t
-          (inst mov ,n-dst ,n-src))))))
+  (unless (location= dst src)
+    (sc-case dst
+      ((single-reg complex-single-reg)
+       (aver (xmm-register-p src))
+       (inst movaps dst src))
+      ((double-reg complex-double-reg)
+       (aver (xmm-register-p src))
+       (inst movapd dst src))
+      #!+sb-simd-pack
+      ((int-sse-reg sse-reg)
+       (aver (xmm-register-p src))
+       (inst movdqa dst src))
+      #!+sb-simd-pack
+      ((single-sse-reg double-sse-reg)
+       (aver (xmm-register-p src))
+       (inst movaps dst src))
+      (t
+       (inst mov dst src)))))
 
 (defmacro make-ea-for-object-slot (ptr slot lowtag)
   `(make-ea :qword :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
@@ -99,14 +109,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 +130,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 +304,40 @@
 #!+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 sb!vm::gc-safepoint-page-addr)))
+
 #!+sb-thread
 (defmacro pseudo-atomic (&rest forms)
+  #!+sb-safepoint-strictly
+  `(progn ,@forms (emit-safepoint))
+  #!-sb-safepoint-strictly
   (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 +552,7 @@ Useful for e.g. foreign calls where another thread may trigger
 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)))