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