vm/callstack.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 callstack *factor_vm::allot_callstack(cell size)
   7 {
   8         callstack *stack = allot<callstack>(callstack_object_size(size));
   9         stack->length = tag_fixnum(size);
  10         return stack;
  11 }
  12
  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.
  16
  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)
  22 {
  23         void *frame_top = ctx->callstack_top;
  24         for (unsigned i = 0; i < 2; ++i)
  25         {
  26                 void *pred = frame_predecessor(frame_top);
  27                 if (pred >= ctx->callstack_bottom)
  28                         return frame_top;
  29                 frame_top = pred;
  30         }
  31         return frame_top;
  32 }
  33
  34 cell factor_vm::capture_callstack(context *ctx)
  35 {
  36         void *top = second_from_top_stack_frame(ctx);
  37         void *bottom = ctx->callstack_bottom;
  38
  39         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
  40
  41         callstack *stack = allot_callstack(size);
  42         memcpy(stack->top(),top,size);
  43         return tag<callstack>(stack);
  44 }
  45
  46 void factor_vm::primitive_callstack()
  47 {
  48         ctx->push(capture_callstack(ctx));
  49 }
  50
  51 void factor_vm::primitive_callstack_for()
  52 {
  53         context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
  54         ctx->push(capture_callstack(other_ctx));
  55 }
  56
  57 void *factor_vm::frame_predecessor(void *frame_top)
  58 {
  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);
  64 }
  65
  66 struct stack_frame_accumulator {
  67         factor_vm *parent;
  68         growable_array frames;
  69
  70         explicit stack_frame_accumulator(factor_vm *parent_)
  71                 : parent(parent_), frames(parent_) {}
  72
  73         void operator()(void *frame_top, cell frame_size, code_block *owner, void *addr)
  74         {
  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);
  78
  79                 frames.add(executing.value());
  80                 frames.add(executing_quot.value());
  81                 frames.add(scan.value());
  82         }
  83 };
  84
  85 struct stack_frame_in_array { cell cells[3]; };
  86
  87 void factor_vm::primitive_callstack_to_array()
  88 {
  89         data_root<callstack> callstack(ctx->pop(),this);
  90
  91         stack_frame_accumulator accum(this);
  92         iterate_callstack_object(callstack.untagged(),accum);
  93
  94         /* The callstack iterator visits frames in reverse order (top to bottom) */
  95         std::reverse(
  96                 (stack_frame_in_array*)accum.frames.elements->data(),
  97                 (stack_frame_in_array*)(accum.frames.elements->data() + accum.frames.count));
  98
  99         accum.frames.trim();
 100
 101         ctx->push(accum.frames.elements.value());
 102
 103 }
 104
 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()
 108 {
 109         callstack *stack = untag_check<callstack>(ctx->pop());
 110         void *frame = stack->top();
 111         void *addr = frame_return_address(frame);
 112         ctx->push(code->code_block_for_address((cell)addr)->owner_quot());
 113 }
 114
 115 void factor_vm::primitive_innermost_stack_frame_scan()
 116 {
 117         callstack *stack = untag_check<callstack>(ctx->pop());
 118         void *frame = stack->top();
 119         void *addr = frame_return_address(frame);
 120         ctx->push(code->code_block_for_address((cell)addr)->scan(this,addr));
 121 }
 122
 123 void factor_vm::primitive_set_innermost_stack_frame_quot()
 124 {
 125         data_root<callstack> stack(ctx->pop(),this);
 126         data_root<quotation> quot(ctx->pop(),this);
 127
 128         stack.untag_check(this);
 129         quot.untag_check(this);
 130
 131         jit_compile_quot(quot.value(),true);
 132
 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);
 138 }
 139
 140 void factor_vm::primitive_callstack_bounds()
 141 {
 142         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 143         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 144 }
 145
 146 }