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)
58 void context::scrub_stacks(gc_info *info, cell index)
60 u8 *bitmap = info->gc_info_bitmap();
63 cell base = info->scrub_d_base(index);
65 for(cell loc = 0; loc < info->scrub_d_count; loc++)
67 if(bitmap_p(bitmap,base + loc))
68 ((cell *)datastack)[-loc] = 0;
73 cell base = info->scrub_r_base(index);
75 for(cell loc = 0; loc < info->scrub_r_count; loc++)
77 if(bitmap_p(bitmap,base + loc))
78 ((cell *)retainstack)[-loc] = 0;
86 delete retainstack_seg;
90 /* called on startup */
91 void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_, cell callstack_size_)
93 datastack_size = datastack_size_;
94 retainstack_size = retainstack_size_;
95 callstack_size = callstack_size_;
98 spare_ctx = new_context();
101 void factor_vm::delete_contexts()
104 std::vector<context *>::const_iterator iter = unused_contexts.begin();
105 std::vector<context *>::const_iterator end = unused_contexts.end();
113 context *factor_vm::new_context()
115 context *new_context;
117 if(unused_contexts.empty())
119 new_context = new context(datastack_size,
125 new_context = unused_contexts.back();
126 unused_contexts.pop_back();
129 new_context->reset();
131 active_contexts.insert(new_context);
136 void factor_vm::init_context(context *ctx)
138 ctx->context_objects[OBJ_CONTEXT] = allot_alien(ctx);
141 context *new_context(factor_vm *parent)
143 context *new_context = parent->new_context();
144 parent->init_context(new_context);
148 void factor_vm::delete_context(context *old_context)
150 unused_contexts.push_back(old_context);
151 active_contexts.erase(old_context);
154 VM_C_API void delete_context(factor_vm *parent, context *old_context)
156 parent->delete_context(old_context);
159 cell factor_vm::begin_callback(cell quot_)
161 data_root<object> quot(quot_,this);
164 spare_ctx = new_context();
165 callback_ids.push_back(callback_id++);
172 cell begin_callback(factor_vm *parent, cell quot)
174 return parent->begin_callback(quot);
177 void factor_vm::end_callback()
179 callback_ids.pop_back();
183 void end_callback(factor_vm *parent)
185 parent->end_callback();
188 void factor_vm::primitive_current_callback()
190 ctx->push(tag_fixnum(callback_ids.back()));
193 void factor_vm::primitive_context_object()
195 fixnum n = untag_fixnum(ctx->peek());
196 ctx->replace(ctx->context_objects[n]);
199 void factor_vm::primitive_set_context_object()
201 fixnum n = untag_fixnum(ctx->pop());
202 cell value = ctx->pop();
203 ctx->context_objects[n] = value;
206 void factor_vm::primitive_context_object_for()
208 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
209 fixnum n = untag_fixnum(ctx->pop());
210 ctx->push(other_ctx->context_objects[n]);
213 cell factor_vm::stack_to_array(cell bottom, cell top)
215 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
221 array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
222 memcpy(a + 1,(void*)bottom,depth);
223 return tag<array>(a);
227 cell factor_vm::datastack_to_array(context *ctx)
229 cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
230 if(array == false_object)
232 general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
239 void factor_vm::primitive_datastack()
241 ctx->push(datastack_to_array(ctx));
244 void factor_vm::primitive_datastack_for()
246 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
247 ctx->push(datastack_to_array(other_ctx));
250 cell factor_vm::retainstack_to_array(context *ctx)
252 cell array = stack_to_array(ctx->retainstack_seg->start,ctx->retainstack);
253 if(array == false_object)
255 general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
262 void factor_vm::primitive_retainstack()
264 ctx->push(retainstack_to_array(ctx));
267 void factor_vm::primitive_retainstack_for()
269 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
270 ctx->push(retainstack_to_array(other_ctx));
273 /* returns pointer to top of stack */
274 cell factor_vm::array_to_stack(array *array, cell bottom)
276 cell depth = array_capacity(array) * sizeof(cell);
277 memcpy((void*)bottom,array + 1,depth);
278 return bottom + depth - sizeof(cell);
281 void factor_vm::set_datastack(context *ctx, array *array)
283 ctx->datastack = array_to_stack(array,ctx->datastack_seg->start);
286 void factor_vm::primitive_set_datastack()
288 set_datastack(ctx,untag_check<array>(ctx->pop()));
291 void factor_vm::set_retainstack(context *ctx, array *array)
293 ctx->retainstack = array_to_stack(array,ctx->retainstack_seg->start);
296 void factor_vm::primitive_set_retainstack()
298 set_retainstack(ctx,untag_check<array>(ctx->pop()));
301 /* Used to implement call( */
302 void factor_vm::primitive_check_datastack()
304 fixnum out = to_fixnum(ctx->pop());
305 fixnum in = to_fixnum(ctx->pop());
306 fixnum height = out - in;
307 array *saved_datastack = untag_check<array>(ctx->pop());
308 fixnum saved_height = array_capacity(saved_datastack);
309 fixnum current_height = (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) / sizeof(cell);
310 if(current_height - height != saved_height)
311 ctx->push(false_object);
314 cell *ds_bot = (cell *)ctx->datastack_seg->start;
315 for(fixnum i = 0; i < saved_height - in; i++)
317 if(ds_bot[i] != array_nth(saved_datastack,i))
319 ctx->push(false_object);
323 ctx->push(true_object);
327 void factor_vm::primitive_load_locals()
329 fixnum count = untag_fixnum(ctx->pop());
330 memcpy((cell *)(ctx->retainstack + sizeof(cell)),
331 (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
332 sizeof(cell) * count);
333 ctx->datastack -= sizeof(cell) * count;
334 ctx->retainstack += sizeof(cell) * count;