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 // Allocates memory (frames.trim()), iterate_callstack_object()
  50 void factor_vm::primitive_callstack_to_array() {
  51   data_root<callstack> callstack(ctx->peek(), this);
  52   // Allocates memory here.
  53   growable_array frames(this);
  54
  55   auto stack_frame_accumulator = [&](cell frame_top,
  56                                      cell size,
  57                                      code_block* owner,
  58                                      cell addr) {
  59     (void)frame_top;
  60     (void)size;
  61     data_root<object> executing_quot(owner->owner_quot(), this);
  62     data_root<object> executing(owner->owner, this);
  63     data_root<object> scan(owner->scan(this, addr), this);
  64
  65     frames.add(executing.value());
  66     frames.add(executing_quot.value());
  67     frames.add(scan.value());
  68   };
  69   iterate_callstack_object(callstack.untagged(), stack_frame_accumulator);
  70
  71   frames.trim();
  72
  73   ctx->replace(frames.elements.value());
  74 }
  75
  76 // Some primitives implementing a limited form of callstack mutation.
  77 // Used by the single stepper.
  78 void factor_vm::primitive_innermost_stack_frame_executing() {
  79   callstack* stack = untag_check<callstack>(ctx->peek());
  80   void* frame = stack->top();
  81   cell addr = *(cell*)frame;
  82   ctx->replace(code->code_block_for_address(addr)->owner_quot());
  83 }
  84
  85 void factor_vm::primitive_innermost_stack_frame_scan() {
  86   callstack* stack = untag_check<callstack>(ctx->peek());
  87   void* frame = stack->top();
  88   cell addr = *(cell*)frame;
  89   ctx->replace(code->code_block_for_address(addr)->scan(this, addr));
  90 }
  91
  92 // Allocates memory (jit_compile_quotation)
  93 void factor_vm::primitive_set_innermost_stack_frame_quotation() {
  94   data_root<callstack> stack(ctx->pop(), this);
  95   data_root<quotation> quot(ctx->pop(), this);
  96
  97   check_tagged(stack);
  98   check_tagged(quot);
  99
 100   jit_compile_quotation(quot.value(), true);
 101
 102   void* inner = stack->top();
 103   cell addr = *(cell*)inner;
 104   code_block* block = code->code_block_for_address(addr);
 105   cell offset = block->offset(addr);
 106   *(cell*)inner = quot->entry_point + offset;
 107 }
 108
 109 // Allocates memory (allot_alien)
 110 void factor_vm::primitive_callstack_bounds() {
 111   ctx->push(allot_alien(ctx->callstack_seg->start));
 112   ctx->push(allot_alien(ctx->callstack_seg->end));
 113 }
 114
 115 }