6 context::context(cell ds_size, cell rs_size) :
8 callstack_bottom(NULL),
12 datastack_region(new segment(ds_size,false)),
13 retainstack_region(new segment(rs_size,false)),
15 current_callback_save(0),
22 context *factor_vm::alloc_context()
28 new_context = unused_contexts;
29 unused_contexts = unused_contexts->next;
32 new_context = new context(ds_size,rs_size);
37 void factor_vm::dealloc_context(context *old_context)
39 old_context->next = unused_contexts;
40 unused_contexts = old_context;
43 /* called on entry into a compiled callback */
44 void factor_vm::nest_stacks(stack_frame *magic_frame)
46 context *new_ctx = alloc_context();
48 new_ctx->callstack_bottom = (stack_frame *)-1;
49 new_ctx->callstack_top = (stack_frame *)-1;
51 new_ctx->magic_frame = magic_frame;
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];
61 void nest_stacks(stack_frame *magic_frame, factor_vm *parent)
63 return parent->nest_stacks(magic_frame);
66 /* called when leaving a compiled callback */
67 void factor_vm::unnest_stacks()
69 /* restore per-callback special_objects */
70 special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save;
71 special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save;
73 context *old_ctx = ctx;
75 dealloc_context(old_ctx);
78 void unnest_stacks(factor_vm *parent)
80 return parent->unnest_stacks();
83 /* called on startup */
84 void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
89 unused_contexts = NULL;
92 bool factor_vm::stack_to_array(cell bottom, cell top)
94 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
100 array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
101 memcpy(a + 1,(void*)bottom,depth);
102 ctx->push(tag<array>(a));
107 void factor_vm::primitive_datastack()
109 if(!stack_to_array(ctx->datastack_region->start,ctx->datastack))
110 general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
113 void factor_vm::primitive_retainstack()
115 if(!stack_to_array(ctx->retainstack_region->start,ctx->retainstack))
116 general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
119 /* returns pointer to top of stack */
120 cell factor_vm::array_to_stack(array *array, cell bottom)
122 cell depth = array_capacity(array) * sizeof(cell);
123 memcpy((void*)bottom,array + 1,depth);
124 return bottom + depth - sizeof(cell);
127 void factor_vm::primitive_set_datastack()
129 ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_region->start);
132 void factor_vm::primitive_set_retainstack()
134 ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_region->start);
137 /* Used to implement call( */
138 void factor_vm::primitive_check_datastack()
140 fixnum out = to_fixnum(ctx->pop());
141 fixnum in = to_fixnum(ctx->pop());
142 fixnum height = out - in;
143 array *saved_datastack = untag_check<array>(ctx->pop());
144 fixnum saved_height = array_capacity(saved_datastack);
145 fixnum current_height = (ctx->datastack - ctx->datastack_region->start + sizeof(cell)) / sizeof(cell);
146 if(current_height - height != saved_height)
147 ctx->push(false_object);
150 cell *ds_bot = (cell *)ctx->datastack_region->start;
151 for(fixnum i = 0; i < saved_height - in; i++)
153 if(ds_bot[i] != array_nth(saved_datastack,i))
155 ctx->push(false_object);
159 ctx->push(true_object);
163 void factor_vm::primitive_load_locals()
165 fixnum count = untag_fixnum(ctx->pop());
166 memcpy((cell *)(ctx->retainstack + sizeof(cell)),
167 (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
168 sizeof(cell) * count);
169 ctx->datastack -= sizeof(cell) * count;
170 ctx->retainstack += sizeof(cell) * count;