From ced29bbb5c5575ed9f71a4bdd79e222216a63e73 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Thu, 19 Sep 2013 23:30:09 +0400 Subject: [PATCH] Optimize special variable binding on sb-thread. 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. --- doc/internals/specials.texinfo | 21 ++++++-- src/compiler/alpha/cell.lisp | 3 ++ src/compiler/generic/objdef.lisp | 6 ++- src/compiler/hppa/cell.lisp | 2 + src/compiler/mips/cell.lisp | 1 + src/compiler/ppc/cell.lisp | 17 +++---- src/compiler/sparc/cell.lisp | 3 ++ src/compiler/x86-64/cell.lisp | 104 +++++++++++++++++++------------------- src/compiler/x86/cell.lisp | 72 +++++++++++++------------- src/runtime/dynbind.c | 44 +++++++--------- src/runtime/dynbind.h | 1 - src/runtime/safepoint.c | 2 +- 12 files changed, 144 insertions(+), 132 deletions(-) diff --git a/doc/internals/specials.texinfo b/doc/internals/specials.texinfo index 96e9afc..4c2b4de 100644 --- a/doc/internals/specials.texinfo +++ b/doc/internals/specials.texinfo @@ -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. + diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index b99075b..de046ec 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -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))) diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index c242a4d..ad0b2c9 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -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 diff --git a/src/compiler/hppa/cell.lisp b/src/compiler/hppa/cell.lisp index c5e21b2..114ed55 100644 --- a/src/compiler/hppa/cell.lisp +++ b/src/compiler/hppa/cell.lisp @@ -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)) diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp index 04689c3..bb18e4c 100644 --- a/src/compiler/mips/cell.lisp +++ b/src/compiler/mips/cell.lisp @@ -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)) diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index 2da18ed..9e2712f 100644 --- a/src/compiler/ppc/cell.lisp +++ b/src/compiler/ppc/cell.lisp @@ -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) diff --git a/src/compiler/sparc/cell.lisp b/src/compiler/sparc/cell.lisp index c9613aa..8477edd 100644 --- a/src/compiler/sparc/cell.lisp +++ b/src/compiler/sparc/cell.lisp @@ -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))) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index e728c1b..fdbeb1b 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -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) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 44d2760..9483fee 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -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) diff --git a/src/runtime/dynbind.c b/src/runtime/dynbind.c index 8d8da8c..d89bc7d 100644 --- a/src/runtime/dynbind.c +++ b/src/runtime/dynbind.c @@ -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); - - 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); +#ifdef LISP_FEATURE_SB_THREAD - 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; diff --git a/src/runtime/dynbind.h b/src/runtime/dynbind.h index 526b02d..41aa9eb 100644 --- a/src/runtime/dynbind.h +++ b/src/runtime/dynbind.h @@ -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 diff --git a/src/runtime/safepoint.c b/src/runtime/safepoint.c index 45af50e..10ac7c0 100644 --- a/src/runtime/safepoint.c +++ b/src/runtime/safepoint.c @@ -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 */ -- 1.7.10.4