vm/contexts.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6
   7 void factorvm::reset_datastack()
   8 {
   9         ds = ds_bot - sizeof(cell);
  10 }
  11
  12 void factorvm::reset_retainstack()
  13 {
  14         rs = rs_bot - sizeof(cell);
  15 }
  16
  17 static const cell stack_reserved = (64 * sizeof(cell));
  18
  19 void factorvm::fix_stacks()
  20 {
  21         if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
  22         if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
  23 }
  24
  25 /* called before entry into foreign C code. Note that ds and rs might
  26 be stored in registers, so callbacks must save and restore the correct values */
  27 void factorvm::save_stacks()
  28 {
  29         if(stack_chain)
  30         {
  31                 stack_chain->datastack = ds;
  32                 stack_chain->retainstack = rs;
  33         }
  34 }
  35
  36 context *factorvm::alloc_context()
  37 {
  38         context *new_context;
  39
  40         if(unused_contexts)
  41         {
  42                 new_context = unused_contexts;
  43                 unused_contexts = unused_contexts->next;
  44         }
  45         else
  46         {
  47                 new_context = (context *)safe_malloc(sizeof(context));
  48                 new_context->datastack_region = alloc_segment(ds_size);
  49                 new_context->retainstack_region = alloc_segment(rs_size);
  50         }
  51
  52         return new_context;
  53 }
  54
  55 void factorvm::dealloc_context(context *old_context)
  56 {
  57         old_context->next = unused_contexts;
  58         unused_contexts = old_context;
  59 }
  60
  61 /* called on entry into a compiled callback */
  62 void factorvm::nest_stacks()
  63 {
  64         context *new_context = alloc_context();
  65
  66         new_context->callstack_bottom = (stack_frame *)-1;
  67         new_context->callstack_top = (stack_frame *)-1;
  68
  69         /* note that these register values are not necessarily valid stack
  70         pointers. they are merely saved non-volatile registers, and are
  71         restored in unnest_stacks(). consider this scenario:
  72         - factor code calls C function
  73         - C function saves ds/cs registers (since they're non-volatile)
  74         - C function clobbers them
  75         - C function calls Factor callback
  76         - Factor callback returns
  77         - C function restores registers
  78         - C function returns to Factor code */
  79         new_context->datastack_save = ds;
  80         new_context->retainstack_save = rs;
  81
  82         /* save per-callback userenv */
  83         new_context->current_callback_save = userenv[CURRENT_CALLBACK_ENV];
  84         new_context->catchstack_save = userenv[CATCHSTACK_ENV];
  85
  86         new_context->next = stack_chain;
  87         stack_chain = new_context;
  88
  89         reset_datastack();
  90         reset_retainstack();
  91 }
  92
  93 void nest_stacks(factorvm *myvm)
  94 {
  95         ASSERTVM();
  96         return VM_PTR->nest_stacks();
  97 }
  98
  99 /* called when leaving a compiled callback */
 100 void factorvm::unnest_stacks()
 101 {
 102         ds = stack_chain->datastack_save;
 103         rs = stack_chain->retainstack_save;
 104
 105         /* restore per-callback userenv */
 106         userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save;
 107         userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save;
 108
 109         context *old_stacks = stack_chain;
 110         stack_chain = old_stacks->next;
 111         dealloc_context(old_stacks);
 112 }
 113
 114 void unnest_stacks(factorvm *myvm)
 115 {
 116         ASSERTVM();
 117         return VM_PTR->unnest_stacks();
 118 }
 119
 120 /* called on startup */
 121 void factorvm::init_stacks(cell ds_size_, cell rs_size_)
 122 {
 123         ds_size = ds_size_;
 124         rs_size = rs_size_;
 125         stack_chain = NULL;
 126         unused_contexts = NULL;
 127 }
 128
 129 bool factorvm::stack_to_array(cell bottom, cell top)
 130 {
 131         fixnum depth = (fixnum)(top - bottom + sizeof(cell));
 132
 133         if(depth < 0)
 134                 return false;
 135         else
 136         {
 137                 array *a = allot_array_internal<array>(depth / sizeof(cell));
 138                 memcpy(a + 1,(void*)bottom,depth);
 139                 dpush(tag<array>(a));
 140                 return true;
 141         }
 142 }
 143
 144 inline void factorvm::vmprim_datastack()
 145 {
 146         if(!stack_to_array(ds_bot,ds))
 147                 general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
 148 }
 149
 150 PRIMITIVE(datastack)
 151 {
 152         PRIMITIVE_GETVM()->vmprim_datastack();
 153 }
 154
 155 inline void factorvm::vmprim_retainstack()
 156 {
 157         if(!stack_to_array(rs_bot,rs))
 158                 general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
 159 }
 160
 161 PRIMITIVE(retainstack)
 162 {
 163         PRIMITIVE_GETVM()->vmprim_retainstack();
 164 }
 165
 166 /* returns pointer to top of stack */
 167 cell factorvm::array_to_stack(array *array, cell bottom)
 168 {
 169         cell depth = array_capacity(array) * sizeof(cell);
 170         memcpy((void*)bottom,array + 1,depth);
 171         return bottom + depth - sizeof(cell);
 172 }
 173
 174 inline void factorvm::vmprim_set_datastack()
 175 {
 176         ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
 177 }
 178
 179 PRIMITIVE(set_datastack)
 180 {
 181         PRIMITIVE_GETVM()->vmprim_set_datastack();
 182 }
 183
 184 inline void factorvm::vmprim_set_retainstack()
 185 {
 186         rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
 187 }
 188
 189 PRIMITIVE(set_retainstack)
 190 {
 191         PRIMITIVE_GETVM()->vmprim_set_retainstack();
 192 }
 193
 194 /* Used to implement call( */
 195 inline void factorvm::vmprim_check_datastack()
 196 {
 197         fixnum out = to_fixnum(dpop());
 198         fixnum in = to_fixnum(dpop());
 199         fixnum height = out - in;
 200         array *saved_datastack = untag_check<array>(dpop());
 201         fixnum saved_height = array_capacity(saved_datastack);
 202         fixnum current_height = (ds - ds_bot + sizeof(cell)) / sizeof(cell);
 203         if(current_height - height != saved_height)
 204                 dpush(F);
 205         else
 206         {
 207                 fixnum i;
 208                 for(i = 0; i < saved_height - in; i++)
 209                 {
 210                         if(((cell *)ds_bot)[i] != array_nth(saved_datastack,i))
 211                         {
 212                                 dpush(F);
 213                                 return;
 214                         }
 215                 }
 216                 dpush(T);
 217         }
 218 }
 219
 220 PRIMITIVE(check_datastack)
 221 {
 222         PRIMITIVE_GETVM()->vmprim_check_datastack();
 223 }
 224
 225 }