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