common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Optimize special variable binding on sb-thread.

Browse source 
Remove a level of indirection when unbinding special bindings, instead
of saving a symbol on the binding stack, and then accessing its
tls-index to unbind it, save the tls-index directly, saving one memory
read.
This commit is contained in:
Stas Boukarev 2013-09-19 23:30:09 +04:00
parent f42374639e
commit ced29bbb5c
12 changed files with 144 additions and 132 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
doc/internals/specials.texinfo
View file

@ -3,8 +3,8 @@
@chapter Specials
@menu
* Overview::
* Binding and unbinding::
* Overview::
* Binding and unbinding::
@end menu
@node Overview
@ -27,8 +27,9 @@ value locally in a thread.
@section Binding and unbinding
Binding goes like this: the binding stack pointer (bsp) is bumped, old
value and symbol are stored at bsp - 1, new value is stored in
symbol's value slot or the tls.
value and symbol are stored at bsp - 1, new value is stored in symbol's
value slot or the tls. On multithreaded builds, @code{TLS-INDEX} is
stored on the binding stack in place of the symbol.
Unbinding: the symbol's value is restored from bsp - 1, value and
symbol at bsp - 1 are set to zero, and finally bsp is decremented.
@ -62,3 +63,15 @@ garbage around that may wreck the ship on the next @code{BIND}.
In other words, the invariant is that the binding stack above bsp only
contains zeros. This makes @code{BIND} safe in face of gc triggered at
any point during its execution.
On platforms with the @code{UNWIND-TO-FRAME-AND-CALL-VOP} feature, it's
possible to restart frames in the debugger, unwinding the binding stack.
To know how much to unwind, @code{BIND-SENTINEL} in the beginning of a
function puts the current frame pointer on the binding stack with
@code{UNBOUND-MARKER-WIDETAG} instead of the symbol/tls-index.
@code{UNBIND-SENTINEL} removes it before returning. The debugger then
search for @code{UNBOUND-MARKER-WIDETAG} with the value being equal to
the desired frame, and calls @code{UNBIND-TO-HERE}. Consequently,
@code{UNBIND-TO-HERE} treats @code{UNBOUND-MARKER-WIDETAG} the same way
as zeros.

3
src/compiler/alpha/cell.lisp
View file

@ -168,6 +168,9 @@
;;; Establish VAL as a binding for SYMBOL. Save the old value and the
;;; symbol on the binding stack and stuff the new value into the symbol.
;;;
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
(symbol :scs (descriptor-reg)))

6
src/compiler/generic/objdef.lisp
View file

@ -282,7 +282,7 @@
(define-primitive-object (binding)
value
symbol)
symbol) ;; on sb-thread, this is actually a tls-index
(define-primitive-object (unwind-block)
(current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
@ -339,7 +339,9 @@
(package :ref-trans symbol-package
:set-trans %set-symbol-package
:init :null)
#!+sb-thread (tls-index :ref-known (flushable) :ref-trans symbol-tls-index))
;; 0 tls-index means no tls-index is allocated
#!+sb-thread
(tls-index :ref-known (flushable) :ref-trans symbol-tls-index))
(define-primitive-object (complex-single-float
:lowtag other-pointer-lowtag

2
src/compiler/hppa/cell.lisp
View file

@ -157,6 +157,8 @@
;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
;;; the symbol on the binding stack and stuff the new value into the
;;; symbol.
;;;
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))

1
src/compiler/mips/cell.lisp
View file

@ -171,6 +171,7 @@
;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
;;; the symbol on the binding stack and stuff the new value into the
;;; symbol.
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))

17
src/compiler/ppc/cell.lisp
View file

