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