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