@ -289,7 +289,7 @@
;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
;;; the symbol on the binding stack and stuff the new value into the
;;; symbol.
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
#!+sb-thread
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
@ -341,9 +341,9 @@
TLS-VALID
(inst lwzx temp thread-base-tn tls-index)
(inst addi bsp-tn bsp-tn (* 2 n-word-bytes))
(inst addi bsp-tn bsp-tn (* binding-size n-word-bytes))
(storew temp bsp-tn (- binding-value-slot binding-size))
(storew symbol bsp-tn (- binding-symbol-slot binding-size))
(storew tls-index bsp-tn (- binding-symbol-slot binding-size))
(inst stwx val thread-base-tn tls-index)))
#!-sb-thread
@ -353,7 +353,7 @@
(:temporary (:scs (descriptor-reg)) temp)
(:generator 5
(loadw temp symbol symbol-value-slot other-pointer-lowtag)
(inst addi bsp-tn bsp-tn (* 2 n-word-bytes))
(inst addi bsp-tn bsp-tn (* binding-size n-word-bytes))
(storew temp bsp-tn (- binding-value-slot binding-size))
(storew symbol bsp-tn (- binding-symbol-slot binding-size))
(storew val symbol symbol-value-slot other-pointer-lowtag)))
@ -363,12 +363,11 @@
(:temporary (:scs (descriptor-reg)) tls-index value)
(:generator 0
(loadw tls-index bsp-tn (- binding-symbol-slot binding-size))
(loadw tls-index tls-index symbol-tls-index-slot other-pointer-lowtag)
(loadw value bsp-tn (- binding-value-slot binding-size))
(inst stwx value thread-base-tn tls-index)
(storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
(storew zero-tn bsp-tn (- binding-value-slot binding-size))
(inst subi bsp-tn bsp-tn (* 2 n-word-bytes))))
(inst subi bsp-tn bsp-tn (* binding-size n-word-bytes))))
#!-sb-thread
(define-vop (unbind)
@ -379,7 +378,7 @@
(storew value symbol symbol-value-slot other-pointer-lowtag)
(storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
(storew zero-tn bsp-tn (- binding-value-slot binding-size))
(inst subi bsp-tn bsp-tn (* 2 n-word-bytes))))
(inst subi bsp-tn bsp-tn (* binding-size n-word-bytes))))
(define-vop (unbind-to-here)
@ -400,8 +399,6 @@
(inst beq skip)
(loadw value bsp-tn (- binding-value-slot binding-size))
#!+sb-thread
(loadw symbol symbol symbol-tls-index-slot other-pointer-lowtag)
#!+sb-thread
(inst stwx value thread-base-tn symbol)
#!-sb-thread
(storew value symbol symbol-value-slot other-pointer-lowtag)
@ -409,7 +406,7 @@
(emit-label skip)
(storew zero-tn bsp-tn (- binding-value-slot binding-size))
(inst subi bsp-tn bsp-tn (* 2 n-word-bytes))
(inst subi bsp-tn bsp-tn (* binding-size n-word-bytes))
(inst cmpw where bsp-tn)
(inst bne loop)

3
src/compiler/sparc/cell.lisp
View file

@ -159,6 +159,9 @@
;;; Establish VAL as a binding for SYMBOL. Save the old value and the
;;; symbol on the binding stack and stuff the new value into the
;;; symbol.
;;;
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
(symbol :scs (descriptor-reg)))

104
src/compiler/x86-64/cell.lisp
View file

