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