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)),
17 reset_context_objects();
20 void context::reset_datastack()
22 datastack = datastack_region->start - sizeof(cell);
25 void context::reset_retainstack()
27 retainstack = retainstack_region->start - sizeof(cell);
30 void context::reset_context_objects()
32 memset_cell(context_objects,false_object,context_object_count * sizeof(cell));
35 context *factor_vm::alloc_context()
41 new_context = unused_contexts;
42 unused_contexts = unused_contexts->next;
45 new_context = new context(ds_size,rs_size);
50 void factor_vm::dealloc_context(context *old_context)
52 old_context->next = unused_contexts;
53 unused_contexts = old_context;
56 /* called on entry into a compiled callback */
57 void factor_vm::nest_stacks()
59 context *new_ctx = alloc_context();
61 new_ctx->callstack_bottom = (stack_frame *)-1;
62 new_ctx->callstack_top = (stack_frame *)-1;
64 new_ctx->reset_datastack();
65 new_ctx->reset_retainstack();
66 new_ctx->reset_context_objects();
72 void nest_stacks(factor_vm *parent)
74 return parent->nest_stacks();
77 /* called when leaving a compiled callback */
78 void factor_vm::unnest_stacks()
80 context *old_ctx = ctx;
82 dealloc_context(old_ctx);
85 void unnest_stacks(factor_vm *parent)
87 return parent->unnest_stacks();
90 /* called on startup */
91 void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
96 unused_contexts = NULL;
99 void factor_vm::primitive_context_object()
101 fixnum n = untag_fixnum(ctx->peek());
102 ctx->replace(ctx->context_objects[n]);
105 void factor_vm::primitive_set_context_object()
107 fixnum n = untag_fixnum(ctx->pop());
108 cell value = ctx->pop();
109 ctx->context_objects[n] = value;
112 bool factor_vm::stack_to_array(cell bottom, cell top)
114 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
120 array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
121 memcpy(a + 1,(void*)bottom,depth);
122 ctx->push(tag<array>(a));
127 void factor_vm::primitive_datastack()
129 if(!stack_to_array(ctx->datastack_region->start,ctx->datastack))
130 general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
133 void factor_vm::primitive_retainstack()
135 if(!stack_to_array(ctx->retainstack_region->start,ctx->retainstack))
136 general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
139 /* returns pointer to top of stack */
140 cell factor_vm::array_to_stack(array *array, cell bottom)
142 cell depth = array_capacity(array) * sizeof(cell);
143 memcpy((void*)bottom,array + 1,depth);
144 return bottom + depth - sizeof(cell);
147 void factor_vm::primitive_set_datastack()
149 ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_region->start);
152 void factor_vm::primitive_set_retainstack()
154 ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_region->start);
157 /* Used to implement call( */
158 void factor_vm::primitive_check_datastack()
160 fixnum out = to_fixnum(ctx->pop());
161 fixnum in = to_fixnum(ctx->pop());
162 fixnum height = out - in;
163 array *saved_datastack = untag_check<array>(ctx->pop());
164 fixnum saved_height = array_capacity(saved_datastack);
165 fixnum current_height = (ctx->datastack - ctx->datastack_region->start + sizeof(cell)) / sizeof(cell);
166 if(current_height - height != saved_height)
167 ctx->push(false_object);
170 cell *ds_bot = (cell *)ctx->datastack_region->start;
171 for(fixnum i = 0; i < saved_height - in; i++)
173 if(ds_bot[i] != array_nth(saved_datastack,i))
175 ctx->push(false_object);
179 ctx->push(true_object);
183 void factor_vm::primitive_load_locals()
185 fixnum count = untag_fixnum(ctx->pop());
186 memcpy((cell *)(ctx->retainstack + sizeof(cell)),
187 (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
188 sizeof(cell) * count);
189 ctx->datastack -= sizeof(cell) * count;
190 ctx->retainstack += sizeof(cell) * count;