]> gitweb.factorcode.org Git - factor.git/blob - vm/callstack.cpp
bb716cbc6dd3ad7bb9465eb588b07329a74843ca
[factor.git] / vm / callstack.cpp
1 #include "master.hpp"
2
3 namespace factor
4 {
5
6 void factor_vm::check_frame(stack_frame *frame)
7 {
8 #ifdef FACTOR_DEBUG
9         check_code_pointer((cell)frame->entry_point);
10         assert(frame->size != 0);
11 #endif
12 }
13
14 callstack *factor_vm::allot_callstack(cell size)
15 {
16         callstack *stack = allot<callstack>(callstack_object_size(size));
17         stack->length = tag_fixnum(size);
18         return stack;
19 }
20
21 /* If 'stack' points into the middle of the frame, find the nearest valid stack
22 pointer where we can resume execution and hope to capture the call trace without
23 crashing. Also, make sure we have at least 'stack_reserved' bytes available so
24 that we don't run out of callstack space while handling the error. */
25 stack_frame *factor_vm::fix_callstack_top(stack_frame *stack)
26 {
27         stack_frame *frame = ctx->callstack_bottom - 1;
28
29         while(frame >= stack
30                 && frame >= ctx->callstack_top
31                 && (cell)frame >= ctx->callstack_seg->start + stack_reserved)
32                 frame = frame_successor(frame);
33
34         return frame + 1;
35 }
36
37 /* We ignore the two topmost frames, the 'callstack' primitive
38 frame itself, and the frame calling the 'callstack' primitive,
39 so that set-callstack doesn't get stuck in an infinite loop.
40
41 This means that if 'callstack' is called in tail position, we
42 will have popped a necessary frame... however this word is only
43 called by continuation implementation, and user code shouldn't
44 be calling it at all, so we leave it as it is for now. */
45 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
46 {
47         stack_frame *frame = ctx->callstack_bottom - 1;
48         while(frame >= ctx->callstack_top
49                 && frame_successor(frame) >= ctx->callstack_top
50                 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
51         {
52                 frame = frame_successor(frame);
53         }
54         return frame + 1;
55 }
56
57 cell factor_vm::capture_callstack(context *ctx)
58 {
59         stack_frame *top = second_from_top_stack_frame(ctx);
60         stack_frame *bottom = ctx->callstack_bottom;
61
62         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
63
64         callstack *stack = allot_callstack(size);
65         memcpy(stack->top(),top,size);
66         return tag<callstack>(stack);
67 }
68
69 void factor_vm::primitive_callstack()
70 {
71         ctx->push(capture_callstack(ctx));
72 }
73
74 void factor_vm::primitive_callstack_for()
75 {
76         context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
77         ctx->push(capture_callstack(other_ctx));
78 }
79
80 code_block *factor_vm::frame_code(stack_frame *frame)
81 {
82         check_frame(frame);
83         return (code_block *)frame->entry_point - 1;
84 }
85
86 code_block_type factor_vm::frame_type(stack_frame *frame)
87 {
88         return frame_code(frame)->type();
89 }
90
91 cell factor_vm::frame_executing(stack_frame *frame)
92 {
93         return frame_code(frame)->owner;
94 }
95
96 cell factor_vm::frame_executing_quot(stack_frame *frame)
97 {
98         tagged<object> executing(frame_executing(frame));
99         code_block *compiled = frame_code(frame);
100         if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
101                 executing = executing.as<word>()->def;
102         return executing.value();
103 }
104
105 stack_frame *factor_vm::frame_successor(stack_frame *frame)
106 {
107         check_frame(frame);
108         return (stack_frame *)((cell)frame - frame->size);
109 }
110
111 /* Allocates memory */
112 cell factor_vm::frame_scan(stack_frame *frame)
113 {
114         switch(frame_type(frame))
115         {
116         case code_block_unoptimized:
117                 {
118                         tagged<object> obj(frame_executing(frame));
119                         if(obj.type_p(WORD_TYPE))
120                                 obj = obj.as<word>()->def;
121
122                         if(obj.type_p(QUOTATION_TYPE))
123                         {
124                                 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
125                                 char *quot_entry_point = (char *)frame_code(frame)->entry_point();
126
127                                 return tag_fixnum(quot_code_offset_to_scan(
128                                         obj.value(),(cell)(return_addr - quot_entry_point)));
129                         }    
130                         else
131                                 return false_object;
132                 }
133         case code_block_optimized:
134                 return false_object;
135         default:
136                 critical_error("Bad frame type",frame_type(frame));
137                 return false_object;
138         }
139 }
140
141 namespace
142 {
143
144 struct stack_frame_accumulator {
145         factor_vm *parent;
146         growable_array frames;
147
148         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {} 
149
150         void operator()(stack_frame *frame)
151         {
152                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
153                 data_root<object> executing(parent->frame_executing(frame),parent);
154                 data_root<object> scan(parent->frame_scan(frame),parent);
155
156                 frames.add(executing.value());
157                 frames.add(executing_quot.value());
158                 frames.add(scan.value());
159         }
160 };
161
162 }
163
164 void factor_vm::primitive_callstack_to_array()
165 {
166         data_root<callstack> callstack(ctx->pop(),this);
167
168         stack_frame_accumulator accum(this);
169         iterate_callstack_object(callstack.untagged(),accum);
170         accum.frames.trim();
171
172         ctx->push(accum.frames.elements.value());
173 }
174
175 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
176 {
177         stack_frame *top = stack->top();
178         stack_frame *bottom = stack->bottom();
179         stack_frame *frame = bottom - 1;
180
181         while(frame >= top && frame_successor(frame) >= top)
182                 frame = frame_successor(frame);
183
184         return frame;
185 }
186
187 /* Some primitives implementing a limited form of callstack mutation.
188 Used by the single stepper. */
189 void factor_vm::primitive_innermost_stack_frame_executing()
190 {
191         stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
192         ctx->push(frame_executing_quot(frame));
193 }
194
195 void factor_vm::primitive_innermost_stack_frame_scan()
196 {
197         stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
198         ctx->push(frame_scan(frame));
199 }
200
201 void factor_vm::primitive_set_innermost_stack_frame_quot()
202 {
203         data_root<callstack> callstack(ctx->pop(),this);
204         data_root<quotation> quot(ctx->pop(),this);
205
206         callstack.untag_check(this);
207         quot.untag_check(this);
208
209         jit_compile_quot(quot.value(),true);
210
211         stack_frame *inner = innermost_stack_frame(callstack.untagged());
212         cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->entry_point;
213         inner->entry_point = quot->entry_point;
214         FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->entry_point + offset;
215 }
216
217 void factor_vm::primitive_callstack_bounds()
218 {
219         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
220         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
221 }
222
223 }