X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=eeb35c1846c926eded80dc66c78a6602a1ec73fa;hb=c9b36f04557bd6c7208863e73bae7b1bc6e64842;hp=0a1ae74cd72b2d541e2b37460991fe0733e1d79f;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 0a1ae74..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))) @@ -52,32 +58,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,18 +90,28 @@ #!+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) (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 @@ -136,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)) @@ -174,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) @@ -195,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)) @@ -286,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 @@ -313,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))) @@ -332,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