@ -295,44 +295,45 @@
;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
;;; the symbol on the binding stack and stuff the new value into the
;;; symbol.
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
#!+sb-thread
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
(symbol :scs (descriptor-reg)))
(:temporary (:sc unsigned-reg) tls-index bsp)
(symbol :scs (descriptor-reg) :target tmp
:to :load))
(:temporary (:sc unsigned-reg) tls-index bsp tmp)
(:generator 10
(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 test tls-index tls-index)
(inst jmp :ne tls-index-valid)
(inst mov tls-index symbol)
(inst mov temp-reg-tn
(make-fixup (ecase (tn-offset tls-index)
(#.rax-offset 'alloc-tls-index-in-rax)
(#.rcx-offset 'alloc-tls-index-in-rcx)
(#.rdx-offset 'alloc-tls-index-in-rdx)
(#.rbx-offset 'alloc-tls-index-in-rbx)
(#.rsi-offset 'alloc-tls-index-in-rsi)
(#.rdi-offset 'alloc-tls-index-in-rdi)
(#.r8-offset 'alloc-tls-index-in-r8)
(#.r9-offset 'alloc-tls-index-in-r9)
(#.r10-offset 'alloc-tls-index-in-r10)
(#.r12-offset 'alloc-tls-index-in-r12)
(#.r13-offset 'alloc-tls-index-in-r13)
(#.r14-offset 'alloc-tls-index-in-r14)
(#.r15-offset 'alloc-tls-index-in-r15))
:assembly-routine))
(inst call temp-reg-tn)
(emit-label tls-index-valid)
(inst push (make-ea :qword :base thread-base-tn :scale 1 :index tls-index))
(popw 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))))
(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 test tls-index tls-index)
(inst jmp :ne TLS-INDEX-VALID)
(inst mov tls-index symbol)
(inst mov tmp
(make-fixup (ecase (tn-offset tls-index)
(#.rax-offset 'alloc-tls-index-in-rax)
(#.rcx-offset 'alloc-tls-index-in-rcx)
(#.rdx-offset 'alloc-tls-index-in-rdx)
(#.rbx-offset 'alloc-tls-index-in-rbx)
(#.rsi-offset 'alloc-tls-index-in-rsi)
(#.rdi-offset 'alloc-tls-index-in-rdi)
(#.r8-offset 'alloc-tls-index-in-r8)
(#.r9-offset 'alloc-tls-index-in-r9)
(#.r10-offset 'alloc-tls-index-in-r10)
(#.r12-offset 'alloc-tls-index-in-r12)
(#.r13-offset 'alloc-tls-index-in-r13)
(#.r14-offset 'alloc-tls-index-in-r14)
(#.r15-offset 'alloc-tls-index-in-r15))
:assembly-routine))
(inst call tmp)
TLS-INDEX-VALID
(inst mov tmp (make-ea :qword :base thread-base-tn :scale 1 :index tls-index))
(storew tls-index bsp (- binding-symbol-slot binding-size))
(storew tmp bsp (- binding-value-slot binding-size))
(inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
val)))
#!-sb-thread
(define-vop (bind)
@ -353,17 +354,18 @@
(:temporary (:sc unsigned-reg) temp bsp tls-index)
(:generator 0
(load-binding-stack-pointer bsp)
;; 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, the restore it to the TLS area.
(loadw temp bsp (- binding-value-slot binding-size))
(inst sub bsp (* binding-size n-word-bytes))
;; Load TLS-INDEX of the SYMBOL from stack
(loadw tls-index bsp binding-symbol-slot)
;; Load VALUE from stack, then restore it to the TLS area.
(loadw temp bsp binding-value-slot)
(inst mov (make-ea :qword :base thread-base-tn :scale 1 :index 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))
(zeroize temp)
(storew temp bsp binding-symbol-slot)
(storew temp bsp binding-value-slot)
(store-binding-stack-pointer bsp)))
#!-sb-thread
@ -381,32 +383,32 @@
(define-vop (unbind-to-here)
(:args (where :scs (descriptor-reg any-reg)))
(:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index)
(:temporary (:sc unsigned-reg) symbol value bsp zero)
(:generator 0
(load-binding-stack-pointer bsp)
(inst cmp where bsp)
(inst jmp :e DONE)
(zeroize zero)
LOOP
(loadw symbol bsp (- binding-symbol-slot binding-size))
(inst sub bsp (* binding-size n-word-bytes))
;; on sb-thread symbol is actually a tls-index
(loadw symbol bsp binding-symbol-slot)
(inst test symbol symbol)
(inst jmp :z SKIP)
;; Bind stack debug sentinels have the unbound marker in the symbol slot
(inst cmp symbol unbound-marker-widetag)
(inst jmp :eq SKIP)
(loadw value bsp (- binding-value-slot binding-size))
(loadw value bsp binding-value-slot)
#!-sb-thread
(storew value symbol symbol-value-slot other-pointer-lowtag)
#!+sb-thread
(loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
#!+sb-thread
(inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)
(inst mov (make-ea :qword :base thread-base-tn :scale 1 :index symbol)
value)
(storew 0 bsp (- binding-symbol-slot binding-size))
(storew zero bsp binding-symbol-slot)
SKIP
(storew 0 bsp (- binding-value-slot binding-size))
(inst sub bsp (* binding-size n-word-bytes))
(storew zero bsp binding-value-slot)
(inst cmp where bsp)
(inst jmp :ne LOOP)
(store-binding-stack-pointer bsp)

72
src/compiler/x86/cell.lisp
View file

@ -274,7 +274,8 @@
;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
;;; the symbol on the binding stack and stuff the new value into the
;;; symbol.
;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
;;
;;; 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
@ -286,29 +287,28 @@
(symbol :scs (descriptor-reg)))
(:temporary (:sc unsigned-reg) tls-index bsp)
(:generator 10
(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 test tls-index tls-index)
(inst jmp :ne tls-index-valid)
(inst mov tls-index symbol)
(inst call (make-fixup
(ecase (tn-offset tls-index)
(#.eax-offset 'alloc-tls-index-in-eax)
(#.ebx-offset 'alloc-tls-index-in-ebx)
(#.ecx-offset 'alloc-tls-index-in-ecx)
(#.edx-offset 'alloc-tls-index-in-edx)
(#.edi-offset 'alloc-tls-index-in-edi)
(#.esi-offset 'alloc-tls-index-in-esi))
:assembly-routine))
(emit-label tls-index-valid)
(with-tls-ea (EA :base tls-index :base-already-live-p t)
(inst push EA :maybe-fs)
(popw bsp (- binding-value-slot binding-size))
(storew symbol bsp (- binding-symbol-slot binding-size))
(inst mov EA val :maybe-fs)))))
(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 test tls-index tls-index)
(inst jmp :ne tls-index-valid)
(inst mov tls-index symbol)
(inst call (make-fixup
(ecase (tn-offset tls-index)
(#.eax-offset 'alloc-tls-index-in-eax)
(#.ebx-offset 'alloc-tls-index-in-ebx)
(#.ecx-offset 'alloc-tls-index-in-ecx)
(#.edx-offset 'alloc-tls-index-in-edx)
(#.edi-offset 'alloc-tls-index-in-edi)
(#.esi-offset 'alloc-tls-index-in-esi))
:assembly-routine))
TLS-INDEX-VALID
(with-tls-ea (EA :base tls-index :base-already-live-p t)
(inst push EA :maybe-fs)
(popw bsp (- binding-value-slot binding-size))
(storew tls-index bsp (- binding-symbol-slot binding-size))
(inst mov EA val :maybe-fs))))
#!-sb-thread
(define-vop (bind)
@ -330,16 +330,15 @@
(:generator 0
(load-binding-stack-pointer bsp)
;; 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)
(loadw tls-index bsp (- binding-symbol-slot binding-size))
;; Load VALUE from stack, then restore it to the TLS area.
(loadw temp bsp (- binding-value-slot binding-size))
(with-tls-ea (EA :base tls-index :base-already-live-p t)
(inst mov EA temp :maybe-fs))
;; 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))
(storew 0 bsp binding-symbol-slot)
(storew 0 bsp binding-value-slot)
(store-binding-stack-pointer bsp)))
#!-sb-thread
@ -358,31 +357,28 @@
(define-vop (unbind-to-here)
(:args (where :scs (descriptor-reg any-reg)))
(:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index)
(:temporary (:sc unsigned-reg) symbol value bsp)
(:generator 0
(load-binding-stack-pointer bsp)
(inst cmp where bsp)
(inst jmp :e done)
LOOP
(loadw symbol bsp (- binding-symbol-slot binding-size))
(inst sub bsp (* binding-size n-word-bytes))
(loadw symbol bsp binding-symbol-slot)
(inst test symbol symbol)
(inst jmp :z skip)
;; Bind stack debug sentinels have the unbound marker in the symbol slot
(inst cmp symbol unbound-marker-widetag)
(inst jmp :eq skip)
(loadw value bsp (- binding-value-slot binding-size))
(loadw value bsp binding-value-slot)
#!-sb-thread (storew value symbol symbol-value-slot other-pointer-lowtag)
#!+sb-thread (loadw
tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
#!+sb-thread (with-tls-ea (EA :base tls-index :base-already-live-p t)
#!+sb-thread (with-tls-ea (EA :base symbol :base-already-live-p t)
(inst mov EA value :maybe-fs))
(storew 0 bsp (- binding-symbol-slot binding-size))
(storew 0 bsp binding-symbol-slot)
SKIP
(storew 0 bsp (- binding-value-slot binding-size))
(inst sub bsp (* binding-size n-word-bytes))
(storew 0 bsp binding-value-slot)
(inst cmp where bsp)
(inst jmp :ne loop)
(store-binding-stack-pointer bsp)

44
src/runtime/dynbind.c
View file

@ -1,5 +1,6 @@
/*
* support for dynamic binding from C
* See the "Chapter 9: Specials" of the SBCL Internals Manual.
*/
/*
@ -54,10 +55,13 @@ void bind_variable(lispobj symbol, lispobj value, void *th)
if (get_pseudo_atomic_interrupted(thread))
do_pending_interrupt();
}
binding->symbol = sym->tls_index;
binding->value = SymbolTlValue(symbol, thread);
}
#endif
binding->value = SymbolTlValue(symbol, thread);
#else
binding->symbol = symbol;
binding->value = SymbolTlValue(symbol, thread);
#endif
SetTlSymbolValue(symbol, value, thread);
}
@ -70,31 +74,16 @@ unbind(void *th)
binding = ((struct binding *)get_binding_stack_pointer(thread)) - 1;
/* On sb-thread, it's actually a tls-index */
symbol = binding->symbol;
SetTlSymbolValue(symbol, binding->value,thread);
#ifdef LISP_FEATURE_SB_THREAD
binding->symbol = 0;
binding->value = 0;
set_binding_stack_pointer(thread,binding);
}
void
unbind_variable(lispobj name, void *th)
{
struct thread *thread=(struct thread *)th;
struct binding *binding;
lispobj symbol;
binding = ((struct binding *)get_binding_stack_pointer(thread)) - 1;
symbol = binding->symbol;
if (symbol != name)
lose("unbind_variable, 0x%p != 0x%p", symbol, name);
SetTlSymbolValue(symbol, binding->value,thread);
((union per_thread_data *)thread)->dynamic_values[(symbol) >> WORD_SHIFT]
= binding->value;
#else
SetSymbolValue(symbol, binding->value, thread);
#endif
binding->symbol = 0;
binding->value = 0;
@ -116,7 +105,12 @@ unbind_to_here(lispobj *bsp,void *th)
symbol = binding->symbol;
if (symbol) {
if (symbol != UNBOUND_MARKER_WIDETAG) {
SetTlSymbolValue(symbol, binding->value,thread);
#ifdef LISP_FEATURE_SB_THREAD
((union per_thread_data *)thread)->dynamic_values[(symbol) >> WORD_SHIFT]
= binding->value;
#else
SetSymbolValue(symbol, binding->value, thread);
#endif
}
binding->symbol = 0;
binding->value = 0;

1
src/runtime/dynbind.h
View file

@ -14,7 +14,6 @@
extern void bind_variable(lispobj symbol, lispobj value,void *thread);
extern void unbind(void *thread);
extern void unbind_variable(lispobj name, void *thread);
extern void unbind_to_here(lispobj *bsp,void *thread);
#endif

2
src/runtime/safepoint.c
View file

@ -576,7 +576,7 @@ check_pending_gc(os_context_t *ctx)
block_deferrable_signals(NULL,&sigset);
if(SymbolTlValue(GC_PENDING,self)==T)
gc_happened = funcall0(StaticSymbolFunction(SUB_GC));
unbind_variable(IN_SAFEPOINT,self);
unbind(self);
thread_sigmask(SIG_SETMASK,&sigset,NULL);
if (gc_happened == T) {
/* POST_GC wants to enable interrupts */