vm/callstack.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 void factor_vm::check_frame(stack_frame *frame)
   7 {
   8 #ifdef FACTOR_DEBUG
   9         check_code_pointer((cell)frame->entry_point);
  10         FACTOR_ASSERT(frame->size != 0);
  11 #endif
  12 }
  13
  14 callstack *factor_vm::allot_callstack(cell size)
  15 {
  16         callstack *stack = allot<callstack>(callstack_object_size(size));
  17         stack->length = tag_fixnum(size);
  18         return stack;
  19 }
  20
  21 /* We ignore the two topmost frames, the 'callstack' primitive
  22 frame itself, and the frame calling the 'callstack' primitive,
  23 so that set-callstack doesn't get stuck in an infinite loop.
  24
  25 This means that if 'callstack' is called in tail position, we
  26 will have popped a necessary frame... however this word is only
  27 called by continuation implementation, and user code shouldn't
  28 be calling it at all, so we leave it as it is for now. */
  29 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
  30 {
  31         stack_frame *frame = ctx->bottom_frame();
  32         while(frame >= ctx->callstack_top
  33                 && frame_successor(frame) >= ctx->callstack_top
  34                 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
  35         {
  36                 frame = frame_successor(frame);
  37         }
  38         return frame + 1;
  39 }
  40
  41 cell factor_vm::capture_callstack(context *ctx)
  42 {
  43         stack_frame *top = second_from_top_stack_frame(ctx);
  44         stack_frame *bottom = ctx->callstack_bottom;
  45
  46         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
  47
  48         callstack *stack = allot_callstack(size);
  49         memcpy(stack->top(),top,size);
  50         return tag<callstack>(stack);
  51 }
  52
  53 void factor_vm::primitive_callstack()
  54 {
  55         ctx->push(capture_callstack(ctx));
  56 }
  57
  58 void factor_vm::primitive_callstack_for()
  59 {
  60         context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
  61         ctx->push(capture_callstack(other_ctx));
  62 }
  63
  64 code_block *factor_vm::frame_code(stack_frame *frame)
  65 {
  66         check_frame(frame);
  67         return (code_block *)frame->entry_point - 1;
  68 }
  69
  70 code_block_type factor_vm::frame_type(stack_frame *frame)
  71 {
  72         return frame_code(frame)->type();
  73 }
  74
  75 cell factor_vm::frame_executing(stack_frame *frame)
  76 {
  77         return frame_code(frame)->owner;
  78 }
  79
  80 cell factor_vm::frame_executing_quot(stack_frame *frame)
  81 {
  82         return frame_code(frame)->owner_quot();
  83 }
  84
  85 stack_frame *factor_vm::frame_successor(stack_frame *frame)
  86 {
  87         check_frame(frame);
  88         return (stack_frame *)((cell)frame - frame->size);
  89 }
  90
  91 cell factor_vm::frame_offset(stack_frame *frame)
  92 {
  93         char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
  94         FACTOR_ASSERT(return_address != 0);
  95         return frame_code(frame)->offset(return_address);
  96 }
  97
  98 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
  99 {
 100         char *entry_point = (char *)frame_code(frame)->entry_point();
 101         FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
 102 }
 103
 104 cell factor_vm::frame_scan(stack_frame *frame)
 105 {
 106         return frame_code(frame)->scan(this, FRAME_RETURN_ADDRESS(frame,this));
 107 }
 108
 109 struct stack_frame_accumulator {
 110         factor_vm *parent;
 111         growable_array frames;
 112
 113         explicit stack_frame_accumulator(factor_vm *parent_)
 114                 : parent(parent_), frames(parent_) {}
 115
 116         void operator()(void *frame_top, cell frame_size, code_block *owner, void *addr)
 117         {
 118                 data_root<object> executing_quot(owner->owner_quot(),parent);
 119                 data_root<object> executing(owner->owner,parent);
 120                 data_root<object> scan(owner->scan(parent, addr),parent);
 121
 122                 frames.add(executing.value());
 123                 frames.add(executing_quot.value());
 124                 frames.add(scan.value());
 125         }
 126 };
 127
 128 struct stack_frame_in_array { cell cells[3]; };
 129
 130 void factor_vm::primitive_callstack_to_array()
 131 {
 132         data_root<callstack> callstack(ctx->pop(),this);
 133
 134         stack_frame_accumulator accum(this);
 135         iterate_callstack_object(callstack.untagged(),accum);
 136
 137         /* The callstack iterator visits frames in reverse order (top to bottom) */
 138         std::reverse(
 139                 (stack_frame_in_array*)accum.frames.elements->data(),
 140                 (stack_frame_in_array*)(accum.frames.elements->data() + accum.frames.count));
 141
 142         accum.frames.trim();
 143
 144         ctx->push(accum.frames.elements.value());
 145
 146 }
 147
 148 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
 149 {
 150         stack_frame *frame = bottom - 1;
 151
 152         while(frame >= top && frame_successor(frame) >= top)
 153                 frame = frame_successor(frame);
 154
 155         return frame;
 156 }
 157
 158 /* Some primitives implementing a limited form of callstack mutation.
 159 Used by the single stepper. */
 160 void factor_vm::primitive_innermost_stack_frame_executing()
 161 {
 162         callstack *stack = untag_check<callstack>(ctx->pop());
 163         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 164         ctx->push(frame_executing_quot(frame));
 165 }
 166
 167 void factor_vm::primitive_innermost_stack_frame_scan()
 168 {
 169         callstack *stack = untag_check<callstack>(ctx->pop());
 170         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 171         ctx->push(frame_scan(frame));
 172 }
 173
 174 void factor_vm::primitive_set_innermost_stack_frame_quot()
 175 {
 176         data_root<callstack> stack(ctx->pop(),this);
 177         data_root<quotation> quot(ctx->pop(),this);
 178
 179         stack.untag_check(this);
 180         quot.untag_check(this);
 181
 182         jit_compile_quot(quot.value(),true);
 183
 184         stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
 185         cell offset = frame_offset(inner);
 186         inner->entry_point = quot->entry_point;
 187         set_frame_offset(inner,offset);
 188 }
 189
 190 void factor_vm::primitive_callstack_bounds()
 191 {
 192         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 193         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 194 }
 195
 196 }