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 // XXX move somewhere more appropriate
26 word_finder(cell address) : address(address), found_word(0) {}
28 // XXX keep a map of word names in the code heap so we don't need this
29 void operator()(object *obj)
31 if (obj->type() == WORD_TYPE)
33 word *w = static_cast<word*>(obj);
34 if ((cell)w->code->entry_point() <= address
35 && address - (cell)w->code->entry_point() < w->code->size()) {
36 assert(found_word == 0);
37 found_word = (cell)w->code->entry_point();
43 static cell find_word_for_address(factor_vm *vm, cell pc)
45 word_finder finder(pc);
46 vm->each_object(finder);
47 assert(finder.found_word != 0);
48 return finder.found_word;
51 void factor_vm::dispatch_signal_handler(cell *sp, cell *pc, cell handler)
53 if (!code->seg->in_segment_p(*pc) || *sp < ctx->callstack_seg->start + stack_reserved)
55 /* Fault came from foreign code, a callstack overflow, or we would probably
56 overflow if we tried the resumable handler. We can't resume, so cut the
57 callstack down to the shallowest Factor stack frame that leaves room for
58 the signal handler to do its thing and launch the handler without going
59 through the resumable subprimitive. */
60 signal_resumable = false;
61 stack_frame *frame = ctx->callstack_bottom - 1;
63 while((cell)frame >= *sp
64 && frame >= ctx->callstack_top
65 && (cell)frame >= ctx->callstack_seg->start + stack_reserved)
67 frame = frame_successor(frame);
70 // XXX FRAME_RETURN_ADDRESS
71 cell newsp = (cell)(frame+1);
73 ctx->callstack_top = (stack_frame*)newsp;
76 signal_resumable = true;
77 // Fault came from Factor, and we've got a good callstack. Route the signal
78 // handler through the resumable signal handler subprimitive.
79 cell offset = *sp % 16;
81 signal_handler_addr = handler;
82 tagged<word> handler_word = tagged<word>(special_objects[SIGNAL_HANDLER_WORD]);
84 /* XXX horribly x86-centric */
85 /* True stack frames are always 16-byte aligned. Leaf procedures
86 that don't create a stack frame will be out of alignment by sizeof(cell)
88 /* On architectures with a link register we would have to check for leafness
89 by matching the PC to a word. We should also use FRAME_RETURN_ADDRESS instead
90 of assuming the stack pointer is the right place to put the resume address. */
93 signal_from_leaf = false; // XXX remove this once we're sure leaf works
94 cell newsp = *sp - sizeof(cell);
98 else if (offset == 16 - sizeof(cell))
100 signal_from_leaf = true; // XXX remove this once we're sure leaf works
102 // Make a fake frame for the leaf procedure
103 cell leaf_word = find_word_for_address(this, *pc);
105 cell newsp = *sp - 4 * sizeof(cell);
106 *(cell*)(newsp + 3*sizeof(cell)) = 4*sizeof(cell);
107 *(cell*)(newsp + 2*sizeof(cell)) = leaf_word;
108 *(cell*) newsp = *pc;
110 handler_word = tagged<word>(special_objects[LEAF_SIGNAL_HANDLER_WORD]);
114 fatal_error("Invalid stack frame during signal handler", *sp);
117 *pc = (cell)handler_word->code->entry_point();
121 /* We ignore the two topmost frames, the 'callstack' primitive
122 frame itself, and the frame calling the 'callstack' primitive,
123 so that set-callstack doesn't get stuck in an infinite loop.
125 This means that if 'callstack' is called in tail position, we
126 will have popped a necessary frame... however this word is only
127 called by continuation implementation, and user code shouldn't
128 be calling it at all, so we leave it as it is for now. */
129 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
131 stack_frame *frame = ctx->callstack_bottom - 1;
132 while(frame >= ctx->callstack_top
133 && frame_successor(frame) >= ctx->callstack_top
134 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
136 frame = frame_successor(frame);
141 cell factor_vm::capture_callstack(context *ctx)
143 stack_frame *top = second_from_top_stack_frame(ctx);
144 stack_frame *bottom = ctx->callstack_bottom;
146 fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
148 callstack *stack = allot_callstack(size);
149 memcpy(stack->top(),top,size);
150 return tag<callstack>(stack);
153 void factor_vm::primitive_callstack()
155 ctx->push(capture_callstack(ctx));
158 void factor_vm::primitive_callstack_for()
160 context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
161 ctx->push(capture_callstack(other_ctx));
164 code_block *factor_vm::frame_code(stack_frame *frame)
167 return (code_block *)frame->entry_point - 1;
170 code_block_type factor_vm::frame_type(stack_frame *frame)
172 return frame_code(frame)->type();
175 cell factor_vm::frame_executing(stack_frame *frame)
177 return frame_code(frame)->owner;
180 cell factor_vm::frame_executing_quot(stack_frame *frame)
182 tagged<object> executing(frame_executing(frame));
183 code_block *compiled = frame_code(frame);
184 if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
185 executing = executing.as<word>()->def;
186 return executing.value();
189 stack_frame *factor_vm::frame_successor(stack_frame *frame)
192 return (stack_frame *)((cell)frame - frame->size);
195 cell factor_vm::frame_offset(stack_frame *frame)
197 char *entry_point = (char *)frame_code(frame)->entry_point();
198 char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
200 return return_address - entry_point;
205 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
207 char *entry_point = (char *)frame_code(frame)->entry_point();
208 if(offset == (cell)-1)
209 FRAME_RETURN_ADDRESS(frame,this) = NULL;
211 FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
214 cell factor_vm::frame_scan(stack_frame *frame)
216 switch(frame_type(frame))
218 case code_block_unoptimized:
220 tagged<object> obj(frame_executing(frame));
221 if(obj.type_p(WORD_TYPE))
222 obj = obj.as<word>()->def;
224 if(obj.type_p(QUOTATION_TYPE))
225 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
229 case code_block_optimized:
232 critical_error("Bad frame type",frame_type(frame));
237 struct stack_frame_accumulator {
239 growable_array frames;
241 explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
243 void operator()(stack_frame *frame)
245 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
246 data_root<object> executing(parent->frame_executing(frame),parent);
247 data_root<object> scan(parent->frame_scan(frame),parent);
249 frames.add(executing.value());
250 frames.add(executing_quot.value());
251 frames.add(scan.value());
255 void factor_vm::primitive_callstack_to_array()
257 data_root<callstack> callstack(ctx->pop(),this);
259 stack_frame_accumulator accum(this);
260 iterate_callstack_object(callstack.untagged(),accum);
263 ctx->push(accum.frames.elements.value());
266 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
268 stack_frame *frame = bottom - 1;
270 while(frame >= top && frame_successor(frame) >= top)
271 frame = frame_successor(frame);
276 /* Some primitives implementing a limited form of callstack mutation.
277 Used by the single stepper. */
278 void factor_vm::primitive_innermost_stack_frame_executing()
280 callstack *stack = untag_check<callstack>(ctx->pop());
281 stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
282 ctx->push(frame_executing_quot(frame));
285 void factor_vm::primitive_innermost_stack_frame_scan()
287 callstack *stack = untag_check<callstack>(ctx->pop());
288 stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
289 ctx->push(frame_scan(frame));
292 void factor_vm::primitive_set_innermost_stack_frame_quot()
294 data_root<callstack> stack(ctx->pop(),this);
295 data_root<quotation> quot(ctx->pop(),this);
297 stack.untag_check(this);
298 quot.untag_check(this);
300 jit_compile_quot(quot.value(),true);
302 stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
303 cell offset = frame_offset(inner);
304 inner->entry_point = quot->entry_point;
305 set_frame_offset(inner,offset);
308 void factor_vm::primitive_callstack_bounds()
310 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
311 ctx->push(allot_alien((void*)ctx->callstack_seg->end));