5 /* Allocates memory (allot) */
6 callstack* factor_vm::allot_callstack(cell size) {
7 callstack* stack = allot<callstack>(callstack_object_size(size));
8 stack->length = tag_fixnum(size);
12 /* We ignore the two topmost frames, the 'callstack' primitive
13 frame itself, and the frame calling the 'callstack' primitive,
14 so that set-callstack doesn't get stuck in an infinite loop.
16 This means that if 'callstack' is called in tail position, we
17 will have popped a necessary frame... however this word is only
18 called by continuation implementation, and user code shouldn't
19 be calling it at all, so we leave it as it is for now. */
20 void* factor_vm::second_from_top_stack_frame(context* ctx) {
21 void* frame_top = ctx->callstack_top;
22 for (cell i = 0; i < 2; ++i) {
23 void* pred = frame_predecessor(frame_top);
24 if (pred >= ctx->callstack_bottom)
31 /* Allocates memory (allot_callstack) */
32 cell factor_vm::capture_callstack(context* ctx) {
33 void* top = second_from_top_stack_frame(ctx);
34 void* bottom = ctx->callstack_bottom;
36 fixnum size = std::max((fixnum)0, (fixnum)bottom - (fixnum)top);
38 callstack* stack = allot_callstack(size);
39 memcpy(stack->top(), top, size);
40 return tag<callstack>(stack);
43 /* Allocates memory (capture_callstack) */
44 void factor_vm::primitive_callstack() { ctx->push(capture_callstack(ctx)); }
46 /* Allocates memory (capture_callstack) */
47 void factor_vm::primitive_callstack_for() {
48 context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
49 ctx->replace(capture_callstack(other_ctx));
52 void* factor_vm::frame_predecessor(void* frame_top) {
53 void* addr = frame_return_address((void*)frame_top);
54 FACTOR_ASSERT(addr != 0);
55 code_block* owner = code->code_block_for_address((cell)addr);
56 cell frame_size = owner->stack_frame_size_for_address((cell)addr);
57 return (void*)((char*)frame_top + frame_size);
60 struct stack_frame_accumulator {
62 growable_array frames;
64 /* Allocates memory (frames is a growable_array, constructor allocates) */
65 explicit stack_frame_accumulator(factor_vm* parent)
66 : parent(parent), frames(parent) {}
69 /* Allocates memory (frames.add()) */
70 void operator()(void* frame_top, cell frame_size, code_block* owner,
72 data_root<object> executing_quot(owner->owner_quot(), parent);
73 data_root<object> executing(owner->owner, parent);
74 data_root<object> scan(owner->scan(parent, addr), parent);
76 frames.add(executing.value());
77 frames.add(executing_quot.value());
78 frames.add(scan.value());
82 struct stack_frame_in_array {
86 void factor_vm::primitive_callstack_to_array() {
87 data_root<callstack> callstack(ctx->peek(), this);
89 stack_frame_accumulator accum(this);
90 iterate_callstack_object(callstack.untagged(), accum);
92 /* The callstack iterator visits frames in reverse order (top to bottom) */
93 std::reverse((stack_frame_in_array*)accum.frames.elements->data(),
94 (stack_frame_in_array*)(accum.frames.elements->data() +
99 ctx->replace(accum.frames.elements.value());
103 /* Some primitives implementing a limited form of callstack mutation.
104 Used by the single stepper. */
105 void factor_vm::primitive_innermost_stack_frame_executing() {
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)->owner_quot());
112 void factor_vm::primitive_innermost_stack_frame_scan() {
113 callstack* stack = untag_check<callstack>(ctx->peek());
114 void* frame = stack->top();
115 void* addr = frame_return_address(frame);
116 ctx->replace(code->code_block_for_address((cell)addr)->scan(this, addr));
119 /* Allocates memory (jit_compile_quot) */
120 void factor_vm::primitive_set_innermost_stack_frame_quot() {
121 data_root<callstack> stack(ctx->pop(), this);
122 data_root<quotation> quot(ctx->pop(), this);
124 stack.untag_check(this);
125 quot.untag_check(this);
127 jit_compile_quot(quot.value(), true);
129 void* inner = stack->top();
130 void* addr = frame_return_address(inner);
131 code_block* block = code->code_block_for_address((cell)addr);
132 cell offset = block->offset(addr);
133 set_frame_return_address(inner, (char*)quot->entry_point + offset);
136 /* Allocates memory (allot_alien) */
137 void factor_vm::primitive_callstack_bounds() {
138 ctx->push(allot_alien((void*)ctx->callstack_seg->start));
139 ctx->push(allot_alien((void*)ctx->callstack_seg->end));