3 factor::context *stack_chain;
9 context *unused_contexts;
11 void reset_datastack()
13 ds = ds_bot - sizeof(cell);
16 void reset_retainstack()
18 rs = rs_bot - sizeof(cell);
21 static const cell stack_reserved = (64 * sizeof(cell));
25 if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
26 if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
29 /* called before entry into foreign C code. Note that ds and rs might
30 be stored in registers, so callbacks must save and restore the correct values */
35 stack_chain->datastack = ds;
36 stack_chain->retainstack = rs;
40 context *alloc_context()
46 new_context = unused_contexts;
47 unused_contexts = unused_contexts->next;
51 new_context = (context *)safe_malloc(sizeof(context));
52 new_context->datastack_region = alloc_segment(ds_size);
53 new_context->retainstack_region = alloc_segment(rs_size);
59 void dealloc_context(context *old_context)
61 old_context->next = unused_contexts;
62 unused_contexts = old_context;
65 /* called on entry into a compiled callback */
68 context *new_context = alloc_context();
70 new_context->callstack_bottom = (stack_frame *)-1;
71 new_context->callstack_top = (stack_frame *)-1;
73 /* note that these register values are not necessarily valid stack
74 pointers. they are merely saved non-volatile registers, and are
75 restored in unnest_stacks(). consider this scenario:
76 - factor code calls C function
77 - C function saves ds/cs registers (since they're non-volatile)
78 - C function clobbers them
79 - C function calls Factor callback
80 - Factor callback returns
81 - C function restores registers
82 - C function returns to Factor code */
83 new_context->datastack_save = ds;
84 new_context->retainstack_save = rs;
86 /* save per-callback userenv */
87 new_context->current_callback_save = userenv[CURRENT_CALLBACK_ENV];
88 new_context->catchstack_save = userenv[CATCHSTACK_ENV];
90 new_context->next = stack_chain;
91 stack_chain = new_context;
97 /* called when leaving a compiled callback */
100 ds = stack_chain->datastack_save;
101 rs = stack_chain->retainstack_save;
103 /* restore per-callback userenv */
104 userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save;
105 userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save;
107 context *old_stacks = stack_chain;
108 stack_chain = old_stacks->next;
109 dealloc_context(old_stacks);
112 /* called on startup */
113 void init_stacks(cell ds_size_, cell rs_size_)
118 unused_contexts = NULL;
121 bool stack_to_array(cell bottom, cell top)
123 fixnum depth = (fixnum)(top - bottom + sizeof(cell));
129 array *a = allot_array_internal<array>(depth / sizeof(cell));
130 memcpy(a + 1,(void*)bottom,depth);
131 dpush(tag<array>(a));
138 if(!stack_to_array(ds_bot,ds))
139 general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
142 PRIMITIVE(retainstack)
144 if(!stack_to_array(rs_bot,rs))
145 general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
148 /* returns pointer to top of stack */
149 cell array_to_stack(array *array, cell bottom)
151 cell depth = array_capacity(array) * sizeof(cell);
152 memcpy((void*)bottom,array + 1,depth);
153 return bottom + depth - sizeof(cell);
156 PRIMITIVE(set_datastack)
158 ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
161 PRIMITIVE(set_retainstack)
163 rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
166 /* Used to implement call( */
167 PRIMITIVE(check_datastack)
169 fixnum out = to_fixnum(dpop());
170 fixnum in = to_fixnum(dpop());
171 fixnum height = out - in;
172 array *saved_datastack = untag_check<array>(dpop());
173 fixnum saved_height = array_capacity(saved_datastack);
174 fixnum current_height = (ds - ds_bot + sizeof(cell)) / sizeof(cell);
175 if(current_height - height != saved_height)
180 for(i = 0; i < saved_height - in; i++)
182 if(((cell *)ds_bot)[i] != array_nth(saved_datastack,i))