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 = 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() { ctx->push(capture_callstack(ctx)); }
  45
  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));
  50 }
  51
  52 cell factor_vm::frame_predecessor(cell frame_top) {
  53   cell addr = *(cell*)frame_top;
  54   FACTOR_ASSERT(addr != 0);
  55   code_block* owner = code->code_block_for_address(addr);
  56   cell frame_size = owner->stack_frame_size_for_address(addr);
  57   return frame_top + frame_size;
  58 }
  59
  60 struct stack_frame_accumulator {
  61   factor_vm* parent;
  62   growable_array frames;
  63
  64   /* Allocates memory (frames is a growable_array, constructor allocates) */
  65   explicit stack_frame_accumulator(factor_vm* parent)
  66       : parent(parent), frames(parent) {}
  67
  68
  69   /* Allocates memory (frames.add()) */
  70   void operator()(cell frame_top, cell size, code_block* owner, cell addr) {
  71     data_root<object> executing_quot(owner->owner_quot(), parent);
  72     data_root<object> executing(owner->owner, parent);
  73     data_root<object> scan(owner->scan(parent, addr), parent);
  74
  75     frames.add(executing.value());
  76     frames.add(executing_quot.value());
  77     frames.add(scan.value());
  78   }
  79 };
  80
  81 struct stack_frame_in_array {
  82   cell cells[3];
  83 };
  84
  85 /* Allocates memory (frames.trim()), iterate_callstack_object() */
  86 void factor_vm::primitive_callstack_to_array() {
  87   data_root<callstack> callstack(ctx->peek(), this);
  88
  89   stack_frame_accumulator accum(this);
  90   iterate_callstack_object(callstack.untagged(), accum);
  91
  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() +
  95                                        accum.frames.count));
  96
  97   accum.frames.trim();
  98
  99   ctx->replace(accum.frames.elements.value());
 100
 101 }
 102
 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 = *(void**)frame;
 109   ctx->replace(code->code_block_for_address((cell)addr)->owner_quot());
 110 }
 111
 112 void factor_vm::primitive_innermost_stack_frame_scan() {
 113   callstack* stack = untag_check<callstack>(ctx->peek());
 114   void* frame = stack->top();
 115   cell addr = *(cell*)frame;
 116   ctx->replace(code->code_block_for_address((cell)addr)->scan(this, addr));
 117 }
 118
 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);
 123
 124   stack.untag_check(this);
 125   quot.untag_check(this);
 126
 127   jit_compile_quot(quot.value(), true);
 128
 129   void* inner = stack->top();
 130   void* addr = *(void**)inner;
 131   code_block* block = code->code_block_for_address((cell)addr);
 132   cell offset = block->offset(addr);
 133   *(void**)inner = (char*)quot->entry_point + offset;
 134 }
 135
 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));
 140 }
 141
 142 }