src/lisp/dynbind.c

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