vm/contexts.cpp

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