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 /* Allocates memory */
112 cell factor_vm::frame_scan(stack_frame *frame)
114 switch(frame_type(frame))
116 case code_block_unoptimized:
118 tagged<object> obj(frame_executing(frame));
119 if(obj.type_p(WORD_TYPE))
120 obj = obj.as<word>()->def;
122 if(obj.type_p(QUOTATION_TYPE))
124 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
125 char *quot_entry_point = (char *)frame_code(frame)->entry_point();
127 return tag_fixnum(quot_code_offset_to_scan(
128 obj.value(),(cell)(return_addr - quot_entry_point)));
133 case code_block_optimized:
136 critical_error("Bad frame type",frame_type(frame));
144 struct stack_frame_accumulator {
146 growable_array frames;
148 explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
150 void operator()(stack_frame *frame)
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);
156 frames.add(executing.value());
157 frames.add(executing_quot.value());
158 frames.add(scan.value());
164 void factor_vm::primitive_callstack_to_array()
166 data_root<callstack> callstack(ctx->pop(),this);
168 stack_frame_accumulator accum(this);
169 iterate_callstack_object(callstack.untagged(),accum);
172 ctx->push(accum.frames.elements.value());
175 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
177 stack_frame *top = stack->top();
178 stack_frame *bottom = stack->bottom();
179 stack_frame *frame = bottom - 1;
181 while(frame >= top && frame_successor(frame) >= top)
182 frame = frame_successor(frame);
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()
191 stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
192 ctx->push(frame_executing_quot(frame));
195 void factor_vm::primitive_innermost_stack_frame_scan()
197 stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
198 ctx->push(frame_scan(frame));
201 void factor_vm::primitive_set_innermost_stack_frame_quot()
203 data_root<callstack> callstack(ctx->pop(),this);
204 data_root<quotation> quot(ctx->pop(),this);
206 callstack.untag_check(this);
207 quot.untag_check(this);
209 jit_compile_quot(quot.value(),true);
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;
217 void factor_vm::primitive_callstack_bounds()
219 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
220 ctx->push(allot_alien((void*)ctx->callstack_seg->end));