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 void factor_vm::init_context(context *ctx)
113 ctx->context_objects[OBJ_CONTEXT] = allot_alien(ctx);
116 context *new_context(factor_vm *parent)
118 context *new_context = parent->new_context();
119 parent->init_context(new_context);
123 void factor_vm::delete_context(context *old_context)
125 unused_contexts.push_back(old_context);
126 active_contexts.erase(old_context);
129 VM_C_API void delete_context(factor_vm *parent, context *old_context)
131 parent->delete_context(old_context);
134 cell factor_vm::begin_callback(cell quot_)
136 data_root<object> quot(quot_,this);
139 spare_ctx = new_context();
140 callback_ids.push_back(callback_id++);
147 cell begin_callback(factor_vm *parent, cell quot)
149 return parent->begin_callback(quot);
152 void factor_vm::end_callback()
154 callback_ids.pop_back();
158 void end_callback(factor_vm *parent)
160 parent->end_callback();
163 void factor_vm::primitive_current_callback()
165 ctx->push(tag_fixnum(callback_ids.back()));
168 void factor_vm::primitive_context_object()
170 fixnum n = untag_fixnum(ctx->peek());
171 ctx->replace(ctx->context_objects[n]);
174 void factor_vm::primitive_set_context_object()
176 fixnum n = untag_fixnum(ctx->pop());
177 cell value = ctx->pop();
178 ctx->context_objects[n] = value;
181 void factor_vm::primitive_context_object_for()
183 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
184 fixnum n = untag_fixnum(ctx->pop());
185 ctx->push(other_ctx->context_objects[n]);
188 cell factor_vm::stack_to_array(cell bottom, cell top)
190 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
196 array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
197 memcpy(a + 1,(void*)bottom,depth);
198 return tag<array>(a);
202 cell factor_vm::datastack_to_array(context *ctx)
204 cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
205 if(array == false_object)
207 general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
214 void factor_vm::primitive_datastack()
216 ctx->push(datastack_to_array(ctx));
219 void factor_vm::primitive_datastack_for()
221 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
222 ctx->push(datastack_to_array(other_ctx));
225 cell factor_vm::retainstack_to_array(context *ctx)
227 cell array = stack_to_array(ctx->retainstack_seg->start,ctx->retainstack);
228 if(array == false_object)
230 general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
237 void factor_vm::primitive_retainstack()
239 ctx->push(retainstack_to_array(ctx));
242 void factor_vm::primitive_retainstack_for()
244 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
245 ctx->push(retainstack_to_array(other_ctx));
248 /* returns pointer to top of stack */
249 cell factor_vm::array_to_stack(array *array, cell bottom)
251 cell depth = array_capacity(array) * sizeof(cell);
252 memcpy((void*)bottom,array + 1,depth);
253 return bottom + depth - sizeof(cell);
256 void factor_vm::set_datastack(context *ctx, array *array)
258 ctx->datastack = array_to_stack(array,ctx->datastack_seg->start);
261 void factor_vm::primitive_set_datastack()
263 set_datastack(ctx,untag_check<array>(ctx->pop()));
266 void factor_vm::set_retainstack(context *ctx, array *array)
268 ctx->retainstack = array_to_stack(array,ctx->retainstack_seg->start);
271 void factor_vm::primitive_set_retainstack()
273 set_retainstack(ctx,untag_check<array>(ctx->pop()));
276 /* Used to implement call( */
277 void factor_vm::primitive_check_datastack()
279 fixnum out = to_fixnum(ctx->pop());
280 fixnum in = to_fixnum(ctx->pop());
281 fixnum height = out - in;
282 array *saved_datastack = untag_check<array>(ctx->pop());
283 fixnum saved_height = array_capacity(saved_datastack);
284 fixnum current_height = (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) / sizeof(cell);
285 if(current_height - height != saved_height)
286 ctx->push(false_object);
289 cell *ds_bot = (cell *)ctx->datastack_seg->start;
290 for(fixnum i = 0; i < saved_height - in; i++)
292 if(ds_bot[i] != array_nth(saved_datastack,i))
294 ctx->push(false_object);
298 ctx->push(true_object);
302 void factor_vm::primitive_load_locals()
304 fixnum count = untag_fixnum(ctx->pop());
305 memcpy((cell *)(ctx->retainstack + sizeof(cell)),
306 (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
307 sizeof(cell) * count);
308 ctx->datastack -= sizeof(cell) * count;
309 ctx->retainstack += sizeof(cell) * count;