6 context::context(cell ds_size, cell rs_size) :
8 callstack_bottom(NULL),
11 datastack_region(new segment(ds_size,false)),
12 retainstack_region(new segment(rs_size,false)),
14 current_callback_save(0),
21 context *factor_vm::alloc_context()
27 new_context = unused_contexts;
28 unused_contexts = unused_contexts->next;
31 new_context = new context(ds_size,rs_size);
36 void factor_vm::dealloc_context(context *old_context)
38 old_context->next = unused_contexts;
39 unused_contexts = old_context;
42 /* called on entry into a compiled callback */
43 void factor_vm::nest_stacks()
45 context *new_ctx = alloc_context();
47 new_ctx->callstack_bottom = (stack_frame *)-1;
48 new_ctx->callstack_top = (stack_frame *)-1;
50 /* save per-callback special_objects */
51 new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
52 new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
54 new_ctx->reset_datastack();
55 new_ctx->reset_retainstack();
61 void nest_stacks(factor_vm *parent)
63 return parent->nest_stacks();
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;