6 void factor_vm::check_frame(stack_frame *frame)
9 check_code_pointer((cell)frame->xt);
10 assert(frame->size != 0);
14 callstack *factor_vm::allot_callstack(cell size)
16 callstack *stack = allot<callstack>(callstack_size(size));
17 stack->length = tag_fixnum(size);
21 stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
23 stack_frame *frame = bottom - 1;
26 frame = frame_successor(frame);
31 /* We ignore the topmost frame, the one calling 'callstack',
32 so that set-callstack doesn't get stuck in an infinite loop.
34 This means that if 'callstack' is called in tail position, we
35 will have popped a necessary frame... however this word is only
36 called by continuation implementation, and user code shouldn't
37 be calling it at all, so we leave it as it is for now. */
38 stack_frame *factor_vm::capture_start()
40 stack_frame *frame = ctx->callstack_bottom - 1;
41 while(frame >= ctx->callstack_top && frame_successor(frame) >= ctx->callstack_top)
42 frame = frame_successor(frame);
46 void factor_vm::primitive_callstack()
48 stack_frame *top = capture_start();
49 stack_frame *bottom = ctx->callstack_bottom;
51 fixnum size = (cell)bottom - (cell)top;
55 callstack *stack = allot_callstack(size);
56 memcpy(stack->top(),top,size);
57 dpush(tag<callstack>(stack));
60 void factor_vm::primitive_set_callstack()
62 callstack *stack = untag_check<callstack>(dpop());
64 set_callstack(ctx->callstack_bottom,
66 untag_fixnum(stack->length),
69 /* We cannot return here ... */
70 critical_error("Bug in set_callstack()",0);
73 code_block *factor_vm::frame_code(stack_frame *frame)
76 return (code_block *)frame->xt - 1;
79 cell factor_vm::frame_type(stack_frame *frame)
81 return frame_code(frame)->type();
84 cell factor_vm::frame_executing(stack_frame *frame)
86 return frame_code(frame)->owner;
89 stack_frame *factor_vm::frame_successor(stack_frame *frame)
92 return (stack_frame *)((cell)frame - frame->size);
95 /* Allocates memory */
96 cell factor_vm::frame_scan(stack_frame *frame)
98 switch(frame_type(frame))
102 cell quot = frame_executing(frame);
105 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
106 char *quot_xt = (char *)(frame_code(frame) + 1);
108 return tag_fixnum(quot_code_offset_to_scan(
109 quot,(cell)(return_addr - quot_xt)));
117 critical_error("Bad frame type",frame_type(frame));
125 struct stack_frame_accumulator {
127 growable_array frames;
129 explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
131 void operator()(stack_frame *frame)
133 gc_root<object> executing(parent->frame_executing(frame),parent);
134 gc_root<object> scan(parent->frame_scan(frame),parent);
136 frames.add(executing.value());
137 frames.add(scan.value());
143 void factor_vm::primitive_callstack_to_array()
145 gc_root<callstack> callstack(dpop(),this);
147 stack_frame_accumulator accum(this);
148 iterate_callstack_object(callstack.untagged(),accum);
151 dpush(accum.frames.elements.value());
154 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
156 stack_frame *top = stack->top();
157 stack_frame *bottom = stack->bottom();
158 stack_frame *frame = bottom - 1;
160 while(frame >= top && frame_successor(frame) >= top)
161 frame = frame_successor(frame);
166 stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
168 stack_frame *inner = innermost_stack_frame(callstack);
169 tagged<quotation>(frame_executing(inner)).untag_check(this);
173 /* Some primitives implementing a limited form of callstack mutation.
174 Used by the single stepper. */
175 void factor_vm::primitive_innermost_stack_frame_executing()
177 dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
180 void factor_vm::primitive_innermost_stack_frame_scan()
182 dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
185 void factor_vm::primitive_set_innermost_stack_frame_quot()
187 gc_root<callstack> callstack(dpop(),this);
188 gc_root<quotation> quot(dpop(),this);
190 callstack.untag_check(this);
191 quot.untag_check(this);
193 jit_compile(quot.value(),true);
195 stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
196 cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
197 inner->xt = quot->xt;
198 FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
201 /* called before entry into Factor code. */
202 void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
204 ctx->callstack_bottom = callstack_bottom;
207 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *parent)
209 return parent->save_callstack_bottom(callstack_bottom);