5 callstack* factor_vm::allot_callstack(cell size) {
6 callstack* stack = allot<callstack>(callstack_object_size(size));
7 stack->length = tag_fixnum(size);
11 /* We ignore the two topmost frames, the 'callstack' primitive
12 frame itself, and the frame calling the 'callstack' primitive,
13 so that set-callstack doesn't get stuck in an infinite loop.
15 This means that if 'callstack' is called in tail position, we
16 will have popped a necessary frame... however this word is only
17 called by continuation implementation, and user code shouldn't
18 be calling it at all, so we leave it as it is for now. */
19 void* factor_vm::second_from_top_stack_frame(context* ctx) {
20 void* frame_top = ctx->callstack_top;
21 for (cell i = 0; i < 2; ++i) {
22 void* pred = frame_predecessor(frame_top);
23 if (pred >= ctx->callstack_bottom)
30 cell factor_vm::capture_callstack(context* ctx) {
31 void* top = second_from_top_stack_frame(ctx);
32 void* bottom = ctx->callstack_bottom;
34 fixnum size = std::max((fixnum)0, (fixnum)bottom - (fixnum)top);
36 callstack* stack = allot_callstack(size);
37 memcpy(stack->top(), top, size);
38 return tag<callstack>(stack);
41 void factor_vm::primitive_callstack() { ctx->push(capture_callstack(ctx)); }
43 void factor_vm::primitive_callstack_for() {
44 context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
45 ctx->replace(capture_callstack(other_ctx));
48 void* factor_vm::frame_predecessor(void* frame_top) {
49 void* addr = frame_return_address((void*)frame_top);
50 FACTOR_ASSERT(addr != 0);
51 code_block* owner = code->code_block_for_address((cell)addr);
52 cell frame_size = owner->stack_frame_size_for_address((cell)addr);
53 return (void*)((char*)frame_top + frame_size);
56 struct stack_frame_accumulator {
58 growable_array frames;
60 explicit stack_frame_accumulator(factor_vm* parent)
61 : parent(parent), frames(parent) {}
63 void operator()(void* frame_top, cell frame_size, code_block* owner,
65 data_root<object> executing_quot(owner->owner_quot(), parent);
66 data_root<object> executing(owner->owner, parent);
67 data_root<object> scan(owner->scan(parent, addr), parent);
69 frames.add(executing.value());
70 frames.add(executing_quot.value());
71 frames.add(scan.value());
75 struct stack_frame_in_array {
79 void factor_vm::primitive_callstack_to_array() {
80 data_root<callstack> callstack(ctx->peek(), this);
82 stack_frame_accumulator accum(this);
83 iterate_callstack_object(callstack.untagged(), accum);
85 /* The callstack iterator visits frames in reverse order (top to bottom) */
86 std::reverse((stack_frame_in_array*)accum.frames.elements->data(),
87 (stack_frame_in_array*)(accum.frames.elements->data() +
92 ctx->replace(accum.frames.elements.value());
96 /* Some primitives implementing a limited form of callstack mutation.
97 Used by the single stepper. */
98 void factor_vm::primitive_innermost_stack_frame_executing() {
99 callstack* stack = untag_check<callstack>(ctx->peek());
100 void* frame = stack->top();
101 void* addr = frame_return_address(frame);
102 ctx->replace(code->code_block_for_address((cell)addr)->owner_quot());
105 void factor_vm::primitive_innermost_stack_frame_scan() {
106 callstack* stack = untag_check<callstack>(ctx->peek());
107 void* frame = stack->top();
108 void* addr = frame_return_address(frame);
109 ctx->replace(code->code_block_for_address((cell)addr)->scan(this, addr));
112 void factor_vm::primitive_set_innermost_stack_frame_quot() {
113 data_root<callstack> stack(ctx->pop(), this);
114 data_root<quotation> quot(ctx->pop(), this);
116 stack.untag_check(this);
117 quot.untag_check(this);
119 jit_compile_quot(quot.value(), true);
121 void* inner = stack->top();
122 void* addr = frame_return_address(inner);
123 code_block* block = code->code_block_for_address((cell)addr);
124 cell offset = block->offset(addr);
125 set_frame_return_address(inner, (char*)quot->entry_point + offset);
128 void factor_vm::primitive_callstack_bounds() {
129 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
130 ctx->push(allot_alien((void*)ctx->callstack_seg->end));