]> gitweb.factorcode.org Git - factor.git/blob - vm/contexts.cpp
Merge branch 'master' of git://factorcode.org/git/factor
[factor.git] / vm / contexts.cpp
1 #include "master.hpp"
2
3 namespace factor
4 {
5
6 void factor_vm::reset_datastack()
7 {
8         ds = ds_bot - sizeof(cell);
9 }
10
11 void factor_vm::reset_retainstack()
12 {
13         rs = rs_bot - sizeof(cell);
14 }
15
16 static const cell stack_reserved = (64 * sizeof(cell));
17
18 void factor_vm::fix_stacks()
19 {
20         if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
21         if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
22 }
23
24 /* called before entry into foreign C code. Note that ds and rs might
25 be stored in registers, so callbacks must save and restore the correct values */
26 void factor_vm::save_stacks()
27 {
28         if(ctx)
29         {
30                 ctx->datastack = ds;
31                 ctx->retainstack = rs;
32         }
33 }
34
35 context *factor_vm::alloc_context()
36 {
37         context *new_context;
38
39         if(unused_contexts)
40         {
41                 new_context = unused_contexts;
42                 unused_contexts = unused_contexts->next;
43         }
44         else
45         {
46                 new_context = new context;
47                 new_context->datastack_region = new segment(ds_size,false);
48                 new_context->retainstack_region = new segment(rs_size,false);
49         }
50
51         return new_context;
52 }
53
54 void factor_vm::dealloc_context(context *old_context)
55 {
56         old_context->next = unused_contexts;
57         unused_contexts = old_context;
58 }
59
60 /* called on entry into a compiled callback */
61 void factor_vm::nest_stacks(stack_frame *magic_frame)
62 {
63         context *new_ctx = alloc_context();
64
65         new_ctx->callstack_bottom = (stack_frame *)-1;
66         new_ctx->callstack_top = (stack_frame *)-1;
67
68         /* note that these register values are not necessarily valid stack
69         pointers. they are merely saved non-volatile registers, and are
70         restored in unnest_stacks(). consider this scenario:
71         - factor code calls C function
72         - C function saves ds/cs registers (since they're non-volatile)
73         - C function clobbers them
74         - C function calls Factor callback
75         - Factor callback returns
76         - C function restores registers
77         - C function returns to Factor code */
78         new_ctx->datastack_save = ds;
79         new_ctx->retainstack_save = rs;
80
81         new_ctx->magic_frame = magic_frame;
82
83         /* save per-callback userenv */
84         new_ctx->current_callback_save = userenv[CURRENT_CALLBACK_ENV];
85         new_ctx->catchstack_save = userenv[CATCHSTACK_ENV];
86
87         new_ctx->next = ctx;
88         ctx = new_ctx;
89
90         reset_datastack();
91         reset_retainstack();
92 }
93
94 void nest_stacks(stack_frame *magic_frame, factor_vm *parent)
95 {
96         return parent->nest_stacks(magic_frame);
97 }
98
99 /* called when leaving a compiled callback */
100 void factor_vm::unnest_stacks()
101 {
102         ds = ctx->datastack_save;
103         rs = ctx->retainstack_save;
104
105         /* restore per-callback userenv */
106         userenv[CURRENT_CALLBACK_ENV] = ctx->current_callback_save;
107         userenv[CATCHSTACK_ENV] = ctx->catchstack_save;
108
109         context *old_ctx = ctx;
110         ctx = old_ctx->next;
111         dealloc_context(old_ctx);
112 }
113
114 void unnest_stacks(factor_vm *parent)
115 {
116         return parent->unnest_stacks();
117 }
118
119 /* called on startup */
120 void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
121 {
122         ds_size = ds_size_;
123         rs_size = rs_size_;
124         ctx = NULL;
125         unused_contexts = NULL;
126 }
127
128 bool factor_vm::stack_to_array(cell bottom, cell top)
129 {
130         fixnum depth = (fixnum)(top - bottom + sizeof(cell));
131
132         if(depth < 0)
133                 return false;
134         else
135         {
136                 array *a = allot_array_internal<array>(depth / sizeof(cell));
137                 memcpy(a + 1,(void*)bottom,depth);
138                 dpush(tag<array>(a));
139                 return true;
140         }
141 }
142
143 void factor_vm::primitive_datastack()
144 {
145         if(!stack_to_array(ds_bot,ds))
146                 general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
147 }
148
149 void factor_vm::primitive_retainstack()
150 {
151         if(!stack_to_array(rs_bot,rs))
152                 general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
153 }
154
155 /* returns pointer to top of stack */
156 cell factor_vm::array_to_stack(array *array, cell bottom)
157 {
158         cell depth = array_capacity(array) * sizeof(cell);
159         memcpy((void*)bottom,array + 1,depth);
160         return bottom + depth - sizeof(cell);
161 }
162
163 void factor_vm::primitive_set_datastack()
164 {
165         ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
166 }
167
168 void factor_vm::primitive_set_retainstack()
169 {
170         rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
171 }
172
173 /* Used to implement call( */
174 void factor_vm::primitive_check_datastack()
175 {
176         fixnum out = to_fixnum(dpop());
177         fixnum in = to_fixnum(dpop());
178         fixnum height = out - in;
179         array *saved_datastack = untag_check<array>(dpop());
180         fixnum saved_height = array_capacity(saved_datastack);
181         fixnum current_height = (ds - ds_bot + sizeof(cell)) / sizeof(cell);
182         if(current_height - height != saved_height)
183                 dpush(false_object);
184         else
185         {
186                 fixnum i;
187                 for(i = 0; i < saved_height - in; i++)
188                 {
189                         if(((cell *)ds_bot)[i] != array_nth(saved_datastack,i))
190                         {
191                                 dpush(false_object);
192                                 return;
193                         }
194                 }
195                 dpush(true_object);
196         }
197 }
198
199 }