#include "master.hpp"
-namespace factor
-{
+namespace factor {
-context::context(cell datastack_size, cell retainstack_size, cell callstack_size) :
- callstack_top(NULL),
- callstack_bottom(NULL),
- datastack(0),
- retainstack(0),
- callstack_save(0),
- datastack_seg(new segment(datastack_size,false)),
- retainstack_seg(new segment(retainstack_size,false)),
- callstack_seg(new segment(callstack_size,false))
-{
- reset();
+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);
+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);
+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_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::reset_context_objects() {
+ memset_cell(context_objects, false_object,
+ context_object_count * sizeof(cell));
}
-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();
+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);
+#else
+ (void)top_ptr;
+ (void)seg;
+ (void)pattern;
+#endif
}
-void context::scrub_stacks(gc_info *info, cell index)
-{
- u8 *bitmap = info->gc_info_bitmap();
-
- {
- cell base = info->scrub_d_base(index);
-
- for(int loc = 0; loc < info->scrub_d_count; loc++)
- {
- if(bitmap_p(bitmap,base + loc))
- {
-#ifdef DEBUG_GC_MAPS
- std::cout << "scrubbing datastack location " << loc << std::endl;
-#endif
- *((cell *)datastack - loc) = 0;
- }
- }
- }
-
- {
- cell base = info->scrub_r_base(index);
-
- for(int loc = 0; loc < info->scrub_r_count; loc++)
- {
- if(bitmap_p(bitmap,base + loc))
- {
-#ifdef DEBUG_GC_MAPS
- std::cout << "scrubbing retainstack location " << loc << std::endl;
-#endif
- *((cell *)retainstack - loc) = 0;
- }
- }
- }
+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;
}
-context::~context()
-{
- delete datastack_seg;
- delete retainstack_seg;
- delete callstack_seg;
+void context::reset() {
+ reset_datastack();
+ reset_retainstack();
+ reset_callstack();
+ reset_context_objects();
}
-/* called on startup */
-void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_, cell callstack_size_)
-{
- datastack_size = datastack_size_;
- retainstack_size = retainstack_size_;
- callstack_size = callstack_size_;
+void context::fix_stacks() {
+ if (datastack + sizeof(cell) < datastack_seg->start ||
+ datastack + stack_reserved >= datastack_seg->end)
+ reset_datastack();
- ctx = NULL;
- spare_ctx = new_context();
+ if (retainstack + sizeof(cell) < retainstack_seg->start ||
+ retainstack + stack_reserved >= retainstack_seg->end)
+ reset_retainstack();
}
-void factor_vm::delete_contexts()
-{
- assert(!ctx);
- std::vector<context *>::const_iterator iter = unused_contexts.begin();
- std::vector<context *>::const_iterator end = unused_contexts.end();
- while(iter != end)
- {
- delete *iter;
- iter++;
- }
+context::~context() {
+ delete datastack_seg;
+ delete retainstack_seg;
+ delete callstack_seg;
}
-context *factor_vm::new_context()
-{
- context *new_context;
+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();
- }
+ 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();
+ new_context->reset();
- active_contexts.insert(new_context);
+ active_contexts.insert(new_context);
- return new_context;
+ return new_context;
}
-void factor_vm::init_context(context *ctx)
-{
- ctx->context_objects[OBJ_CONTEXT] = allot_alien(ctx);
+// Allocates memory
+void factor_vm::init_context(context* ctx) {
+ ctx->context_objects[OBJ_CONTEXT] = allot_alien((cell)ctx);
}
-context *new_context(factor_vm *parent)
-{
- context *new_context = parent->new_context();
- parent->init_context(new_context);
- return new_context;
+// 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(context *old_context)
-{
- unused_contexts.push_back(old_context);
- active_contexts.erase(old_context);
-}
+void factor_vm::delete_context() {
+ unused_contexts.push_back(ctx);
+ active_contexts.erase(ctx);
-VM_C_API void delete_context(factor_vm *parent, context *old_context)
-{
- parent->delete_context(old_context);
+ while (unused_contexts.size() > 10) {
+ context* stale_context = unused_contexts.front();
+ unused_contexts.pop_front();
+ delete stale_context;
+ }
}
-cell factor_vm::begin_callback(cell quot_)
-{
- data_root<object> quot(quot_,this);
+VM_C_API void delete_context(factor_vm* parent) {
+ parent->delete_context();
+}
- ctx->reset();
- spare_ctx = new_context();
- callback_ids.push_back(callback_id++);
+// Allocates memory (init_context())
+VM_C_API void reset_context(factor_vm* parent) {
- init_context(ctx);
+ // 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.
- return quot.value();
+ context* ctx = parent->ctx;
+ cell arg1 = ctx->pop();
+ cell arg2 = ctx->pop();
+ ctx->reset();
+ ctx->push(arg2);
+ ctx->push(arg1);
+ parent->init_context(ctx);
}
-cell begin_callback(factor_vm *parent, cell quot)
-{
- return parent->begin_callback(quot);
+// 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();
}
-void factor_vm::end_callback()
-{
- callback_ids.pop_back();
- delete_context(ctx);
+// Allocates memory
+cell begin_callback(factor_vm* parent, cell quot) {
+ return parent->begin_callback(quot);
}
-void end_callback(factor_vm *parent)
-{
- parent->end_callback();
+void factor_vm::end_callback() {
+ callback_ids.pop_back();
+ delete_context();
}
-void factor_vm::primitive_current_callback()
-{
- ctx->push(tag_fixnum(callback_ids.back()));
+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_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_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->pop());
- ctx->push(other_ctx->context_objects[n]);
+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]);
}
-cell factor_vm::stack_to_array(cell bottom, cell top)
-{
- fixnum depth = (fixnum)(top - bottom + sizeof(cell));
+// 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)
- return false_object;
- else
- {
- array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
- memcpy(a + 1,(void*)bottom,depth);
- return tag<array>(a);
- }
+ 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);
}
-cell factor_vm::datastack_to_array(context *ctx)
-{
- cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
- if(array == false_object)
- {
- general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
- return false_object;
- }
- else
- return array;
+// Allocates memory
+cell factor_vm::datastack_to_array(context* ctx) {
+ return stack_to_array(ctx->datastack_seg->start,
+ ctx->datastack,
+ ERROR_DATASTACK_UNDERFLOW);
}
-void factor_vm::primitive_datastack()
-{
- ctx->push(datastack_to_array(ctx));
+// 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);
}
-void factor_vm::primitive_datastack_for()
-{
- context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
- ctx->push(datastack_to_array(other_ctx));
+// Allocates memory
+cell factor_vm::retainstack_to_array(context* ctx) {
+ return stack_to_array(ctx->retainstack_seg->start,
+ ctx->retainstack,
+ ERROR_RETAINSTACK_UNDERFLOW);
}
-cell factor_vm::retainstack_to_array(context *ctx)
-{
- cell array = stack_to_array(ctx->retainstack_seg->start,ctx->retainstack);
- if(array == false_object)
- {
- general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
- return false_object;
- }
- else
- return array;
+// Allocates memory
+void factor_vm::primitive_retainstack_for() {
+ context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
+ ctx->replace(retainstack_to_array(other_ctx));
}
-void factor_vm::primitive_retainstack()
-{
- ctx->push(retainstack_to_array(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_retainstack_for()
-{
- context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
- ctx->push(retainstack_to_array(other_ctx));
+void factor_vm::primitive_set_datastack() {
+ array* arr = untag_check<array>(ctx->pop());
+ ctx->datastack = array_to_stack(arr, ctx->datastack_seg->start);
}
-/* returns pointer to top of stack */
-cell factor_vm::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_retainstack() {
+ array* arr = untag_check<array>(ctx->pop());
+ ctx->retainstack = array_to_stack(arr, ctx->retainstack_seg->start);
}
-void factor_vm::set_datastack(context *ctx, array *array)
-{
- ctx->datastack = array_to_stack(array,ctx->datastack_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_set_datastack()
-{
- set_datastack(ctx,untag_check<array>(ctx->pop()));
-}
-
-void factor_vm::set_retainstack(context *ctx, array *array)
-{
- ctx->retainstack = array_to_stack(array,ctx->retainstack_seg->start);
-}
-
-void factor_vm::primitive_set_retainstack()
-{
- set_retainstack(ctx,untag_check<array>(ctx->pop()));
-}
-
-/* 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(true_object);
- }
-}
-
-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;
+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;
}
}
projects / factor.git / blobdiff