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 stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
  22 {
  23         stack_frame *frame = bottom - 1;
  24
  25         while(frame >= top)
  26                 frame = frame_successor(frame);
  27
  28         return frame + 1;
  29 }
  30
  31 /* We ignore the two topmost frames, the 'callstack' primitive
  32 frame itself, and the frame calling the 'callstack' primitive,
  33 so that set-callstack doesn't get stuck in an infinite loop.
  34
  35 This means that if 'callstack' is called in tail position, we
  36 will have popped a necessary frame... however this word is only
  37 called by continuation implementation, and user code shouldn't
  38 be calling it at all, so we leave it as it is for now. */
  39 stack_frame *factor_vm::second_from_top_stack_frame()
  40 {
  41         stack_frame *frame = ctx->callstack_bottom - 1;
  42         while(frame >= ctx->callstack_top
  43                 && frame_successor(frame) >= ctx->callstack_top
  44                 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
  45         {
  46                 frame = frame_successor(frame);
  47         }
  48         return frame + 1;
  49 }
  50
  51 void factor_vm::primitive_callstack()
  52 {
  53         stack_frame *top = second_from_top_stack_frame();
  54         stack_frame *bottom = ctx->callstack_bottom;
  55
  56         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
  57
  58         callstack *stack = allot_callstack(size);
  59         memcpy(stack->top(),top,size);
  60         ctx->push(tag<callstack>(stack));
  61 }
  62
  63 code_block *factor_vm::frame_code(stack_frame *frame)
  64 {
  65         check_frame(frame);
  66         return (code_block *)frame->entry_point - 1;
  67 }
  68
  69 code_block_type factor_vm::frame_type(stack_frame *frame)
  70 {
  71         return frame_code(frame)->type();
  72 }
  73
  74 cell factor_vm::frame_executing(stack_frame *frame)
  75 {
  76         return frame_code(frame)->owner;
  77 }
  78
  79 cell factor_vm::frame_executing_quot(stack_frame *frame)
  80 {
  81         tagged<object> executing(frame_executing(frame));
  82         code_block *compiled = frame_code(frame);
  83         if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
  84                 executing = executing.as<word>()->def;
  85         return executing.value();
  86 }
  87
  88 stack_frame *factor_vm::frame_successor(stack_frame *frame)
  89 {
  90         check_frame(frame);
  91         return (stack_frame *)((cell)frame - frame->size);
  92 }
  93
  94 /* Allocates memory */
  95 cell factor_vm::frame_scan(stack_frame *frame)
  96 {
  97         switch(frame_type(frame))
  98         {
  99         case code_block_unoptimized:
 100                 {
 101                         tagged<object> obj(frame_executing(frame));
 102                         if(obj.type_p(WORD_TYPE))
 103                                 obj = obj.as<word>()->def;
 104
 105                         if(obj.type_p(QUOTATION_TYPE))
 106                         {
 107                                 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
 108                                 char *quot_entry_point = (char *)(frame_code(frame) + 1);
 109
 110                                 return tag_fixnum(quot_code_offset_to_scan(
 111                                         obj.value(),(cell)(return_addr - quot_entry_point)));
 112                         }
 113                         else
 114                                 return false_object;
 115                 }
 116         case code_block_optimized:
 117                 return false_object;
 118         default:
 119                 critical_error("Bad frame type",frame_type(frame));
 120                 return false_object;
 121         }
 122 }
 123
 124 namespace
 125 {
 126
 127 struct stack_frame_accumulator {
 128         factor_vm *parent;
 129         growable_array frames;
 130
 131         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
 132
 133         void operator()(stack_frame *frame)
 134         {
 135                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
 136                 data_root<object> executing(parent->frame_executing(frame),parent);
 137                 data_root<object> scan(parent->frame_scan(frame),parent);
 138
 139                 frames.add(executing.value());
 140                 frames.add(executing_quot.value());
 141                 frames.add(scan.value());
 142         }
 143 };
 144
 145 }
 146
 147 void factor_vm::primitive_callstack_to_array()
 148 {
 149         data_root<callstack> callstack(ctx->pop(),this);
 150
 151         stack_frame_accumulator accum(this);
 152         iterate_callstack_object(callstack.untagged(),accum);
 153         accum.frames.trim();
 154
 155         ctx->push(accum.frames.elements.value());
 156 }
 157
 158 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
 159 {
 160         stack_frame *top = stack->top();
 161         stack_frame *bottom = stack->bottom();
 162         stack_frame *frame = bottom - 1;
 163
 164         while(frame >= top && frame_successor(frame) >= top)
 165                 frame = frame_successor(frame);
 166
 167         return frame;
 168 }
 169
 170 /* Some primitives implementing a limited form of callstack mutation.
 171 Used by the single stepper. */
 172 void factor_vm::primitive_innermost_stack_frame_executing()
 173 {
 174         stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
 175         ctx->push(frame_executing_quot(frame));
 176 }
 177
 178 void factor_vm::primitive_innermost_stack_frame_scan()
 179 {
 180         stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
 181         ctx->push(frame_scan(frame));
 182 }
 183
 184 void factor_vm::primitive_set_innermost_stack_frame_quot()
 185 {
 186         data_root<callstack> callstack(ctx->pop(),this);
 187         data_root<quotation> quot(ctx->pop(),this);
 188
 189         callstack.untag_check(this);
 190         quot.untag_check(this);
 191
 192         jit_compile_quot(quot.value(),true);
 193
 194         stack_frame *inner = innermost_stack_frame(callstack.untagged());
 195         cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->entry_point;
 196         inner->entry_point = quot->entry_point;
 197         FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->entry_point + offset;
 198 }
 199
 200 }