X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=18251b53be3bc0ba0926a70c7012560656644f5d;hb=11b5ac86a98f058fe0375b0a707c6ef9e24590c9;hp=4c1a916c667a98bfc1dd4df9f4d8baf8cf04aee4;hpb=1fc851cde8352f4f3c1062ee46593e66a6284c60;p=sbcl.git diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 4c1a916..18251b5 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*)) @@ -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)) @@ -299,7 +290,7 @@ ;;;; error code (defun emit-error-break (vop kind code values) (assemble () - #!-darwin + #!-ud2-breakpoints (inst int 3) ; i386 breakpoint instruction ;; CLH 20060314 ;; On Darwin, we need to use #x0b0f instead of int3 in order @@ -307,7 +298,7 @@ ;; doesn't seem to be reliably firing SIGTRAP ;; handlers. Hopefully this will be fixed by Apple at a ;; later date. - #!+darwin + #!+ud2-breakpoints (inst word #x0b0f) ;; The return PC points here; note the location for the debugger. (when vop @@ -359,20 +350,24 @@ (progn ,@forms) (pseudo-atomic ,@forms))) +;;; Unsafely clear pa flags so that the image can properly lose in a +;;; pa section. +#!+sb-thread +(defmacro %clear-pseudo-atomic () + '(inst mov (make-ea :dword :disp (* 4 thread-pseudo-atomic-bits-slot)) 0 :fs)) + #!+sb-thread (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)))) @@ -380,14 +375,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)))) @@ -410,8 +405,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 @@ -426,7 +419,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) @@ -557,6 +550,7 @@ collection." ;; BODY is stuffed in a function to preserve the lexical ;; environment. `(flet ((,wpo () (progn ,@body))) + (declare (muffle-conditions compiler-note)) ;; PINS are dx-allocated in case the compiler for some ;; unfathomable reason decides to allocate value-cells ;; for them -- since we have DX value-cells on x86oid