X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=2857d95fbe09abe8379b68d9266f1a4db72948fb;hb=08917ec0d00a781a1089922a5419b7f136cdf08f;hp=168cad86bddb212c79e6a20803d407c5ddca008c;hpb=641fe4d4aa7cafc39219e93baa0b5fd019f376ee;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 168cad8..2857d95 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -42,11 +42,9 @@ (:results (result :scs (descriptor-reg any-reg))) (:generator 5 (move eax old) - #!+sb-thread - (inst lock) (inst cmpxchg (make-ea :dword :base object :disp (- (* offset n-word-bytes) lowtag)) - new) + new :lock) (move result eax))) ;;;; symbol hacking VOPs @@ -73,16 +71,14 @@ (progn (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) ;; Thread-local area, no LOCK needed. - (inst fs-segment-prefix) - (inst cmpxchg (make-ea :dword :base tls) new) + (inst cmpxchg (make-ea :dword :base tls) new :fs) (inst cmp eax no-tls-value-marker-widetag) (inst jmp :ne check) - (move eax old) - (inst lock)) + (move eax old)) (inst cmpxchg (make-ea :dword :base symbol :disp (- (* symbol-value-slot n-word-bytes) other-pointer-lowtag)) - new) + new :lock) (emit-label check) (move result eax) (inst cmp result unbound-marker-widetag) @@ -103,11 +99,9 @@ (let ((global-val (gen-label)) (done (gen-label))) (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag) + (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag :fs) (inst jmp :z global-val) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls) value) + (inst mov (make-ea :dword :base tls) value :fs) (inst jmp done) (emit-label global-val) (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -133,8 +127,7 @@ (err-lab (generate-error-code vop 'unbound-symbol-error object)) (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov value (make-ea :dword :base value)) + (inst mov value (make-ea :dword :base value) :fs) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -155,8 +148,7 @@ (:generator 8 (let ((ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov value (make-ea :dword :base value)) + (inst mov value (make-ea :dword :base value) :fs) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -182,56 +174,33 @@ (:policy :fast) (:translate symbol-value)) -(defknown locked-symbol-global-value-add (symbol fixnum) fixnum ()) - -(define-vop (locked-symbol-global-value-add) - (:args (object :scs (descriptor-reg) :to :result) - (value :scs (any-reg) :target result)) - (:arg-types * tagged-num) - (:results (result :scs (any-reg) :from (:argument 1))) - (:policy :fast) - (:translate locked-symbol-global-value-add) - (:result-types tagged-num) - (:policy :fast-safe) - (:generator 4 - (move result value) - (inst lock) - (inst add (make-ea-for-object-slot object symbol-value-slot - other-pointer-lowtag) - value))) - #!+sb-thread (define-vop (boundp) (:translate boundp) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:conditional) - (:info target not-p) + (:conditional :ne) (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value) (:generator 9 (let ((check-unbound-label (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov value (make-ea :dword :base value)) + (inst mov value (make-ea :dword :base value) :fs) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) (emit-label check-unbound-label) - (inst cmp value unbound-marker-widetag) - (inst jmp (if not-p :e :ne) target)))) + (inst cmp value unbound-marker-widetag)))) #!-sb-thread (define-vop (boundp) (:translate boundp) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:conditional) - (:info target not-p) + (:conditional :ne) (:generator 9 (inst cmp (make-ea-for-object-slot object symbol-value-slot other-pointer-lowtag) - unbound-marker-widetag) - (inst jmp (if not-p :e :ne) target))) + unbound-marker-widetag))) (define-vop (symbol-hash) @@ -331,12 +300,10 @@ (#.esi-offset 'alloc-tls-index-in-esi)) :assembly-routine)) (emit-label tls-index-valid) - (inst fs-segment-prefix) - (inst push (make-ea :dword :base tls-index)) + (inst push (make-ea :dword :base tls-index) :fs) (popw bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls-index) val)))) + (inst mov (make-ea :dword :base tls-index) val :fs)))) #!-sb-thread (define-vop (bind) @@ -362,8 +329,7 @@ (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag) ;; Load VALUE from stack, then restore it to the TLS area. (loadw temp bsp (- binding-value-slot binding-size)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls-index) temp) + (inst mov (make-ea :dword :base tls-index) temp :fs) ;; Zero out the stack. (storew 0 bsp (- binding-symbol-slot binding-size)) (storew 0 bsp (- binding-value-slot binding-size)) @@ -404,8 +370,7 @@ #!+sb-thread (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - #!+sb-thread (inst fs-segment-prefix) - #!+sb-thread (inst mov (make-ea :dword :base tls-index) value) + #!+sb-thread (inst mov (make-ea :dword :base tls-index) value :fs) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP @@ -573,6 +538,25 @@ (:generator 5 (inst mov (make-ea-for-raw-slot object index instance-length 1) value))) +(define-vop (raw-instance-atomic-incf/word) + (:translate %raw-instance-atomic-incf/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg immediate)) + (diff :scs (signed-reg) :target result)) + (:arg-types * tagged-num signed-num) + (:temporary (:sc unsigned-reg) tmp) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst shr tmp n-widetag-bits) + (when (sc-is index any-reg) + (inst shl tmp 2) + (inst sub tmp index)) + (inst xadd (make-ea-for-raw-slot object index tmp 1) diff :lock) + (move result diff))) + (define-vop (raw-instance-ref/single) (:translate %raw-instance-ref/single) (:policy :fast-safe)