#include "master.hpp" namespace factor { context::context(cell ds_size, cell rs_size, cell cs_size) : callstack_top(0), callstack_bottom(0), datastack(0), retainstack(0), callstack_save(0), datastack_seg(new segment(ds_size, false)), retainstack_seg(new segment(rs_size, false)), callstack_seg(new segment(cs_size, false)) { reset(); } void context::reset_datastack() { datastack = datastack_seg->start - sizeof(cell); fill_stack_seg(datastack, datastack_seg, 0x11111111); } void context::reset_retainstack() { retainstack = retainstack_seg->start - sizeof(cell); fill_stack_seg(retainstack, retainstack_seg, 0x22222222); } void context::reset_callstack() { callstack_top = callstack_bottom = CALLSTACK_BOTTOM(this); } void context::reset_context_objects() { memset_cell(context_objects, false_object, context_object_count * sizeof(cell)); } void context::fill_stack_seg(cell top_ptr, segment* seg, cell pattern) { #ifdef FACTOR_DEBUG cell clear_start = top_ptr + sizeof(cell); cell clear_size = seg->end - clear_start; memset_cell((void*)clear_start, pattern, clear_size); #endif } vm_error_type context::address_to_error(cell addr) { if (datastack_seg->underflow_p(addr)) return ERROR_DATASTACK_UNDERFLOW; if (datastack_seg->overflow_p(addr)) return ERROR_DATASTACK_OVERFLOW; if (retainstack_seg->underflow_p(addr)) return ERROR_RETAINSTACK_UNDERFLOW; if (retainstack_seg->overflow_p(addr)) return ERROR_RETAINSTACK_OVERFLOW; // These are flipped because the callstack grows downwards. if (callstack_seg->underflow_p(addr)) return ERROR_CALLSTACK_OVERFLOW; if (callstack_seg->overflow_p(addr)) return ERROR_CALLSTACK_UNDERFLOW; return ERROR_MEMORY; } void context::reset() { reset_datastack(); reset_retainstack(); reset_callstack(); reset_context_objects(); } void context::fix_stacks() { if (datastack + sizeof(cell) < datastack_seg->start || datastack + stack_reserved >= datastack_seg->end) reset_datastack(); if (retainstack + sizeof(cell) < retainstack_seg->start || retainstack + stack_reserved >= retainstack_seg->end) reset_retainstack(); } context::~context() { delete datastack_seg; delete retainstack_seg; delete callstack_seg; } context* factor_vm::new_context() { context* new_context; if (unused_contexts.empty()) { new_context = new context(datastack_size, retainstack_size, callstack_size); } else { new_context = unused_contexts.back(); unused_contexts.pop_back(); } new_context->reset(); active_contexts.insert(new_context); return new_context; } // Allocates memory void factor_vm::init_context(context* ctx) { ctx->context_objects[OBJ_CONTEXT] = allot_alien((cell)ctx); } // Allocates memory (init_context(), but not parent->new_context() VM_C_API context* new_context(factor_vm* parent) { context* new_context = parent->new_context(); parent->init_context(new_context); return new_context; } void factor_vm::delete_context() { unused_contexts.push_back(ctx); active_contexts.erase(ctx); while (unused_contexts.size() > 10) { context* stale_context = unused_contexts.front(); unused_contexts.pop_front(); delete stale_context; } } VM_C_API void delete_context(factor_vm* parent) { parent->delete_context(); } // Allocates memory (init_context()) VM_C_API void reset_context(factor_vm* parent) { // The function is used by (start-context-and-delete) which expects // the top two datastack items to be preserved after the context has // been resetted. context* ctx = parent->ctx; cell arg1 = ctx->pop(); cell arg2 = ctx->pop(); ctx->reset(); ctx->push(arg2); ctx->push(arg1); parent->init_context(ctx); } // Allocates memory cell factor_vm::begin_callback(cell quot_) { data_root<object> quot(quot_, this); ctx->reset(); spare_ctx = new_context(); callback_ids.push_back(callback_id++); init_context(ctx); return quot.value(); } // Allocates memory cell begin_callback(factor_vm* parent, cell quot) { return parent->begin_callback(quot); } void factor_vm::end_callback() { callback_ids.pop_back(); delete_context(); } void end_callback(factor_vm* parent) { parent->end_callback(); } void factor_vm::primitive_current_callback() { ctx->push(tag_fixnum(callback_ids.back())); } void factor_vm::primitive_context_object() { fixnum n = untag_fixnum(ctx->peek()); ctx->replace(ctx->context_objects[n]); } void factor_vm::primitive_set_context_object() { fixnum n = untag_fixnum(ctx->pop()); cell value = ctx->pop(); ctx->context_objects[n] = value; } void factor_vm::primitive_context_object_for() { context* other_ctx = (context*)pinned_alien_offset(ctx->pop()); fixnum n = untag_fixnum(ctx->peek()); ctx->replace(other_ctx->context_objects[n]); } // Allocates memory cell factor_vm::stack_to_array(cell bottom, cell top, vm_error_type error) { fixnum depth = (fixnum)(top - bottom + sizeof(cell)); if (depth < 0) { general_error(error, false_object, false_object); } array* a = allot_uninitialized_array<array>(depth / sizeof(cell)); memcpy(a + 1, (void*)bottom, depth); return tag<array>(a); } // Allocates memory cell factor_vm::datastack_to_array(context* ctx) { return stack_to_array(ctx->datastack_seg->start, ctx->datastack, ERROR_DATASTACK_UNDERFLOW); } // Allocates memory void factor_vm::primitive_datastack_for() { data_root<alien> alien_ctx(ctx->pop(), this); context* other_ctx = (context*)pinned_alien_offset(alien_ctx.value()); cell array = datastack_to_array(other_ctx); ctx->push(array); } // Allocates memory cell factor_vm::retainstack_to_array(context* ctx) { return stack_to_array(ctx->retainstack_seg->start, ctx->retainstack, ERROR_RETAINSTACK_UNDERFLOW); } // Allocates memory void factor_vm::primitive_retainstack_for() { context* other_ctx = (context*)pinned_alien_offset(ctx->peek()); ctx->replace(retainstack_to_array(other_ctx)); } // returns pointer to top of stack static cell array_to_stack(array* array, cell bottom) { cell depth = array_capacity(array) * sizeof(cell); memcpy((void*)bottom, array + 1, depth); return bottom + depth - sizeof(cell); } void factor_vm::primitive_set_datastack() { array* arr = untag_check<array>(ctx->pop()); ctx->datastack = array_to_stack(arr, ctx->datastack_seg->start); } void factor_vm::primitive_set_retainstack() { array* arr = untag_check<array>(ctx->pop()); ctx->retainstack = array_to_stack(arr, ctx->retainstack_seg->start); } // Used to implement call( void factor_vm::primitive_check_datastack() { fixnum out = to_fixnum(ctx->pop()); fixnum in = to_fixnum(ctx->pop()); fixnum height = out - in; array* saved_datastack = untag_check<array>(ctx->pop()); fixnum saved_height = array_capacity(saved_datastack); fixnum current_height = (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) / sizeof(cell); if (current_height - height != saved_height) ctx->push(false_object); else { cell* ds_bot = (cell*)ctx->datastack_seg->start; for (fixnum i = 0; i < saved_height - in; i++) { if (ds_bot[i] != array_nth(saved_datastack, i)) { ctx->push(false_object); return; } } ctx->push(special_objects[OBJ_CANONICAL_TRUE]); } } void factor_vm::primitive_load_locals() { fixnum count = untag_fixnum(ctx->pop()); memcpy((cell*)(ctx->retainstack + sizeof(cell)), (cell*)(ctx->datastack - sizeof(cell) * (count - 1)), sizeof(cell) * count); ctx->datastack -= sizeof(cell) * count; ctx->retainstack += sizeof(cell) * count; } }