0.9.6.23:

[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 0a1ae74..002f7de 100644 (file)
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -52,32 +52,31 @@
 (defmacro load-symbol (reg symbol)
   `(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol))))
 
+(defmacro make-ea-for-symbol-value (symbol)
+  `(make-ea :qword
+    :disp (+ nil-value
+           (static-symbol-offset ',symbol)
+           (ash symbol-value-slot word-shift)
+           (- other-pointer-lowtag))))
+
 (defmacro load-symbol-value (reg symbol)
-  `(inst mov ,reg
-         (make-ea :qword
-                  :disp (+ nil-value
-                           (static-symbol-offset ',symbol)
-                           (ash symbol-value-slot word-shift)
-                           (- other-pointer-lowtag)))))
+  `(inst mov ,reg (make-ea-for-symbol-value ,symbol)))
 
 (defmacro store-symbol-value (reg symbol)
-  `(inst mov
-         (make-ea :qword
-                  :disp (+ nil-value
-                           (static-symbol-offset ',symbol)
-                           (ash symbol-value-slot word-shift)
-                           (- other-pointer-lowtag)))
-         ,reg))
+  `(inst mov (make-ea-for-symbol-value ,symbol) ,reg))
+
+#!+sb-thread
+(defmacro make-ea-for-symbol-tls-index (symbol)
+  `(make-ea :qword
+    :disp (+ nil-value
+           (static-symbol-offset ',symbol)
+           (ash symbol-tls-index-slot word-shift)
+           (- other-pointer-lowtag))))
 
 #!+sb-thread
 (defmacro load-tl-symbol-value (reg symbol)
   `(progn
-    (inst mov ,reg
-     (make-ea :qword
-      :disp (+ nil-value
-               (static-symbol-offset ',symbol)
-               (ash symbol-tls-index-slot word-shift)
-               (- other-pointer-lowtag))))
+    (inst mov ,reg (make-ea-for-symbol-tls-index ,symbol))
     (inst mov ,reg (make-ea :qword :base thread-base-tn :scale 1 :index ,reg))))
 #!-sb-thread
 (defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol))
@@ -85,12 +84,7 @@
 #!+sb-thread
 (defmacro store-tl-symbol-value (reg symbol temp)
   `(progn
-    (inst mov ,temp
-     (make-ea :qword
-      :disp (+ nil-value
-               (static-symbol-offset ',symbol)
-               (ash symbol-tls-index-slot word-shift)
-               (- other-pointer-lowtag))))
+    (inst mov ,temp (make-ea-for-symbol-tls-index ,symbol))
     (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index ,temp) ,reg)))
 #!-sb-thread
 (defmacro store-tl-symbol-value (reg symbol temp)
@@ -136,9 +130,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))
 
@@ -174,12 +168,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)
@@ -195,9 +195,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))