vm/contexts.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 context::context(cell ds_size, cell rs_size) :
   7         callstack_top(NULL),
   8         callstack_bottom(NULL),
   9         datastack(0),
  10         retainstack(0),
  11         datastack_region(new segment(ds_size,false)),
  12         retainstack_region(new segment(rs_size,false)),
  13         catchstack_save(0),
  14         current_callback_save(0),
  15         next(NULL)
  16 {
  17         reset_datastack();
  18         reset_retainstack();
  19 }
  20
  21 context *factor_vm::alloc_context()
  22 {
  23         context *new_context;
  24
  25         if(unused_contexts)
  26         {
  27                 new_context = unused_contexts;
  28                 unused_contexts = unused_contexts->next;
  29         }
  30         else
  31                 new_context = new context(ds_size,rs_size);
  32
  33         return new_context;
  34 }
  35
  36 void factor_vm::dealloc_context(context *old_context)
  37 {
  38         old_context->next = unused_contexts;
  39         unused_contexts = old_context;
  40 }
  41
  42 /* called on entry into a compiled callback */
  43 void factor_vm::nest_stacks()
  44 {
  45         context *new_ctx = alloc_context();
  46
  47         new_ctx->callstack_bottom = (stack_frame *)-1;
  48         new_ctx->callstack_top = (stack_frame *)-1;
  49
  50         /* save per-callback special_objects */
  51         new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
  52         new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
  53
  54         new_ctx->reset_datastack();
  55         new_ctx->reset_retainstack();
  56
  57         new_ctx->next = ctx;
  58         ctx = new_ctx;
  59 }
  60
  61 void nest_stacks(factor_vm *parent)
  62 {
  63         return parent->nest_stacks();
  64 }
  65
  66 /* called when leaving a compiled callback */
  67 void factor_vm::unnest_stacks()
  68 {
  69         /* restore per-callback special_objects */
  70         special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save;
  71         special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save;
  72
  73         context *old_ctx = ctx;
  74         ctx = old_ctx->next;
  75         dealloc_context(old_ctx);
  76 }
  77
  78 void unnest_stacks(factor_vm *parent)
  79 {
  80         return parent->unnest_stacks();
  81 }
  82
  83 /* called on startup */
  84 void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
  85 {
  86         ds_size = ds_size_;
  87         rs_size = rs_size_;
  88         ctx = NULL;
  89         unused_contexts = NULL;
  90 }
  91
  92 bool factor_vm::stack_to_array(cell bottom, cell top)
  93 {
  94         fixnum depth = (fixnum)(top - bottom + sizeof(cell));
  95
  96         if(depth < 0)
  97                 return false;
  98         else
  99         {
 100                 array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
 101                 memcpy(a + 1,(void*)bottom,depth);
 102                 ctx->push(tag<array>(a));
 103                 return true;
 104         }
 105 }
 106
 107 void factor_vm::primitive_datastack()
 108 {
 109         if(!stack_to_array(ctx->datastack_region->start,ctx->datastack))
 110                 general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
 111 }
 112
 113 void factor_vm::primitive_retainstack()
 114 {
 115         if(!stack_to_array(ctx->retainstack_region->start,ctx->retainstack))
 116                 general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
 117 }
 118
 119 /* returns pointer to top of stack */
 120 cell factor_vm::array_to_stack(array *array, cell bottom)
 121 {
 122         cell depth = array_capacity(array) * sizeof(cell);
 123         memcpy((void*)bottom,array + 1,depth);
 124         return bottom + depth - sizeof(cell);
 125 }
 126
 127 void factor_vm::primitive_set_datastack()
 128 {
 129         ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_region->start);
 130 }
 131
 132 void factor_vm::primitive_set_retainstack()
 133 {
 134         ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_region->start);
 135 }
 136
 137 /* Used to implement call( */
 138 void factor_vm::primitive_check_datastack()
 139 {
 140         fixnum out = to_fixnum(ctx->pop());
 141         fixnum in = to_fixnum(ctx->pop());
 142         fixnum height = out - in;
 143         array *saved_datastack = untag_check<array>(ctx->pop());
 144         fixnum saved_height = array_capacity(saved_datastack);
 145         fixnum current_height = (ctx->datastack - ctx->datastack_region->start + sizeof(cell)) / sizeof(cell);
 146         if(current_height - height != saved_height)
 147                 ctx->push(false_object);
 148         else
 149         {
 150                 cell *ds_bot = (cell *)ctx->datastack_region->start;
 151                 for(fixnum i = 0; i < saved_height - in; i++)
 152                 {
 153                         if(ds_bot[i] != array_nth(saved_datastack,i))
 154                         {
 155                                 ctx->push(false_object);
 156                                 return;
 157                         }
 158                 }
 159                 ctx->push(true_object);
 160         }
 161 }
 162
 163 void factor_vm::primitive_load_locals()
 164 {
 165         fixnum count = untag_fixnum(ctx->pop());
 166         memcpy((cell *)(ctx->retainstack + sizeof(cell)),
 167                 (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
 168                 sizeof(cell) * count);
 169         ctx->datastack -= sizeof(cell) * count;
 170         ctx->retainstack += sizeof(cell) * count;
 171 }
 172
 173 }