6 context::context(cell datastack_size, cell retainstack_size, cell callstack_size) :
8 callstack_bottom(NULL),
12 datastack_seg(new segment(datastack_size,false)),
13 retainstack_seg(new segment(retainstack_size,false)),
14 callstack_seg(new segment(callstack_size,false))
19 void context::reset_datastack()
21 datastack = datastack_seg->start - sizeof(cell);
24 void context::reset_retainstack()
26 retainstack = retainstack_seg->start - sizeof(cell);
29 void context::reset_callstack()
31 callstack_top = callstack_bottom = CALLSTACK_BOTTOM(this);
34 void context::reset_context_objects()
36 memset_cell(context_objects,false_object,context_object_count * sizeof(cell));
44 reset_context_objects();
47 void context::fix_stacks()
49 if(datastack + sizeof(cell) < datastack_seg->start
50 || datastack + stack_reserved >= datastack_seg->end)
53 if(retainstack + sizeof(cell) < retainstack_seg->start
54 || retainstack + stack_reserved >= retainstack_seg->end)
61 delete retainstack_seg;
65 /* called on startup */
66 void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_, cell callstack_size_)
68 datastack_size = datastack_size_;
69 retainstack_size = retainstack_size_;
70 callstack_size = callstack_size_;
73 spare_ctx = new_context();
76 void factor_vm::delete_contexts()
79 std::vector<context *>::const_iterator iter = unused_contexts.begin();
80 std::vector<context *>::const_iterator end = unused_contexts.end();
88 context *factor_vm::new_context()
92 if(unused_contexts.empty())
94 new_context = new context(datastack_size,
100 new_context = unused_contexts.back();
101 unused_contexts.pop_back();
104 new_context->reset();
106 active_contexts.insert(new_context);
111 context *new_context(factor_vm *parent)
113 return parent->new_context();
116 void factor_vm::delete_context(context *old_context)
118 unused_contexts.push_back(old_context);
119 active_contexts.erase(old_context);
122 VM_C_API void delete_context(factor_vm *parent, context *old_context)
124 parent->delete_context(old_context);
127 void factor_vm::begin_callback()
130 spare_ctx = new_context();
131 callback_ids.push_back(callback_id++);
134 void begin_callback(factor_vm *parent)
136 parent->begin_callback();
139 void factor_vm::end_callback()
141 callback_ids.pop_back();
145 void end_callback(factor_vm *parent)
147 parent->end_callback();
150 void factor_vm::primitive_current_callback()
152 ctx->push(tag_fixnum(callback_ids.back()));
155 void factor_vm::primitive_context_object()
157 fixnum n = untag_fixnum(ctx->peek());
158 ctx->replace(ctx->context_objects[n]);
161 void factor_vm::primitive_set_context_object()
163 fixnum n = untag_fixnum(ctx->pop());
164 cell value = ctx->pop();
165 ctx->context_objects[n] = value;
168 void factor_vm::primitive_context_object_for()
170 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
171 fixnum n = untag_fixnum(ctx->pop());
172 ctx->push(other_ctx->context_objects[n]);
175 cell factor_vm::stack_to_array(cell bottom, cell top)
177 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
183 array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
184 memcpy(a + 1,(void*)bottom,depth);
185 return tag<array>(a);
189 cell factor_vm::datastack_to_array(context *ctx)
191 cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
192 if(array == false_object)
194 general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
201 void factor_vm::primitive_datastack()
203 ctx->push(datastack_to_array(ctx));
206 void factor_vm::primitive_datastack_for()
208 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
209 ctx->push(datastack_to_array(other_ctx));
212 cell factor_vm::retainstack_to_array(context *ctx)
214 cell array = stack_to_array(ctx->retainstack_seg->start,ctx->retainstack);
215 if(array == false_object)
217 general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
224 void factor_vm::primitive_retainstack()
226 ctx->push(retainstack_to_array(ctx));
229 void factor_vm::primitive_retainstack_for()
231 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
232 ctx->push(retainstack_to_array(other_ctx));
235 /* returns pointer to top of stack */
236 cell factor_vm::array_to_stack(array *array, cell bottom)
238 cell depth = array_capacity(array) * sizeof(cell);
239 memcpy((void*)bottom,array + 1,depth);
240 return bottom + depth - sizeof(cell);
243 void factor_vm::set_datastack(context *ctx, array *array)
245 ctx->datastack = array_to_stack(array,ctx->datastack_seg->start);
248 void factor_vm::primitive_set_datastack()
250 set_datastack(ctx,untag_check<array>(ctx->pop()));
253 void factor_vm::set_retainstack(context *ctx, array *array)
255 ctx->retainstack = array_to_stack(array,ctx->retainstack_seg->start);
258 void factor_vm::primitive_set_retainstack()
260 set_retainstack(ctx,untag_check<array>(ctx->pop()));
263 /* Used to implement call( */
264 void factor_vm::primitive_check_datastack()
266 fixnum out = to_fixnum(ctx->pop());
267 fixnum in = to_fixnum(ctx->pop());
268 fixnum height = out - in;
269 array *saved_datastack = untag_check<array>(ctx->pop());
270 fixnum saved_height = array_capacity(saved_datastack);
271 fixnum current_height = (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) / sizeof(cell);
272 if(current_height - height != saved_height)
273 ctx->push(false_object);
276 cell *ds_bot = (cell *)ctx->datastack_seg->start;
277 for(fixnum i = 0; i < saved_height - in; i++)
279 if(ds_bot[i] != array_nth(saved_datastack,i))
281 ctx->push(false_object);
285 ctx->push(true_object);
289 void factor_vm::primitive_load_locals()
291 fixnum count = untag_fixnum(ctx->pop());
292 memcpy((cell *)(ctx->retainstack + sizeof(cell)),
293 (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
294 sizeof(cell) * count);
295 ctx->datastack -= sizeof(cell) * count;
296 ctx->retainstack += sizeof(cell) * count;
299 void factor_vm::primitive_context()
301 ctx->push(allot_alien(ctx));