5 context::context(cell datastack_size, cell retainstack_size,
12 datastack_seg(new segment(datastack_size, false)),
13 retainstack_seg(new segment(retainstack_size, false)),
14 callstack_seg(new segment(callstack_size, false)) {
18 void context::reset_datastack() {
19 datastack = datastack_seg->start - sizeof(cell);
20 fill_stack_seg(datastack, datastack_seg, 0x11111111);
23 void context::reset_retainstack() {
24 retainstack = retainstack_seg->start - sizeof(cell);
25 fill_stack_seg(retainstack, retainstack_seg, 0x22222222);
28 void context::reset_callstack() {
29 callstack_top = callstack_bottom = CALLSTACK_BOTTOM(this);
32 void context::reset_context_objects() {
33 memset_cell(context_objects, false_object,
34 context_object_count * sizeof(cell));
37 void context::fill_stack_seg(cell top_ptr, segment* seg, cell pattern) {
39 cell clear_start = top_ptr + sizeof(cell);
40 cell clear_size = seg->end - clear_start;
41 memset_cell((void*)clear_start, pattern, clear_size);
45 vm_error_type context::address_to_error(cell addr) {
46 if (datastack_seg->underflow_p(addr))
47 return ERROR_DATASTACK_UNDERFLOW;
48 if (datastack_seg->overflow_p(addr))
49 return ERROR_DATASTACK_OVERFLOW;
50 if (retainstack_seg->underflow_p(addr))
51 return ERROR_RETAINSTACK_UNDERFLOW;
52 if (retainstack_seg->overflow_p(addr))
53 return ERROR_RETAINSTACK_OVERFLOW;
54 /* These are flipped because the callstack grows downwards. */
55 if (callstack_seg->underflow_p(addr))
56 return ERROR_CALLSTACK_OVERFLOW;
57 if (callstack_seg->overflow_p(addr))
58 return ERROR_CALLSTACK_UNDERFLOW;
62 void context::reset() {
66 reset_context_objects();
69 void context::fix_stacks() {
70 if (datastack + sizeof(cell) < datastack_seg->start ||
71 datastack + stack_reserved >= datastack_seg->end)
74 if (retainstack + sizeof(cell) < retainstack_seg->start ||
75 retainstack + stack_reserved >= retainstack_seg->end)
81 delete retainstack_seg;
85 /* called on startup */
86 /* Allocates memory (new_context()) */
87 void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_,
88 cell callstack_size_) {
89 datastack_size = datastack_size_;
90 retainstack_size = retainstack_size_;
91 callstack_size = callstack_size_;
94 spare_ctx = new_context();
97 void factor_vm::delete_contexts() {
99 FACTOR_FOR_EACH(unused_contexts) {
105 context* factor_vm::new_context() {
106 context* new_context;
108 if (unused_contexts.empty()) {
109 new_context = new context(datastack_size, retainstack_size, callstack_size);
111 new_context = unused_contexts.back();
112 unused_contexts.pop_back();
115 new_context->reset();
117 active_contexts.insert(new_context);
122 /* Allocates memory */
123 void factor_vm::init_context(context* ctx) {
124 ctx->context_objects[OBJ_CONTEXT] = allot_alien(ctx);
127 /* Allocates memory (init_context(), but not parent->new_context() */
128 VM_C_API context* new_context(factor_vm* parent) {
129 context* new_context = parent->new_context();
130 parent->init_context(new_context);
134 void factor_vm::delete_context() {
135 unused_contexts.push_back(ctx);
136 active_contexts.erase(ctx);
138 while (unused_contexts.size() > 10) {
139 context* stale_context = unused_contexts.front();
140 unused_contexts.pop_front();
141 delete stale_context;
145 VM_C_API void delete_context(factor_vm* parent) {
146 parent->delete_context();
149 /* Allocates memory (init_context()) */
150 VM_C_API void reset_context(factor_vm* parent) {
152 // The function is used by (start-context-and-delete) which expects
153 // the top two datastack items to be preserved after the context has
156 context* ctx = parent->ctx;
157 cell arg1 = ctx->pop();
158 cell arg2 = ctx->pop();
162 parent->init_context(ctx);
165 /* Allocates memory */
166 cell factor_vm::begin_callback(cell quot_) {
167 data_root<object> quot(quot_, this);
170 spare_ctx = new_context();
171 callback_ids.push_back(callback_id++);
178 /* Allocates memory */
179 cell begin_callback(factor_vm* parent, cell quot) {
180 return parent->begin_callback(quot);
183 void factor_vm::end_callback() {
184 callback_ids.pop_back();
188 void end_callback(factor_vm* parent) { parent->end_callback(); }
190 void factor_vm::primitive_current_callback() {
191 ctx->push(tag_fixnum(callback_ids.back()));
194 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() {
200 fixnum n = untag_fixnum(ctx->pop());
201 cell value = ctx->pop();
202 ctx->context_objects[n] = value;
205 void factor_vm::primitive_context_object_for() {
206 context* other_ctx = (context*)pinned_alien_offset(ctx->pop());
207 fixnum n = untag_fixnum(ctx->peek());
208 ctx->replace(other_ctx->context_objects[n]);
211 /* Allocates memory */
212 cell factor_vm::stack_to_array(cell bottom, cell top, vm_error_type error) {
213 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
216 general_error(error, false_object, false_object);
218 array* a = allot_uninitialized_array<array>(depth / sizeof(cell));
219 memcpy(a + 1, (void*)bottom, depth);
220 return tag<array>(a);
223 /* Allocates memory */
224 cell factor_vm::datastack_to_array(context* ctx) {
225 return stack_to_array(ctx->datastack_seg->start,
227 ERROR_DATASTACK_UNDERFLOW);
230 /* Allocates memory */
231 void factor_vm::primitive_datastack() { ctx->push(datastack_to_array(ctx)); }
233 /* Allocates memory */
234 void factor_vm::primitive_datastack_for() {
235 context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
236 ctx->replace(datastack_to_array(other_ctx));
239 /* Allocates memory */
240 cell factor_vm::retainstack_to_array(context* ctx) {
241 return stack_to_array(ctx->retainstack_seg->start,
243 ERROR_RETAINSTACK_UNDERFLOW);
246 /* Allocates memory */
247 void factor_vm::primitive_retainstack() {
248 ctx->push(retainstack_to_array(ctx));
251 /* Allocates memory */
252 void factor_vm::primitive_retainstack_for() {
253 context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
254 ctx->replace(retainstack_to_array(other_ctx));
257 /* returns pointer to top of stack */
258 cell factor_vm::array_to_stack(array* array, cell bottom) {
259 cell depth = array_capacity(array) * sizeof(cell);
260 memcpy((void*)bottom, array + 1, depth);
261 return bottom + depth - sizeof(cell);
264 void factor_vm::set_datastack(context* ctx, array* array) {
265 ctx->datastack = array_to_stack(array, ctx->datastack_seg->start);
268 void factor_vm::primitive_set_datastack() {
269 set_datastack(ctx, untag_check<array>(ctx->pop()));
272 void factor_vm::set_retainstack(context* ctx, array* array) {
273 ctx->retainstack = array_to_stack(array, ctx->retainstack_seg->start);
276 void factor_vm::primitive_set_retainstack() {
277 set_retainstack(ctx, untag_check<array>(ctx->pop()));
280 /* Used to implement call( */
281 void factor_vm::primitive_check_datastack() {
282 fixnum out = to_fixnum(ctx->pop());
283 fixnum in = to_fixnum(ctx->pop());
284 fixnum height = out - in;
285 array* saved_datastack = untag_check<array>(ctx->pop());
286 fixnum saved_height = array_capacity(saved_datastack);
287 fixnum current_height =
288 (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) /
290 if (current_height - height != saved_height)
291 ctx->push(false_object);
293 cell* ds_bot = (cell*)ctx->datastack_seg->start;
294 for (fixnum i = 0; i < saved_height - in; i++) {
295 if (ds_bot[i] != array_nth(saved_datastack, i)) {
296 ctx->push(false_object);
300 ctx->push(true_object);
304 void factor_vm::primitive_load_locals() {
305 fixnum count = untag_fixnum(ctx->pop());
306 memcpy((cell*)(ctx->retainstack + sizeof(cell)),
307 (cell*)(ctx->datastack - sizeof(cell) * (count - 1)),
308 sizeof(cell) * count);
309 ctx->datastack -= sizeof(cell) * count;
310 ctx->retainstack += sizeof(cell) * count;