X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fdynbind.c;h=9acc23bd75ea3a09a035086c0ea6b60e170eda01;hb=3b5fb548ed34612fb853b11b2bcdd29440834eaa;hp=173ae054df3e038d3d435492c202faca594cdbf7;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git diff --git a/src/runtime/dynbind.c b/src/runtime/dynbind.c index 173ae05..9acc23b 100644 --- a/src/runtime/dynbind.c +++ b/src/runtime/dynbind.c @@ -13,45 +13,53 @@ * 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) { - lispobj old_tl_value; struct binding *binding; struct thread *thread=(struct thread *)th; + 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); -#endif - binding = GetBSP(); - SetBSP(binding+1); -#ifdef LISP_FEATURE_SB_THREAD - 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); + { + struct symbol *sym=(struct symbol *)native_pointer(symbol); + if(!sym->tls_index) { + lispobj *tls_index_lock= + &((struct symbol *)native_pointer(TLS_INDEX_LOCK))->value; + 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, 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); + FSHOW_SIGNAL((stderr, "exiting dynbind tls alloc\n")); + clear_pseudo_atomic_atomic(thread); + if (get_pseudo_atomic_interrupted(thread)) + do_pending_interrupt(); + } } #endif - old_tl_value=SymbolTlValue(symbol,thread); - binding->value = old_tl_value; + binding->value = SymbolTlValue(symbol, thread); binding->symbol = symbol; - SetTlSymbolValue(symbol, value,thread); + SetTlSymbolValue(symbol, value, thread); } void @@ -60,16 +68,17 @@ unbind(void *th) struct thread *thread=(struct thread *)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; - SetBSP(binding); + set_binding_stack_pointer(thread,binding); } void @@ -77,17 +86,20 @@ 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) { - binding--; + binding--; - symbol = binding->symbol; - if (symbol) { - SetTlSymbolValue(symbol, binding->value,thread); - binding->symbol = 0; - } + symbol = binding->symbol; + if (symbol) { + if (symbol != UNBOUND_MARKER_WIDETAG) { + SetTlSymbolValue(symbol, binding->value,thread); + } + binding->symbol = 0; + binding->value = 0; + } } - SetBSP(binding); + set_binding_stack_pointer(thread,binding); }