vm/contexts.cpp

   1 #include "master.hpp"
   2
   3 namespace factor {
   4
   5 context::context(cell ds_size, cell rs_size, cell cs_size)
   6     : callstack_top(0),
   7       callstack_bottom(0),
   8       datastack(0),
   9       retainstack(0),
  10       callstack_save(0),
  11       datastack_seg(new segment(ds_size, false)),
  12       retainstack_seg(new segment(rs_size, false)),
  13       callstack_seg(new segment(cs_size, false)) {
  14   reset();
  15 }
  16
  17 void context::reset_datastack() {
  18   datastack = datastack_seg->start - sizeof(cell);
  19   fill_stack_seg(datastack, datastack_seg, 0x11111111);
  20 }
  21
  22 void context::reset_retainstack() {
  23   retainstack = retainstack_seg->start - sizeof(cell);
  24   fill_stack_seg(retainstack, retainstack_seg, 0x22222222);
  25 }
  26
  27 void context::reset_callstack() {
  28   callstack_top = callstack_bottom = CALLSTACK_BOTTOM(this);
  29 }
  30
  31 void context::reset_context_objects() {
  32   memset_cell(context_objects, false_object,
  33               context_object_count * sizeof(cell));
  34 }
  35
  36 void context::fill_stack_seg(cell top_ptr, segment* seg, cell pattern) {
  37 #ifdef FACTOR_DEBUG
  38   cell clear_start = top_ptr + sizeof(cell);
  39   cell clear_size = seg->end - clear_start;
  40   memset_cell((void*)clear_start, pattern, clear_size);
  41 #endif
  42 }
  43
  44 vm_error_type context::address_to_error(cell addr) {
  45   if (datastack_seg->underflow_p(addr))
  46     return ERROR_DATASTACK_UNDERFLOW;
  47   if (datastack_seg->overflow_p(addr))
  48     return ERROR_DATASTACK_OVERFLOW;
  49   if (retainstack_seg->underflow_p(addr))
  50     return ERROR_RETAINSTACK_UNDERFLOW;
  51   if (retainstack_seg->overflow_p(addr))
  52     return ERROR_RETAINSTACK_OVERFLOW;
  53   // These are flipped because the callstack grows downwards.
  54   if (callstack_seg->underflow_p(addr))
  55     return ERROR_CALLSTACK_OVERFLOW;
  56   if (callstack_seg->overflow_p(addr))
  57     return ERROR_CALLSTACK_UNDERFLOW;
  58   return ERROR_MEMORY;
  59 }
  60
  61 void context::reset() {
  62   reset_datastack();
  63   reset_retainstack();
  64   reset_callstack();
  65   reset_context_objects();
  66 }
  67
  68 void context::fix_stacks() {
  69   if (datastack + sizeof(cell) < datastack_seg->start ||
  70       datastack + stack_reserved >= datastack_seg->end)
  71     reset_datastack();
  72
  73   if (retainstack + sizeof(cell) < retainstack_seg->start ||
  74       retainstack + stack_reserved >= retainstack_seg->end)
  75     reset_retainstack();
  76 }
  77
  78 context::~context() {
  79   delete datastack_seg;
  80   delete retainstack_seg;
  81   delete callstack_seg;
  82 }
  83
  84 // called on startup
  85 // Allocates memory (new_context())
  86 void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_,
  87                               cell callstack_size_) {
  88   datastack_size = datastack_size_;
  89   retainstack_size = retainstack_size_;
  90   callstack_size = callstack_size_;
  91
  92   ctx = NULL;
  93   spare_ctx = new_context();
  94 }
  95
  96 context* factor_vm::new_context() {
  97   context* new_context;
  98
  99   if (unused_contexts.empty()) {
 100     new_context = new context(datastack_size, retainstack_size, callstack_size);
 101   } else {
 102     new_context = unused_contexts.back();
 103     unused_contexts.pop_back();
 104   }
 105
 106   new_context->reset();
 107
 108   active_contexts.insert(new_context);
 109
 110   return new_context;
 111 }
 112
 113 // Allocates memory
 114 void factor_vm::init_context(context* ctx) {
 115   ctx->context_objects[OBJ_CONTEXT] = allot_alien((cell)ctx);
 116 }
 117
 118 // Allocates memory (init_context(), but not parent->new_context()
 119 VM_C_API context* new_context(factor_vm* parent) {
 120   context* new_context = parent->new_context();
 121   parent->init_context(new_context);
 122   return new_context;
 123 }
 124
 125 void factor_vm::delete_context() {
 126   unused_contexts.push_back(ctx);
 127   active_contexts.erase(ctx);
 128
 129   while (unused_contexts.size() > 10) {
 130     context* stale_context = unused_contexts.front();
 131     unused_contexts.pop_front();
 132     delete stale_context;
 133   }
 134 }
 135
 136 VM_C_API void delete_context(factor_vm* parent) {
 137   parent->delete_context();
 138 }
 139
 140 // Allocates memory (init_context())
 141 VM_C_API void reset_context(factor_vm* parent) {
 142
 143   // The function is used by (start-context-and-delete) which expects
 144   // the top two datastack items to be preserved after the context has
 145   // been resetted.
 146
 147   context* ctx = parent->ctx;
 148   cell arg1 = ctx->pop();
 149   cell arg2 = ctx->pop();
 150   ctx->reset();
 151   ctx->push(arg2);
 152   ctx->push(arg1);
 153   parent->init_context(ctx);
 154 }
 155
 156 // Allocates memory
 157 cell factor_vm::begin_callback(cell quot_) {
 158   data_root<object> quot(quot_, this);
 159
 160   ctx->reset();
 161   spare_ctx = new_context();
 162   callback_ids.push_back(callback_id++);
 163
 164   init_context(ctx);
 165
 166   return quot.value();
 167 }
 168
 169 // Allocates memory
 170 cell begin_callback(factor_vm* parent, cell quot) {
 171   return parent->begin_callback(quot);
 172 }
 173
 174 void factor_vm::end_callback() {
 175   callback_ids.pop_back();
 176   delete_context();
 177 }
 178
 179 void end_callback(factor_vm* parent) { parent->end_callback(); }
 180
 181 void factor_vm::primitive_current_callback() {
 182   ctx->push(tag_fixnum(callback_ids.back()));
 183 }
 184
 185 void factor_vm::primitive_context_object() {
 186   fixnum n = untag_fixnum(ctx->peek());
 187   ctx->replace(ctx->context_objects[n]);
 188 }
 189
 190 void factor_vm::primitive_set_context_object() {
 191   fixnum n = untag_fixnum(ctx->pop());
 192   cell value = ctx->pop();
 193   ctx->context_objects[n] = value;
 194 }
 195
 196 void factor_vm::primitive_context_object_for() {
 197   context* other_ctx = (context*)pinned_alien_offset(ctx->pop());
 198   fixnum n = untag_fixnum(ctx->peek());
 199   ctx->replace(other_ctx->context_objects[n]);
 200 }
 201
 202 // Allocates memory
 203 cell factor_vm::stack_to_array(cell bottom, cell top, vm_error_type error) {
 204   fixnum depth = (fixnum)(top - bottom + sizeof(cell));
 205
 206   if (depth < 0) {
 207     general_error(error, false_object, false_object);
 208   }
 209   array* a = allot_uninitialized_array<array>(depth / sizeof(cell));
 210   memcpy(a + 1, (void*)bottom, depth);
 211   return tag<array>(a);
 212 }
 213
 214 // Allocates memory
 215 cell factor_vm::datastack_to_array(context* ctx) {
 216   return stack_to_array(ctx->datastack_seg->start,
 217                         ctx->datastack,
 218                         ERROR_DATASTACK_UNDERFLOW);
 219 }
 220
 221 // Allocates memory
 222 void factor_vm::primitive_datastack_for() {
 223   data_root<alien> alien_ctx(ctx->pop(), this);
 224   context* other_ctx = (context*)pinned_alien_offset(alien_ctx.value());
 225   cell array = datastack_to_array(other_ctx);
 226   ctx->push(array);
 227 }
 228
 229 // Allocates memory
 230 cell factor_vm::retainstack_to_array(context* ctx) {
 231   return stack_to_array(ctx->retainstack_seg->start,
 232                         ctx->retainstack,
 233                         ERROR_RETAINSTACK_UNDERFLOW);
 234 }
 235
 236 // Allocates memory
 237 void factor_vm::primitive_retainstack_for() {
 238   context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
 239   ctx->replace(retainstack_to_array(other_ctx));
 240 }
 241
 242 // returns pointer to top of stack
 243 static cell array_to_stack(array* array, cell bottom) {
 244   cell depth = array_capacity(array) * sizeof(cell);
 245   memcpy((void*)bottom, array + 1, depth);
 246   return bottom + depth - sizeof(cell);
 247 }
 248
 249 void factor_vm::primitive_set_datastack() {
 250   array* arr = untag_check<array>(ctx->pop());
 251   ctx->datastack = array_to_stack(arr, ctx->datastack_seg->start);
 252 }
 253
 254 void factor_vm::primitive_set_retainstack() {
 255   array* arr = untag_check<array>(ctx->pop());
 256   ctx->retainstack = array_to_stack(arr, ctx->retainstack_seg->start);
 257 }
 258
 259 // Used to implement call(
 260 void factor_vm::primitive_check_datastack() {
 261   fixnum out = to_fixnum(ctx->pop());
 262   fixnum in = to_fixnum(ctx->pop());
 263   fixnum height = out - in;
 264   array* saved_datastack = untag_check<array>(ctx->pop());
 265   fixnum saved_height = array_capacity(saved_datastack);
 266   fixnum current_height =
 267       (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) /
 268       sizeof(cell);
 269   if (current_height - height != saved_height)
 270     ctx->push(false_object);
 271   else {
 272     cell* ds_bot = (cell*)ctx->datastack_seg->start;
 273     for (fixnum i = 0; i < saved_height - in; i++) {
 274       if (ds_bot[i] != array_nth(saved_datastack, i)) {
 275         ctx->push(false_object);
 276         return;
 277       }
 278     }
 279     ctx->push(special_objects[OBJ_CANONICAL_TRUE]);
 280   }
 281 }
 282
 283 void factor_vm::primitive_load_locals() {
 284   fixnum count = untag_fixnum(ctx->pop());
 285   memcpy((cell*)(ctx->retainstack + sizeof(cell)),
 286          (cell*)(ctx->datastack - sizeof(cell) * (count - 1)),
 287          sizeof(cell) * count);
 288   ctx->datastack -= sizeof(cell) * count;
 289   ctx->retainstack += sizeof(cell) * count;
 290 }
 291
 292 }