6 callstack *factor_vm::allot_callstack(cell size)
8 callstack *stack = allot<callstack>(callstack_object_size(size));
9 stack->length = tag_fixnum(size);
13 /* We ignore the two topmost frames, the 'callstack' primitive
14 frame itself, and the frame calling the 'callstack' primitive,
15 so that set-callstack doesn't get stuck in an infinite loop.
17 This means that if 'callstack' is called in tail position, we
18 will have popped a necessary frame... however this word is only
19 called by continuation implementation, and user code shouldn't
20 be calling it at all, so we leave it as it is for now. */
21 void *factor_vm::second_from_top_stack_frame(context *ctx)
23 void *frame_top = ctx->callstack_top;
24 for (cell i = 0; i < 2; ++i)
26 void *pred = frame_predecessor(frame_top);
27 if (pred >= ctx->callstack_bottom)
34 cell factor_vm::capture_callstack(context *ctx)
36 void *top = second_from_top_stack_frame(ctx);
37 void *bottom = ctx->callstack_bottom;
39 fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
41 callstack *stack = allot_callstack(size);
42 memcpy(stack->top(),top,size);
43 return tag<callstack>(stack);
46 void factor_vm::primitive_callstack()
48 ctx->push(capture_callstack(ctx));
51 void factor_vm::primitive_callstack_for()
53 context *other_ctx = (context *)pinned_alien_offset(ctx->peek());
54 ctx->replace(capture_callstack(other_ctx));
57 void *factor_vm::frame_predecessor(void *frame_top)
59 void *addr = frame_return_address((void*)frame_top);
60 FACTOR_ASSERT(addr != 0);
61 code_block *owner = code->code_block_for_address((cell)addr);
62 cell frame_size = owner->stack_frame_size_for_address((cell)addr);
63 return (void*)((char*)frame_top + frame_size);
66 struct stack_frame_accumulator {
68 growable_array frames;
70 explicit stack_frame_accumulator(factor_vm *parent_)
71 : parent(parent_), frames(parent_) {}
73 void operator()(void *frame_top, cell frame_size, code_block *owner, void *addr)
75 data_root<object> executing_quot(owner->owner_quot(),parent);
76 data_root<object> executing(owner->owner,parent);
77 data_root<object> scan(owner->scan(parent, addr),parent);
79 frames.add(executing.value());
80 frames.add(executing_quot.value());
81 frames.add(scan.value());
85 struct stack_frame_in_array { cell cells[3]; };
87 void factor_vm::primitive_callstack_to_array()
89 data_root<callstack> callstack(ctx->peek(),this);
91 stack_frame_accumulator accum(this);
92 iterate_callstack_object(callstack.untagged(),accum);
94 /* The callstack iterator visits frames in reverse order (top to bottom) */
96 (stack_frame_in_array*)accum.frames.elements->data(),
97 (stack_frame_in_array*)(accum.frames.elements->data() + accum.frames.count));
101 ctx->replace(accum.frames.elements.value());
105 /* Some primitives implementing a limited form of callstack mutation.
106 Used by the single stepper. */
107 void factor_vm::primitive_innermost_stack_frame_executing()
109 callstack *stack = untag_check<callstack>(ctx->peek());
110 void *frame = stack->top();
111 void *addr = frame_return_address(frame);
112 ctx->replace(code->code_block_for_address((cell)addr)->owner_quot());
115 void factor_vm::primitive_innermost_stack_frame_scan()
117 callstack *stack = untag_check<callstack>(ctx->peek());
118 void *frame = stack->top();
119 void *addr = frame_return_address(frame);
120 ctx->replace(code->code_block_for_address((cell)addr)->scan(this,addr));
123 void factor_vm::primitive_set_innermost_stack_frame_quot()
125 data_root<callstack> stack(ctx->pop(),this);
126 data_root<quotation> quot(ctx->pop(),this);
128 stack.untag_check(this);
129 quot.untag_check(this);
131 jit_compile_quot(quot.value(),true);
133 void *inner = stack->top();
134 void *addr = frame_return_address(inner);
135 code_block *block = code->code_block_for_address((cell)addr);
136 cell offset = block->offset(addr);
137 set_frame_return_address(inner, (char*)quot->entry_point + offset);
140 void factor_vm::primitive_callstack_bounds()
142 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
143 ctx->push(allot_alien((void*)ctx->callstack_seg->end));