From 6a62de3cd5eacf0c2236c70b1f7dc27d9f009712 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 16 Jul 2007 16:12:18 +0000 Subject: [PATCH] 1.0.7.21: threaded SET & BIND VOP touchups * In SET: don't check versus TLS-INDEX == 0: TLS-INDEX 0 already gives the NO-TLS-VALUE-MARKER. Smaller code, and common case seems to be assignment to a bound variable. * In BIND: use one register less, splitting the duties of the old TEMP between TLS-INDEX and EAX/RAX. Increment the *FREE-TLS-INDEX* directly in memory. --- src/compiler/x86-64/cell.lisp | 24 ++++++++++++------------ src/compiler/x86/cell.lisp | 23 ++++++++++++----------- version.lisp-expr | 2 +- 3 files changed, 25 insertions(+), 24 deletions(-) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 3a4d571e5..3d85b6b44 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -89,7 +89,7 @@ #!+sb-thread (progn (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - ;; Thread-local area, not LOCK needed. + ;; Thread-local area, no LOCK needed. (inst cmpxchg (make-ea :qword :base thread-base-tn :index tls :scale 1) new) @@ -122,8 +122,6 @@ (let ((global-val (gen-label)) (done (gen-label))) (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - (inst or tls tls) - (inst jmp :z global-val) (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls) no-tls-value-marker-widetag) (inst jmp :z global-val) @@ -330,7 +328,7 @@ (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) (:temporary (:sc descriptor-reg :offset rax-offset) rax) - (:temporary (:sc unsigned-reg) tls-index temp bsp) + (:temporary (:sc unsigned-reg) tls-index bsp) (:generator 10 (let ((tls-index-valid (gen-label)) (get-tls-index-lock (gen-label)) @@ -342,12 +340,17 @@ (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 temp 1) + (inst mov tls-index 1) (zeroize rax) (inst lock) - (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) temp) + (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 @@ -356,17 +359,14 @@ (inst jmp :ne release-tls-index-lock) ;; allocate a new tls-index (load-symbol-value tls-index *free-tls-index*) - (inst add tls-index 8) ;XXX surely we can do this more - (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 8) + (inst add (make-ea-for-symbol-value *free-tls-index*) 8) ; 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*)) (emit-label tls-index-valid) - (inst mov temp - (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) - (storew temp bsp (- binding-value-slot binding-size)) + (inst mov rax (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) + (storew rax bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) val)))) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index d8e5a3461..de45ddf75 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -72,7 +72,7 @@ #!+sb-thread (progn (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - ;; Thread-local area, not LOCK needed. + ;; Thread-local area, no LOCK needed. (inst fs-segment-prefix) (inst cmpxchg (make-ea :dword :base tls) new) (inst cmp eax no-tls-value-marker-widetag) @@ -103,8 +103,6 @@ (let ((global-val (gen-label)) (done (gen-label))) (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - (inst or tls tls) - (inst jmp :z global-val) (inst fs-segment-prefix) (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag) (inst jmp :z global-val) @@ -309,7 +307,7 @@ (: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 temp bsp) + (:temporary (:sc unsigned-reg) tls-index bsp) (:generator 10 (let ((tls-index-valid (gen-label)) (get-tls-index-lock (gen-label)) @@ -321,12 +319,17 @@ (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 temp 1) + (inst mov tls-index 1) (inst xor eax eax) (inst lock) - (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) temp) + (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 @@ -335,17 +338,15 @@ (inst jmp :ne release-tls-index-lock) ;; allocate a new tls-index (load-symbol-value tls-index *free-tls-index*) - (inst add tls-index 4) ;XXX surely we can do this more - (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 4) + (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*)) (emit-label tls-index-valid) (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :base tls-index)) - (storew temp bsp (- binding-value-slot binding-size)) + (inst mov eax (make-ea :dword :base tls-index)) + (storew eax 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)))) diff --git a/version.lisp-expr b/version.lisp-expr index 1cddedeb6..20b66881d 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.7.20" +"1.0.7.21" -- 2.11.4.GIT