X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fdynbind.c;h=9e928a3f335efb80fac2e1faf090ad05391ef42e;hb=ed1910efb36f71b5ebe33b5ffffd7195e15644de;hp=d9774d620925077cc4d924dcb866244c6447a3aa;hpb=077b294463eb6819c0eba67bb8ce71ec66d61ba8;p=sbcl.git diff --git a/src/runtime/dynbind.c b/src/runtime/dynbind.c index d9774d6..9e928a3 100644 --- a/src/runtime/dynbind.c +++ b/src/runtime/dynbind.c @@ -13,47 +13,45 @@ * files for more information. */ +#include +#include + #include "sbcl.h" #include "runtime.h" #include "globals.h" #include "dynbind.h" #include "thread.h" +#include "pseudo-atomic.h" #include "genesis/symbol.h" #include "genesis/binding.h" -#include "genesis/thread.h" #include "genesis/static-symbols.h" -#if defined(BINDING_STACK_POINTER) -#define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER,thread)) -#define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value),thread) -#else -#define GetBSP() ((struct binding *)current_binding_stack_pointer) -#define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value)) -#endif - void bind_variable(lispobj symbol, lispobj value, void *th) { struct binding *binding; struct thread *thread=(struct thread *)th; - binding = GetBSP(); - SetBSP(binding+1); + binding = (struct binding *)get_binding_stack_pointer(thread); + set_binding_stack_pointer(thread,binding+1); #ifdef LISP_FEATURE_SB_THREAD { struct symbol *sym=(struct symbol *)native_pointer(symbol); if(!sym->tls_index) { lispobj *tls_index_lock= &((struct symbol *)native_pointer(TLS_INDEX_LOCK))->value; - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th); + FSHOW_SIGNAL((stderr, "entering dynbind tls alloc\n")); + set_pseudo_atomic_atomic(thread); get_spinlock(tls_index_lock,(long)th); if(!sym->tls_index) { sym->tls_index=SymbolValue(FREE_TLS_INDEX,0); - SetSymbolValue(FREE_TLS_INDEX, - make_fixnum(fixnum_value(sym->tls_index)+1),0); + SetSymbolValue(FREE_TLS_INDEX, sym->tls_index+N_WORD_BYTES, 0); + if((sym->tls_index)>=(TLS_SIZE << WORD_SHIFT)) { + lose("Thread local storage exhausted."); + } } release_spinlock(tls_index_lock); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th); - if (fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th))) + FSHOW_SIGNAL((stderr, "exiting dynbind tls alloc\n")); + clear_pseudo_atomic_atomic(thread); + if (get_pseudo_atomic_interrupted(thread)) do_pending_interrupt(); } } @@ -70,15 +68,38 @@ unbind(void *th) struct binding *binding; lispobj symbol; - binding = GetBSP() - 1; + binding = ((struct binding *)get_binding_stack_pointer(thread)) - 1; + + 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); + SetTlSymbolValue(symbol, binding->value,thread); binding->symbol = 0; + binding->value = 0; - SetBSP(binding); + set_binding_stack_pointer(thread,binding); } void @@ -86,7 +107,7 @@ unbind_to_here(lispobj *bsp,void *th) { struct thread *thread=(struct thread *)th; struct binding *target = (struct binding *)bsp; - struct binding *binding = GetBSP(); + struct binding *binding = (struct binding *)get_binding_stack_pointer(thread); lispobj symbol; while (target < binding) { @@ -94,9 +115,12 @@ unbind_to_here(lispobj *bsp,void *th) symbol = binding->symbol; if (symbol) { - SetTlSymbolValue(symbol, binding->value,thread); + if (symbol != UNBOUND_MARKER_WIDETAG) { + SetTlSymbolValue(symbol, binding->value,thread); + } binding->symbol = 0; + binding->value = 0; } } - SetBSP(binding); + set_binding_stack_pointer(thread,binding); }