6 void factor_vm::check_frame(stack_frame *frame)
9 check_code_pointer((cell)frame->entry_point);
10 assert(frame->size != 0);
14 callstack *factor_vm::allot_callstack(cell size)
16 callstack *stack = allot<callstack>(callstack_object_size(size));
17 stack->length = tag_fixnum(size);
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)
27 stack_frame *frame = ctx->callstack_bottom - 1;
30 && frame >= ctx->callstack_top
31 && (cell)frame >= ctx->callstack_seg->start + stack_reserved)
32 frame = frame_successor(frame);
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.
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)
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)
52 frame = frame_successor(frame);
57 cell factor_vm::capture_callstack(context *ctx)
59 stack_frame *top = second_from_top_stack_frame(ctx);
60 stack_frame *bottom = ctx->callstack_bottom;
62 fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
64 callstack *stack = allot_callstack(size);
65 memcpy(stack->top(),top,size);
66 return tag<callstack>(stack);
69 void factor_vm::primitive_callstack()
71 ctx->push(capture_callstack(ctx));
74 void factor_vm::primitive_callstack_for()
76 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
77 ctx->push(capture_callstack(other_ctx));
80 code_block *factor_vm::frame_code(stack_frame *frame)
83 return (code_block *)frame->entry_point - 1;
86 code_block_type factor_vm::frame_type(stack_frame *frame)
88 return frame_code(frame)->type();
91 cell factor_vm::frame_executing(stack_frame *frame)
93 return frame_code(frame)->owner;
96 cell factor_vm::frame_executing_quot(stack_frame *frame)
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();
105 stack_frame *factor_vm::frame_successor(stack_frame *frame)
108 return (stack_frame *)((cell)frame - frame->size);
111 cell factor_vm::frame_offset(stack_frame *frame)
113 char *entry_point = (char *)frame_code(frame)->entry_point();
114 char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
116 return return_address - entry_point;
121 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
123 char *entry_point = (char *)frame_code(frame)->entry_point();
124 if(offset == (cell)-1)
125 FRAME_RETURN_ADDRESS(frame,this) = NULL;
127 FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
130 void factor_vm::scrub_return_address()
132 stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
134 set_frame_offset(frame,0);
137 cell factor_vm::frame_scan(stack_frame *frame)
139 switch(frame_type(frame))
141 case code_block_unoptimized:
143 tagged<object> obj(frame_executing(frame));
144 if(obj.type_p(WORD_TYPE))
145 obj = obj.as<word>()->def;
147 if(obj.type_p(QUOTATION_TYPE))
148 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
152 case code_block_optimized:
155 critical_error("Bad frame type",frame_type(frame));
160 struct stack_frame_accumulator {
162 growable_array frames;
164 explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
166 void operator()(stack_frame *frame)
168 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
169 data_root<object> executing(parent->frame_executing(frame),parent);
170 data_root<object> scan(parent->frame_scan(frame),parent);
172 frames.add(executing.value());
173 frames.add(executing_quot.value());
174 frames.add(scan.value());
178 void factor_vm::primitive_callstack_to_array()
180 data_root<callstack> callstack(ctx->pop(),this);
182 stack_frame_accumulator accum(this);
183 iterate_callstack_object(callstack.untagged(),accum);
186 ctx->push(accum.frames.elements.value());
189 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
191 stack_frame *frame = bottom - 1;
193 while(frame >= top && frame_successor(frame) >= top)
194 frame = frame_successor(frame);
199 /* Some primitives implementing a limited form of callstack mutation.
200 Used by the single stepper. */
201 void factor_vm::primitive_innermost_stack_frame_executing()
203 callstack *stack = untag_check<callstack>(ctx->pop());
204 stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
205 ctx->push(frame_executing_quot(frame));
208 void factor_vm::primitive_innermost_stack_frame_scan()
210 callstack *stack = untag_check<callstack>(ctx->pop());
211 stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
212 ctx->push(frame_scan(frame));
215 void factor_vm::primitive_set_innermost_stack_frame_quot()
217 data_root<callstack> stack(ctx->pop(),this);
218 data_root<quotation> quot(ctx->pop(),this);
220 stack.untag_check(this);
221 quot.untag_check(this);
223 jit_compile_quot(quot.value(),true);
225 stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
226 cell offset = frame_offset(inner);
227 inner->entry_point = quot->entry_point;
228 set_frame_offset(inner,offset);
231 void factor_vm::primitive_callstack_bounds()
233 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
234 ctx->push(allot_alien((void*)ctx->callstack_seg->end));