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         tagged<object> executing(frame_executing(frame));
  83         code_block *compiled = frame_code(frame);
  84         if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
  85                 executing = executing.as<word>()->def;
  86         return executing.value();
  87 }
  88
  89 stack_frame *factor_vm::frame_successor(stack_frame *frame)
  90 {
  91         check_frame(frame);
  92         return (stack_frame *)((cell)frame - frame->size);
  93 }
  94
  95 cell factor_vm::frame_offset(stack_frame *frame)
  96 {
  97         char *entry_point = (char *)frame_code(frame)->entry_point();
  98         char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
  99         FACTOR_ASSERT(return_address != 0);
 100         return return_address - entry_point;
 101 }
 102
 103 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
 104 {
 105         char *entry_point = (char *)frame_code(frame)->entry_point();
 106         FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
 107 }
 108
 109 cell factor_vm::frame_scan(stack_frame *frame)
 110 {
 111         switch(frame_type(frame))
 112         {
 113         case code_block_unoptimized:
 114                 {
 115                         tagged<object> obj(frame_executing(frame));
 116                         if(obj.type_p(WORD_TYPE))
 117                                 obj = obj.as<word>()->def;
 118
 119                         if(obj.type_p(QUOTATION_TYPE))
 120                                 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
 121                         else
 122                                 return false_object;
 123                 }
 124         case code_block_optimized:
 125                 return false_object;
 126         default:
 127                 critical_error("Bad frame type",frame_type(frame));
 128                 return false_object;
 129         }
 130 }
 131
 132 struct stack_frame_accumulator {
 133         factor_vm *parent;
 134         growable_array frames;
 135
 136         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
 137
 138         void operator()(stack_frame *frame)
 139         {
 140                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
 141                 data_root<object> executing(parent->frame_executing(frame),parent);
 142                 data_root<object> scan(parent->frame_scan(frame),parent);
 143
 144                 frames.add(executing.value());
 145                 frames.add(executing_quot.value());
 146                 frames.add(scan.value());
 147         }
 148 };
 149
 150 void factor_vm::primitive_callstack_to_array()
 151 {
 152         data_root<callstack> callstack(ctx->pop(),this);
 153
 154         stack_frame_accumulator accum(this);
 155         iterate_callstack_object(callstack.untagged(),accum);
 156         accum.frames.trim();
 157
 158         ctx->push(accum.frames.elements.value());
 159 }
 160
 161 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
 162 {
 163         stack_frame *frame = bottom - 1;
 164
 165         while(frame >= top && frame_successor(frame) >= top)
 166                 frame = frame_successor(frame);
 167
 168         return frame;
 169 }
 170
 171 /* Some primitives implementing a limited form of callstack mutation.
 172 Used by the single stepper. */
 173 void factor_vm::primitive_innermost_stack_frame_executing()
 174 {
 175         callstack *stack = untag_check<callstack>(ctx->pop());
 176         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 177         ctx->push(frame_executing_quot(frame));
 178 }
 179
 180 void factor_vm::primitive_innermost_stack_frame_scan()
 181 {
 182         callstack *stack = untag_check<callstack>(ctx->pop());
 183         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 184         ctx->push(frame_scan(frame));
 185 }
 186
 187 void factor_vm::primitive_set_innermost_stack_frame_quot()
 188 {
 189         data_root<callstack> stack(ctx->pop(),this);
 190         data_root<quotation> quot(ctx->pop(),this);
 191
 192         stack.untag_check(this);
 193         quot.untag_check(this);
 194
 195         jit_compile_quot(quot.value(),true);
 196
 197         stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
 198         cell offset = frame_offset(inner);
 199         inner->entry_point = quot->entry_point;
 200         set_frame_offset(inner,offset);
 201 }
 202
 203 void factor_vm::primitive_callstack_bounds()
 204 {
 205         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 206         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 207 }
 208
 209 }