vm/contexts.cpp

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