vm/contexts.cpp

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