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