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_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 two topmost frames, the 'callstack' primitive
32 frame itself, and the frame calling the 'callstack' primitive,
33 so that set-callstack doesn't get stuck in an infinite loop.
35 This means that if 'callstack' is called in tail position, we
36 will have popped a necessary frame... however this word is only
37 called by continuation implementation, and user code shouldn't
38 be calling it at all, so we leave it as it is for now. */
39 stack_frame *factor_vm::second_from_top_stack_frame()
41 stack_frame *frame = ctx->callstack_bottom - 1;
42 while(frame >= ctx->callstack_top
43 && frame_successor(frame) >= ctx->callstack_top
44 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
46 frame = frame_successor(frame);
51 void factor_vm::primitive_callstack()
53 stack_frame *top = second_from_top_stack_frame();
54 stack_frame *bottom = ctx->callstack_bottom;
56 fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
58 callstack *stack = allot_callstack(size);
59 memcpy(stack->top(),top,size);
60 ctx->push(tag<callstack>(stack));
63 code_block *factor_vm::frame_code(stack_frame *frame)
66 return (code_block *)frame->entry_point - 1;
69 code_block_type factor_vm::frame_type(stack_frame *frame)
71 return frame_code(frame)->type();
74 cell factor_vm::frame_executing(stack_frame *frame)
76 return frame_code(frame)->owner;
79 cell factor_vm::frame_executing_quot(stack_frame *frame)
81 tagged<object> executing(frame_executing(frame));
82 code_block *compiled = frame_code(frame);
83 if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
84 executing = executing.as<word>()->def;
85 return executing.value();
88 stack_frame *factor_vm::frame_successor(stack_frame *frame)
91 return (stack_frame *)((cell)frame - frame->size);
94 /* Allocates memory */
95 cell factor_vm::frame_scan(stack_frame *frame)
97 switch(frame_type(frame))
99 case code_block_unoptimized:
101 tagged<object> obj(frame_executing(frame));
102 if(obj.type_p(WORD_TYPE))
103 obj = obj.as<word>()->def;
105 if(obj.type_p(QUOTATION_TYPE))
107 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
108 char *quot_entry_point = (char *)(frame_code(frame) + 1);
110 return tag_fixnum(quot_code_offset_to_scan(
111 obj.value(),(cell)(return_addr - quot_entry_point)));
116 case code_block_optimized:
119 critical_error("Bad frame type",frame_type(frame));
127 struct stack_frame_accumulator {
129 growable_array frames;
131 explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
133 void operator()(stack_frame *frame)
135 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
136 data_root<object> executing(parent->frame_executing(frame),parent);
137 data_root<object> scan(parent->frame_scan(frame),parent);
139 frames.add(executing.value());
140 frames.add(executing_quot.value());
141 frames.add(scan.value());
147 void factor_vm::primitive_callstack_to_array()
149 data_root<callstack> callstack(ctx->pop(),this);
151 stack_frame_accumulator accum(this);
152 iterate_callstack_object(callstack.untagged(),accum);
155 ctx->push(accum.frames.elements.value());
158 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
160 stack_frame *top = stack->top();
161 stack_frame *bottom = stack->bottom();
162 stack_frame *frame = bottom - 1;
164 while(frame >= top && frame_successor(frame) >= top)
165 frame = frame_successor(frame);
170 /* Some primitives implementing a limited form of callstack mutation.
171 Used by the single stepper. */
172 void factor_vm::primitive_innermost_stack_frame_executing()
174 stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
175 ctx->push(frame_executing_quot(frame));
178 void factor_vm::primitive_innermost_stack_frame_scan()
180 stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
181 ctx->push(frame_scan(frame));
184 void factor_vm::primitive_set_innermost_stack_frame_quot()
186 data_root<callstack> callstack(ctx->pop(),this);
187 data_root<quotation> quot(ctx->pop(),this);
189 callstack.untag_check(this);
190 quot.untag_check(this);
192 jit_compile_quot(quot.value(),true);
194 stack_frame *inner = innermost_stack_frame(callstack.untagged());
195 cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->entry_point;
196 inner->entry_point = quot->entry_point;
197 FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->entry_point + offset;