X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=eeb35c1846c926eded80dc66c78a6602a1ec73fa;hb=88cc2f72774202503588331fddd1592ae8546de1;hp=4a6a36bf5cb1f1aa09e944163d77ce5cf579dd90;hpb=939275c1bc2f18ef93cd1dd4ab35a18f6008cfd9;p=sbcl.git

diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index 4a6a36b..eeb35c1 100644
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -19,7 +19,13 @@
   (once-only ((n-dst dst)
               (n-src src))
     `(unless (location= ,n-dst ,n-src)
-       (inst mov ,n-dst ,n-src))))
+       (sc-case ,n-dst
+         (single-reg
+          (inst movss ,n-dst ,n-src))
+         (double-reg
+          (inst movsd ,n-dst ,n-src))
+         (t
+          (inst mov ,n-dst ,n-src))))))
 
 (defmacro make-ea-for-object-slot (ptr slot lowtag)
   `(make-ea :qword :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
@@ -91,6 +97,21 @@
   (declare (ignore temp))
   `(store-symbol-value ,reg ,symbol))
 
+(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)))
+  #!-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))
+    ,reg)
+  #!-sb-thread
+  `(store-symbol-value ,reg *binding-stack-pointer*))
+
 (defmacro load-type (target source &optional (offset 0))
   #!+sb-doc
   "Loads the type bits of a pointer into target independent of
@@ -130,9 +151,9 @@
 (defun allocation-tramp (alloc-tn size &optional ignored)
   (declare (ignore ignored))
   (inst push size)
-  (inst lea r13-tn (make-ea :qword
+  (inst lea temp-reg-tn (make-ea :qword
                             :disp (make-fixup "alloc_tramp" :foreign)))
-  (inst call r13-tn)
+  (inst call temp-reg-tn)
   (inst pop alloc-tn)
   (values))
 
@@ -168,12 +189,18 @@
     (cond (in-elsewhere
            (allocation-tramp alloc-tn size))
           (t
-           (unless (and (tn-p size) (location= alloc-tn size))
-             (inst mov alloc-tn size))
-           (inst add alloc-tn free-pointer)
+           (inst mov temp-reg-tn free-pointer)
+           (if (tn-p size)
+               (if (location= alloc-tn size)
+                   (inst add alloc-tn temp-reg-tn)
+                   (inst lea alloc-tn
+                         (make-ea :qword :base temp-reg-tn :index size)))
+               (inst lea alloc-tn
+                     (make-ea :qword :base temp-reg-tn :disp size)))
            (inst cmp end-addr alloc-tn)
            (inst jmp :be NOT-INLINE)
-           (inst xchg free-pointer alloc-tn)
+           (inst mov free-pointer alloc-tn)
+           (inst mov alloc-tn temp-reg-tn)
            (emit-label DONE)
            (assemble (*elsewhere*)
              (emit-label NOT-INLINE)
@@ -189,9 +216,9 @@
 (defun allocation (alloc-tn size &optional ignored)
   (declare (ignore ignored))
   (inst push size)
-  (inst lea r13-tn (make-ea :qword
+  (inst lea temp-reg-tn (make-ea :qword
                             :disp (make-fixup "alloc_tramp" :foreign)))
-  (inst call r13-tn)
+  (inst call temp-reg-tn)
   (inst pop alloc-tn)
   (values))
 
@@ -280,9 +307,6 @@
     `(let ((,label (gen-label)))
       (inst mov (make-ea :byte
                  :base thread-base-tn
-                 :disp (* 8 thread-pseudo-atomic-interrupted-slot)) 0)
-      (inst mov (make-ea :byte
-                 :base thread-base-tn
                  :disp (* 8 thread-pseudo-atomic-atomic-slot))
             (fixnumize 1))
       ,@forms
@@ -307,14 +331,6 @@
       ;; something. (perhaps SVLB, for static variable low byte)
       (inst mov (make-ea :byte :disp (+ nil-value
                                         (static-symbol-offset
-                                         '*pseudo-atomic-interrupted*)
-                                        (ash symbol-value-slot word-shift)
-                                        ;; FIXME: Use mask, not minus, to
-                                        ;; take out type bits.
-                                        (- other-pointer-lowtag)))
-       0)
-      (inst mov (make-ea :byte :disp (+ nil-value
-                                        (static-symbol-offset
                                          '*pseudo-atomic-atomic*)
                                         (ash symbol-value-slot word-shift)
                                         (- other-pointer-lowtag)))
@@ -326,12 +342,6 @@
                                         (ash symbol-value-slot word-shift)
                                         (- other-pointer-lowtag)))
        0)
-      ;; KLUDGE: Is there any requirement for interrupts to be
-      ;; handled in order? It seems as though an interrupt coming
-      ;; in at this point will be executed before any pending interrupts.
-      ;; Or do incoming interrupts check to see whether any interrupts
-      ;; are pending? I wish I could find the documentation for
-      ;; pseudo-atomics.. -- WHN 19991130
       (inst cmp (make-ea :byte
                  :disp (+ nil-value
                           (static-symbol-offset