Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / dynbind.c
1 /*
2  * Support for dynamic binding from C.
3  */
4
5 #include "lisp.h"
6 #include "internals.h"
7 #include "globals.h"
8 #include "dynbind.h"
9
10 #if defined(ibmrt) || defined(i386) || defined(__x86_64)
11 #define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER))
12 #define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value))
13 #else
14 #define GetBSP() ((struct binding *)current_binding_stack_pointer)
15 #define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value))
16 #endif
17
18 void
19 bind_variable(lispobj symbol, lispobj value)
20 {
21     lispobj old_value;
22     struct binding *binding;
23
24     old_value = SymbolValue(symbol);
25     binding = GetBSP();
26     SetBSP(binding + 1);
27
28     binding->value = old_value;
29     binding->symbol = symbol;
30     SetSymbolValue(symbol, value);
31 }
32
33 void
34 unbind(void)
35 {
36     struct binding *binding;
37     lispobj symbol;
38
39     binding = GetBSP() - 1;
40
41     symbol = binding->symbol;
42
43     SetSymbolValue(symbol, binding->value);
44
45     binding->symbol = 0;
46
47     SetBSP(binding);
48 }
49
50 void
51 unbind_to_here(lispobj * bsp)
52 {
53     struct binding *target = (struct binding *) bsp;
54     struct binding *binding = GetBSP();
55     lispobj symbol;
56
57     while (target < binding) {
58         binding--;
59
60         symbol = binding->symbol;
61
62         if (symbol) {
63             SetSymbolValue(symbol, binding->value);
64             binding->symbol = 0;
65         }
66
67     }
68     SetBSP(binding);
69 }