0.9.5.20:
[sbcl.git] / src / runtime / dynbind.c
1 /*
2  * support for dynamic binding from C
3  */
4
5 /*
6  * This software is part of the SBCL system. See the README file for
7  * more information.
8  *
9  * This software is derived from the CMU CL system, which was
10  * written at Carnegie Mellon University and released into the
11  * public domain. The software is in the public domain and is
12  * provided with absolutely no warranty. See the COPYING and CREDITS
13  * files for more information.
14  */
15
16 #include "sbcl.h"
17 #include "runtime.h"
18 #include "globals.h"
19 #include "dynbind.h"
20 #include "thread.h"
21 #include "genesis/symbol.h"
22 #include "genesis/binding.h"
23 #include "genesis/thread.h"
24 #include "genesis/static-symbols.h"
25
26 #if defined(BINDING_STACK_POINTER)
27 #define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER,thread))
28 #define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value),thread)
29 #else
30 #define GetBSP() ((struct binding *)current_binding_stack_pointer)
31 #define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value))
32 #endif
33
34 void bind_variable(lispobj symbol, lispobj value, void *th)
35 {
36     lispobj old_tl_value;
37     struct binding *binding;
38     struct thread *thread=(struct thread *)th;
39     binding = GetBSP();
40     SetBSP(binding+1);
41 #ifdef LISP_FEATURE_SB_THREAD
42     {
43         struct symbol *sym=(struct symbol *)native_pointer(symbol);
44         if(!sym->tls_index) {
45             lispobj *tls_index_lock=
46                 &((struct symbol *)native_pointer(TLS_INDEX_LOCK))->value;
47             SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th);
48             SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th);
49             get_spinlock(tls_index_lock,(long)th);
50             if(!sym->tls_index) {
51                 sym->tls_index=SymbolValue(FREE_TLS_INDEX,0);
52                 SetSymbolValue(FREE_TLS_INDEX,
53                                make_fixnum(fixnum_value(sym->tls_index)+1),0);
54             }
55             release_spinlock(tls_index_lock);
56             SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th);
57             if (fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th)))
58                 do_pending_interrupt();
59         }
60     }
61 #endif
62     old_tl_value=SymbolTlValue(symbol,thread);
63     binding->value = old_tl_value;
64     binding->symbol = symbol;
65     SetTlSymbolValue(symbol, value,thread);
66 }
67
68 void
69 unbind(void *th)
70 {
71     struct thread *thread=(struct thread *)th;
72     struct binding *binding;
73     lispobj symbol;
74
75     binding = GetBSP() - 1;
76
77     symbol = binding->symbol;
78
79     SetTlSymbolValue(symbol, binding->value,thread);
80
81     binding->symbol = 0;
82
83     SetBSP(binding);
84 }
85
86 void
87 unbind_to_here(lispobj *bsp,void *th)
88 {
89     struct thread *thread=(struct thread *)th;
90     struct binding *target = (struct binding *)bsp;
91     struct binding *binding = GetBSP();
92     lispobj symbol;
93
94     while (target < binding) {
95         binding--;
96
97         symbol = binding->symbol;
98         if (symbol) {
99             SetTlSymbolValue(symbol, binding->value,thread);
100             binding->symbol = 0;
101         }
102     }
103     SetBSP(binding);
104 }