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 /* We ignore the two topmost frames, the 'callstack' primitive
22 frame itself, and the frame calling the 'callstack' primitive,
23 so that set-callstack doesn't get stuck in an infinite loop.
25 This means that if 'callstack' is called in tail position, we
26 will have popped a necessary frame... however this word is only
27 called by continuation implementation, and user code shouldn't
28 be calling it at all, so we leave it as it is for now. */
29 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
31 stack_frame *frame = ctx->callstack_bottom - 1;
32 while(frame >= ctx->callstack_top
33 && frame_successor(frame) >= ctx->callstack_top
34 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
36 frame = frame_successor(frame);
41 cell factor_vm::capture_callstack(context *ctx)
43 stack_frame *top = second_from_top_stack_frame(ctx);
44 stack_frame *bottom = ctx->callstack_bottom;
46 fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
48 callstack *stack = allot_callstack(size);
49 memcpy(stack->top(),top,size);
50 return tag<callstack>(stack);
53 void factor_vm::primitive_callstack()
55 ctx->push(capture_callstack(ctx));
58 void factor_vm::primitive_callstack_for()
60 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
61 ctx->push(capture_callstack(other_ctx));
64 code_block *factor_vm::frame_code(stack_frame *frame)
67 return (code_block *)frame->entry_point - 1;
70 code_block_type factor_vm::frame_type(stack_frame *frame)
72 return frame_code(frame)->type();
75 cell factor_vm::frame_executing(stack_frame *frame)
77 return frame_code(frame)->owner;
80 cell factor_vm::frame_executing_quot(stack_frame *frame)
82 tagged<object> executing(frame_executing(frame));
83 code_block *compiled = frame_code(frame);
84 if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
85 executing = executing.as<word>()->def;
86 return executing.value();
89 stack_frame *factor_vm::frame_successor(stack_frame *frame)
92 return (stack_frame *)((cell)frame - frame->size);
95 cell factor_vm::frame_offset(stack_frame *frame)
97 char *entry_point = (char *)frame_code(frame)->entry_point();
98 char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
100 return return_address - entry_point;
105 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
107 char *entry_point = (char *)frame_code(frame)->entry_point();
108 if(offset == (cell)-1)
109 FRAME_RETURN_ADDRESS(frame,this) = NULL;
111 FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
114 cell factor_vm::frame_scan(stack_frame *frame)
116 switch(frame_type(frame))
118 case code_block_unoptimized:
120 tagged<object> obj(frame_executing(frame));
121 if(obj.type_p(WORD_TYPE))
122 obj = obj.as<word>()->def;
124 if(obj.type_p(QUOTATION_TYPE))
125 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
129 case code_block_optimized:
132 critical_error("Bad frame type",frame_type(frame));
137 struct stack_frame_accumulator {
139 growable_array frames;
141 explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
143 void operator()(stack_frame *frame)
145 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
146 data_root<object> executing(parent->frame_executing(frame),parent);
147 data_root<object> scan(parent->frame_scan(frame),parent);
149 frames.add(executing.value());
150 frames.add(executing_quot.value());
151 frames.add(scan.value());
155 void factor_vm::primitive_callstack_to_array()
157 data_root<callstack> callstack(ctx->pop(),this);
159 stack_frame_accumulator accum(this);
160 iterate_callstack_object(callstack.untagged(),accum);
163 ctx->push(accum.frames.elements.value());
166 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
168 stack_frame *frame = bottom - 1;
170 while(frame >= top && frame_successor(frame) >= top)
171 frame = frame_successor(frame);
176 /* Some primitives implementing a limited form of callstack mutation.
177 Used by the single stepper. */
178 void factor_vm::primitive_innermost_stack_frame_executing()
180 callstack *stack = untag_check<callstack>(ctx->pop());
181 stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
182 ctx->push(frame_executing_quot(frame));
185 void factor_vm::primitive_innermost_stack_frame_scan()
187 callstack *stack = untag_check<callstack>(ctx->pop());
188 stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
189 ctx->push(frame_scan(frame));
192 void factor_vm::primitive_set_innermost_stack_frame_quot()
194 data_root<callstack> stack(ctx->pop(),this);
195 data_root<quotation> quot(ctx->pop(),this);
197 stack.untag_check(this);
198 quot.untag_check(this);
200 jit_compile_quot(quot.value(),true);
202 stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
203 cell offset = frame_offset(inner);
204 inner->entry_point = quot->entry_point;
205 set_frame_offset(inner,offset);
208 void factor_vm::primitive_callstack_bounds()
210 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
211 ctx->push(allot_alien((void*)ctx->callstack_seg->end));