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 = stack_chain->callstack_bottom - 1;
41 while(frame >= stack_chain->callstack_top
42 && frame_successor(frame) >= stack_chain->callstack_top)
44 frame = frame_successor(frame);
49 inline void factor_vm::primitive_callstack()
51 stack_frame *top = capture_start();
52 stack_frame *bottom = stack_chain->callstack_bottom;
54 fixnum size = (cell)bottom - (cell)top;
58 callstack *stack = allot_callstack(size);
59 memcpy(stack->top(),top,size);
60 dpush(tag<callstack>(stack));
63 PRIMITIVE_FORWARD(callstack)
65 inline void factor_vm::primitive_set_callstack()
67 callstack *stack = untag_check<callstack>(dpop());
69 set_callstack(stack_chain->callstack_bottom,
71 untag_fixnum(stack->length),
74 /* We cannot return here ... */
75 critical_error("Bug in set_callstack()",0);
78 PRIMITIVE_FORWARD(set_callstack)
80 code_block *factor_vm::frame_code(stack_frame *frame)
83 return (code_block *)frame->xt - 1;
86 cell factor_vm::frame_type(stack_frame *frame)
88 return frame_code(frame)->type;
91 cell factor_vm::frame_executing(stack_frame *frame)
93 code_block *compiled = frame_code(frame);
94 if(compiled->literals == F || !stack_traces_p())
98 array *literals = untag<array>(compiled->literals);
99 cell executing = array_nth(literals,0);
100 check_data_pointer((object *)executing);
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))
118 cell quot = frame_executing(frame);
123 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
124 char *quot_xt = (char *)(frame_code(frame) + 1);
126 return tag_fixnum(quot_code_offset_to_scan(
127 quot,(cell)(return_addr - quot_xt)));
133 critical_error("Bad frame type",frame_type(frame));
141 struct stack_frame_accumulator {
142 growable_array frames;
144 stack_frame_accumulator(factor_vm *vm) : frames(vm) {}
146 void operator()(stack_frame *frame, factor_vm *myvm)
148 gc_root<object> executing(myvm->frame_executing(frame),myvm);
149 gc_root<object> scan(myvm->frame_scan(frame),myvm);
151 frames.add(executing.value());
152 frames.add(scan.value());
158 inline void factor_vm::primitive_callstack_to_array()
160 gc_root<callstack> callstack(dpop(),this);
162 stack_frame_accumulator accum(this);
163 iterate_callstack_object(callstack.untagged(),accum);
166 dpush(accum.frames.elements.value());
169 PRIMITIVE_FORWARD(callstack_to_array)
171 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
173 stack_frame *top = stack->top();
174 stack_frame *bottom = stack->bottom();
175 stack_frame *frame = bottom - 1;
177 while(frame >= top && frame_successor(frame) >= top)
178 frame = frame_successor(frame);
183 stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
185 stack_frame *inner = innermost_stack_frame(callstack);
186 tagged<quotation>(frame_executing(inner)).untag_check(this);
190 /* Some primitives implementing a limited form of callstack mutation.
191 Used by the single stepper. */
192 inline void factor_vm::primitive_innermost_stack_frame_executing()
194 dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
197 PRIMITIVE_FORWARD(innermost_stack_frame_executing)
199 inline void factor_vm::primitive_innermost_stack_frame_scan()
201 dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
204 PRIMITIVE_FORWARD(innermost_stack_frame_scan)
206 inline void factor_vm::primitive_set_innermost_stack_frame_quot()
208 gc_root<callstack> callstack(dpop(),this);
209 gc_root<quotation> quot(dpop(),this);
211 callstack.untag_check(this);
212 quot.untag_check(this);
214 jit_compile(quot.value(),true);
216 stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
217 cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
218 inner->xt = quot->xt;
219 FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
222 PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
224 /* called before entry into Factor code. */
225 void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
227 stack_chain->callstack_bottom = callstack_bottom;
230 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm)
233 return VM_PTR->save_callstack_bottom(callstack_bottom);