From 290b5879fd424a7217d6fb1a431d12c283a22348 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 1 Mar 2008 19:25:41 +0000 Subject: [PATCH] 1.0.15.7: threaded BIND and UNBIND improvements on x86 * TLS index allocation is rare, so move it out of line from BIND. Shrinks the threaded core by over 170k bytes. * Make UNBIND use three registers instead of four. --- src/assembly/x86/alloc.lisp | 47 ++++++++++++++++++++++++++++++++ src/compiler/x86/cell.lisp | 66 ++++++++++++++++++--------------------------- version.lisp-expr | 2 +- 3 files changed, 74 insertions(+), 41 deletions(-) diff --git a/src/assembly/x86/alloc.lisp b/src/assembly/x86/alloc.lisp index ca62f9274..8829134ce 100644 --- a/src/assembly/x86/alloc.lisp +++ b/src/assembly/x86/alloc.lisp @@ -78,3 +78,50 @@ (intern (aref *dword-register-names* tn-offset))) routines))))) (frob-cons-routines)) + +#+sb-assembling +(macrolet ((def (reg) + (let* ((name (intern (format nil "ALLOCATE-TLS-INDEX-IN-~A" reg))) + (target-offset (intern (format nil "~A-OFFSET" reg))) + (other-offset (if (eql 'eax reg) + 'ecx-offset + 'eax-offset))) + ;; Symbol starts in TARGET, where the TLS-INDEX ends up in. + `(define-assembly-routine ,name + ((:temp other descriptor-reg ,other-offset) + (:temp target descriptor-reg ,target-offset)) + (let ((get-tls-index-lock (gen-label)) + (release-tls-index-lock (gen-label))) + (pseudo-atomic + ;; Save OTHER & push the symbol. EAX is either one of the two. + (inst push other) + (inst push target) + (emit-label get-tls-index-lock) + (inst mov target 1) + (inst xor eax-tn eax-tn) + (inst lock) + (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target) + (inst jmp :ne get-tls-index-lock) + ;; The symbol is now in OTHER. + (inst pop other) + ;; Now with the lock held, see if the symbol's tls index has been + ;; set in the meantime. + (loadw target other symbol-tls-index-slot other-pointer-lowtag) + (inst or target target) + (inst jmp :ne release-tls-index-lock) + ;; Allocate a new tls-index. + (load-symbol-value target *free-tls-index*) + (inst add (make-ea-for-symbol-value *free-tls-index*) 4) ; fixnum + 1 + (storew target other symbol-tls-index-slot other-pointer-lowtag) + (emit-label release-tls-index-lock) + (store-symbol-value 0 *tls-index-lock*) + ;; Restore OTHER. + (inst pop other)) + (inst ret)))))) + (def eax) + (def ebx) + (def ecx) + (def edx) + (def edi) + (def esi)) + diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index de45ddf75..bf2a1ac9f 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -302,51 +302,38 @@ ;;; the symbol on the binding stack and stuff the new value into the ;;; symbol. +;;; FIXME: Split into DYNBIND and BIND: DYNBIND needs to ensure +;;; TLS-INDEX, whereas BIND should assume it is already in place. Make +;;; LET &co compile into BIND, and PROGV into DYNBIND, plus ensure +;;; TLS-INDEX at compile-time, and make loader and dumper preserve +;;; the existence of a TLS-INDEX. #!+sb-thread (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) - (:temporary (:sc descriptor-reg :offset eax-offset) eax) (:temporary (:sc unsigned-reg) tls-index bsp) (:generator 10 - (let ((tls-index-valid (gen-label)) - (get-tls-index-lock (gen-label)) - (release-tls-index-lock (gen-label))) + (let ((tls-index-valid (gen-label))) (load-binding-stack-pointer bsp) (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (inst add bsp (* binding-size n-word-bytes)) (store-binding-stack-pointer bsp) (inst or tls-index tls-index) (inst jmp :ne tls-index-valid) - - ;; FIXME: - ;; * We should ensure the existence of TLS index for LET-bound specials - ;; at compile/load time, and use write a FAST-BIND for use with those. - ;; * PROGV will need to do this, but even there this should not be inline. - ;; This is probably best moved to C, since dynbind.c also needs to do this. - (pseudo-atomic - (emit-label get-tls-index-lock) - (inst mov tls-index 1) - (inst xor eax eax) - (inst lock) - (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) tls-index) - (inst jmp :ne get-tls-index-lock) - ;; now with the lock held, see if the symbol's tls index has - ;; been set in the meantime - (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - (inst or tls-index tls-index) - (inst jmp :ne release-tls-index-lock) - ;; allocate a new tls-index - (load-symbol-value tls-index *free-tls-index*) - (inst add (make-ea-for-symbol-value *free-tls-index*) 4) ; fixnum + 1 - (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - (emit-label release-tls-index-lock) - (store-symbol-value 0 *tls-index-lock*)) - + (inst mov tls-index symbol) + (inst call (make-fixup + (ecase (tn-offset tls-index) + (#.eax-offset 'allocate-tls-index-in-eax) + (#.ebx-offset 'allocate-tls-index-in-ebx) + (#.ecx-offset 'allocate-tls-index-in-ecx) + (#.edx-offset 'allocate-tls-index-in-edx) + (#.edi-offset 'allocate-tls-index-in-edi) + (#.esi-offset 'allocate-tls-index-in-esi)) + :assembly-routine)) (emit-label tls-index-valid) (inst fs-segment-prefix) - (inst mov eax (make-ea :dword :base tls-index)) - (storew eax bsp (- binding-value-slot binding-size)) + (inst push (make-ea :dword :base tls-index)) + (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)))) @@ -365,20 +352,19 @@ (storew symbol bsp (- binding-symbol-slot binding-size)) (storew val symbol symbol-value-slot other-pointer-lowtag))) - #!+sb-thread (define-vop (unbind) - ;; four temporaries? - (:temporary (:sc unsigned-reg) symbol value bsp tls-index) + (:temporary (:sc unsigned-reg) temp bsp tls-index) (:generator 0 (load-binding-stack-pointer bsp) - (loadw symbol bsp (- binding-symbol-slot binding-size)) - (loadw value bsp (- binding-value-slot binding-size)) - - (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + ;; Load SYMBOL from stack, and get the TLS-INDEX. + (loadw temp bsp (- binding-symbol-slot binding-size)) + (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) value) - + (inst mov (make-ea :dword :base tls-index) temp) + ;; Zero out the stack. (storew 0 bsp (- binding-symbol-slot binding-size)) (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) diff --git a/version.lisp-expr b/version.lisp-expr index a1dc484b7..0f62eaf5d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.15.6" +"1.0.15.7" -- 2.11.4.GIT