X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=aa6f1e707f7764acd09bd44b177b795c92314363;hb=4c400df29038a283e6b4df2d835d5b9c5201d0dd;hp=5489a367e3c4b2f0f2eccd782e91c1631a593717;hpb=96bb2dc76dddb1a21b3886fa7522796879e9ed9d;p=sbcl.git diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 5489a36..aa6f1e7 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -112,8 +112,7 @@ (defmacro load-tl-symbol-value (reg symbol) `(progn (inst mov ,reg (make-ea-for-symbol-tls-index ,symbol)) - (inst fs-segment-prefix) - (inst mov ,reg (make-ea :dword :base ,reg)))) + (inst mov ,reg (make-ea :dword :base ,reg) :fs))) #!-sb-thread (defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol)) @@ -121,8 +120,7 @@ (defmacro store-tl-symbol-value (reg symbol temp) `(progn (inst mov ,temp (make-ea-for-symbol-tls-index ,symbol)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base ,temp) ,reg))) + (inst mov (make-ea :dword :base ,temp) ,reg :fs))) #!-sb-thread (defmacro store-tl-symbol-value (reg symbol temp) (declare (ignore temp)) @@ -131,19 +129,18 @@ (defmacro load-binding-stack-pointer (reg) #!+sb-thread `(progn - (inst fs-segment-prefix) (inst mov ,reg (make-ea :dword - :disp (* 4 thread-binding-stack-pointer-slot)))) + :disp (* 4 thread-binding-stack-pointer-slot)) + :fs)) #!-sb-thread `(load-symbol-value ,reg *binding-stack-pointer*)) (defmacro store-binding-stack-pointer (reg) #!+sb-thread `(progn - (inst fs-segment-prefix) (inst mov (make-ea :dword :disp (* 4 thread-binding-stack-pointer-slot)) - ,reg)) + ,reg :fs)) #!-sb-thread `(store-symbol-value ,reg *binding-stack-pointer*)) @@ -177,7 +174,7 @@ ;;; the duration. Now we have pseudoatomic there's no need for that ;;; overhead. -(defun allocation-dynamic-extent (alloc-tn size) +(defun allocation-dynamic-extent (alloc-tn size lowtag) (inst sub esp-tn size) ;; FIXME: SIZE _should_ be double-word aligned (suggested but ;; unfortunately not enforced by PAD-DATA-BLOCK and @@ -187,7 +184,7 @@ ;; 2004-03-30 (inst and esp-tn (lognot lowtag-mask)) (aver (not (location= alloc-tn esp-tn))) - (inst mov alloc-tn esp-tn) + (inst lea alloc-tn (make-ea :byte :base esp-tn :disp lowtag)) (values)) (defun allocation-notinline (alloc-tn size) @@ -226,10 +223,8 @@ :scale 1))) ; thread->alloc_region.end_addr (unless (and (tn-p size) (location= alloc-tn size)) (inst mov alloc-tn size)) - #!+sb-thread (inst fs-segment-prefix) - (inst add alloc-tn free-pointer) - #!+sb-thread (inst fs-segment-prefix) - (inst cmp alloc-tn end-addr) + (inst add alloc-tn free-pointer #!+sb-thread :fs) + (inst cmp alloc-tn end-addr #!+sb-thread :fs) (inst jmp :be ok) (let ((dst (ecase (tn-offset alloc-tn) (#.eax-offset "alloc_overflow_eax") @@ -244,16 +239,12 @@ ;; Swap ALLOC-TN and FREE-POINTER (cond ((and (tn-p size) (location= alloc-tn size)) ;; XCHG is extremely slow, use the xor swap trick - #!+sb-thread (inst fs-segment-prefix) - (inst xor alloc-tn free-pointer) - #!+sb-thread (inst fs-segment-prefix) - (inst xor free-pointer alloc-tn) - #!+sb-thread (inst fs-segment-prefix) - (inst xor alloc-tn free-pointer)) + (inst xor alloc-tn free-pointer #!+sb-thread :fs) + (inst xor free-pointer alloc-tn #!+sb-thread :fs) + (inst xor alloc-tn free-pointer #!+sb-thread :fs)) (t ;; It's easier if SIZE is still available. - #!+sb-thread (inst fs-segment-prefix) - (inst mov free-pointer alloc-tn) + (inst mov free-pointer alloc-tn #!+sb-thread :fs) (inst sub alloc-tn size))) (emit-label done)) (values)) @@ -269,12 +260,16 @@ ;;; (FIXME: so why aren't we asserting this?) -(defun allocation (alloc-tn size &optional inline dynamic-extent) +(defun allocation (alloc-tn size &optional inline dynamic-extent lowtag) (cond - (dynamic-extent (allocation-dynamic-extent alloc-tn size)) + (dynamic-extent + (allocation-dynamic-extent alloc-tn size lowtag)) ((or (null inline) (policy inline (>= speed space))) (allocation-inline alloc-tn size)) - (t (allocation-notinline alloc-tn size))) + (t + (allocation-notinline alloc-tn size))) + (when (and lowtag (not dynamic-extent)) + (inst lea alloc-tn (make-ea :byte :base alloc-tn :disp lowtag))) (values)) ;;; Allocate an other-pointer object of fixed SIZE with a single word @@ -286,12 +281,11 @@ (bug "empty &body in WITH-FIXED-ALLOCATION")) (once-only ((result-tn result-tn) (size size) (stack-allocate-p stack-allocate-p)) `(maybe-pseudo-atomic ,stack-allocate-p - (allocation ,result-tn (pad-data-block ,size) ,inline ,stack-allocate-p) - (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag) - ,result-tn) - (inst lea ,result-tn - (make-ea :byte :base ,result-tn :disp other-pointer-lowtag)) - ,@forms))) + (allocation ,result-tn (pad-data-block ,size) ,inline ,stack-allocate-p + other-pointer-lowtag) + (storew (logior (ash (1- ,size) n-widetag-bits) ,widetag) + ,result-tn 0 other-pointer-lowtag) + ,@forms))) ;;;; error code (defun emit-error-break (vop kind code values) @@ -360,16 +354,14 @@ (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) `(let ((,label (gen-label))) - (inst fs-segment-prefix) - (inst or (make-ea :byte :disp (* 4 thread-pseudo-atomic-bits-slot)) - (fixnumize 1)) + (inst mov (make-ea :dword :disp (* 4 thread-pseudo-atomic-bits-slot)) + ebp-tn :fs) ,@forms - (inst fs-segment-prefix) - (inst xor (make-ea :byte :disp (* 4 thread-pseudo-atomic-bits-slot)) - (fixnumize 1)) + (inst xor (make-ea :dword :disp (* 4 thread-pseudo-atomic-bits-slot)) + ebp-tn :fs) (inst jmp :z ,label) - ;; if PAI was set, interrupts were disabled at the same - ;; time using the process signal mask. + ;; if PAI was set, interrupts were disabled at the same time + ;; using the process signal mask. (inst break pending-interrupt-trap) (emit-label ,label)))) @@ -377,14 +369,14 @@ (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) `(let ((,label (gen-label))) - (inst or (make-ea-for-symbol-value *pseudo-atomic-bits* :byte) - (fixnumize 1)) + (inst mov (make-ea-for-symbol-value *pseudo-atomic-bits* :dword) + ebp-tn) ,@forms - (inst xor (make-ea-for-symbol-value *pseudo-atomic-bits* :byte) - (fixnumize 1)) + (inst xor (make-ea-for-symbol-value *pseudo-atomic-bits* :dword) + ebp-tn) (inst jmp :z ,label) - ;; if PAI was set, interrupts were disabled at the same - ;; time using the process signal mask. + ;; if PAI was set, interrupts were disabled at the same time + ;; using the process signal mask. (inst break pending-interrupt-trap) (emit-label ,label)))) @@ -407,8 +399,6 @@ (:result-types ,el-type) (:generator 5 (move eax old-value) - #!+sb-thread - (inst lock) (let ((ea (sc-case index (immediate (make-ea :dword :base object @@ -423,7 +413,7 @@ (make-ea :dword :base object :index index :disp (- (* ,offset n-word-bytes) ,lowtag)))))) - (inst cmpxchg ea new-value)) + (inst cmpxchg ea new-value :lock)) (move value eax))))) (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate)