]> gitweb.factorcode.org Git - factor.git/blob - vm/callstack.cpp
VM: undoing 0274e889b94323fdde6919a77c494ffcfbcb2166 (#1513)
[factor.git] / vm / callstack.cpp
1 #include "master.hpp"
2
3 namespace factor {
4
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);
9   return stack;
10 }
11
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.
15
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 cell factor_vm::second_from_top_stack_frame(context* ctx) {
21   cell frame_top = ctx->callstack_top;
22   for (cell i = 0; i < 2; ++i) {
23     cell pred = code->frame_predecessor(frame_top);
24     if (pred >= ctx->callstack_bottom)
25       return frame_top;
26     frame_top = pred;
27   }
28   return frame_top;
29 }
30
31 // Allocates memory (allot_callstack)
32 cell factor_vm::capture_callstack(context* ctx) {
33   cell top = second_from_top_stack_frame(ctx);
34   cell bottom = ctx->callstack_bottom;
35
36   fixnum size = std::max((cell)0, bottom - top);
37
38   callstack* stack = allot_callstack(size);
39   memcpy(stack->top(), (void *)top, size);
40   return tag<callstack>(stack);
41 }
42
43 // Allocates memory (capture_callstack)
44 void factor_vm::primitive_callstack_for() {
45   context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
46   ctx->replace(capture_callstack(other_ctx));
47 }
48
49 struct stack_frame_in_array {
50   cell cells[3];
51 };
52
53 // Allocates memory (frames.trim()), iterate_callstack_object()
54 void factor_vm::primitive_callstack_to_array() {
55   data_root<callstack> callstack(ctx->peek(), this);
56   // Allocates memory here.
57   growable_array frames(this);
58
59   auto stack_frame_accumulator = [&](cell frame_top,
60                                      cell size,
61                                      code_block* owner,
62                                      cell addr) {
63     data_root<object> executing_quot(owner->owner_quot(), this);
64     data_root<object> executing(owner->owner, this);
65     data_root<object> scan(owner->scan(this, addr), this);
66
67     frames.add(executing.value());
68     frames.add(executing_quot.value());
69     frames.add(scan.value());
70   };
71   iterate_callstack_object(callstack.untagged(), stack_frame_accumulator);
72
73   frames.trim();
74
75   ctx->replace(frames.elements.value());
76 }
77
78 // Some primitives implementing a limited form of callstack mutation.
79 // Used by the single stepper.
80 void factor_vm::primitive_innermost_stack_frame_executing() {
81   callstack* stack = untag_check<callstack>(ctx->peek());
82   void* frame = stack->top();
83   cell addr = *(cell*)frame;
84   ctx->replace(code->code_block_for_address(addr)->owner_quot());
85 }
86
87 void factor_vm::primitive_innermost_stack_frame_scan() {
88   callstack* stack = untag_check<callstack>(ctx->peek());
89   void* frame = stack->top();
90   cell addr = *(cell*)frame;
91   ctx->replace(code->code_block_for_address(addr)->scan(this, addr));
92 }
93
94 // Allocates memory (jit_compile_quotation)
95 void factor_vm::primitive_set_innermost_stack_frame_quotation() {
96   data_root<callstack> stack(ctx->pop(), this);
97   data_root<quotation> quot(ctx->pop(), this);
98
99   stack.untag_check(this);
100   quot.untag_check(this);
101
102   jit_compile_quotation(quot.value(), true);
103
104   void* inner = stack->top();
105   cell addr = *(cell*)inner;
106   code_block* block = code->code_block_for_address(addr);
107   cell offset = block->offset(addr);
108   *(cell*)inner = quot->entry_point + offset;
109 }
110
111 // Allocates memory (allot_alien)
112 void factor_vm::primitive_callstack_bounds() {
113   ctx->push(allot_alien(ctx->callstack_seg->start));
114   ctx->push(allot_alien(ctx->callstack_seg->end));
115 }
116
117 }