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 void factor_vm::scrub_return_address()
 131 {
 132         stack_frame *top = ctx->callstack_top;
 133         stack_frame *bottom = ctx->callstack_bottom;
 134         stack_frame *frame = bottom - 1;
 135
 136         while(frame >= top && frame_successor(frame) >= top)
 137                 frame = frame_successor(frame);
 138
 139         set_frame_offset(frame,0);
 140 }
 141
 142 cell factor_vm::frame_scan(stack_frame *frame)
 143 {
 144         switch(frame_type(frame))
 145         {
 146         case code_block_unoptimized:
 147                 {
 148                         tagged<object> obj(frame_executing(frame));
 149                         if(obj.type_p(WORD_TYPE))
 150                                 obj = obj.as<word>()->def;
 151
 152                         if(obj.type_p(QUOTATION_TYPE))
 153                                 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
 154                         else
 155                                 return false_object;
 156                 }
 157         case code_block_optimized:
 158                 return false_object;
 159         default:
 160                 critical_error("Bad frame type",frame_type(frame));
 161                 return false_object;
 162         }
 163 }
 164
 165 struct stack_frame_accumulator {
 166         factor_vm *parent;
 167         growable_array frames;
 168
 169         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
 170
 171         void operator()(stack_frame *frame)
 172         {
 173                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
 174                 data_root<object> executing(parent->frame_executing(frame),parent);
 175                 data_root<object> scan(parent->frame_scan(frame),parent);
 176
 177                 frames.add(executing.value());
 178                 frames.add(executing_quot.value());
 179                 frames.add(scan.value());
 180         }
 181 };
 182
 183 void factor_vm::primitive_callstack_to_array()
 184 {
 185         data_root<callstack> callstack(ctx->pop(),this);
 186
 187         stack_frame_accumulator accum(this);
 188         iterate_callstack_object(callstack.untagged(),accum);
 189         accum.frames.trim();
 190
 191         ctx->push(accum.frames.elements.value());
 192 }
 193
 194 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
 195 {
 196         stack_frame *top = stack->top();
 197         stack_frame *bottom = stack->bottom();
 198         stack_frame *frame = bottom - 1;
 199
 200         while(frame >= top && frame_successor(frame) >= top)
 201                 frame = frame_successor(frame);
 202
 203         return frame;
 204 }
 205
 206 /* Some primitives implementing a limited form of callstack mutation.
 207 Used by the single stepper. */
 208 void factor_vm::primitive_innermost_stack_frame_executing()
 209 {
 210         stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
 211         ctx->push(frame_executing_quot(frame));
 212 }
 213
 214 void factor_vm::primitive_innermost_stack_frame_scan()
 215 {
 216         stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
 217         ctx->push(frame_scan(frame));
 218 }
 219
 220 void factor_vm::primitive_set_innermost_stack_frame_quot()
 221 {
 222         data_root<callstack> callstack(ctx->pop(),this);
 223         data_root<quotation> quot(ctx->pop(),this);
 224
 225         callstack.untag_check(this);
 226         quot.untag_check(this);
 227
 228         jit_compile_quot(quot.value(),true);
 229
 230         stack_frame *inner = innermost_stack_frame(callstack.untagged());
 231         cell offset = frame_offset(inner);
 232         inner->entry_point = quot->entry_point;
 233         set_frame_offset(inner,offset);
 234 }
 235
 236 void factor_vm::primitive_callstack_bounds()
 237 {
 238         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 239         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 240 }
 241
 242 }