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 void factor_vm::dispatch_signal_handler(cell *sp, cell *pc, cell newpc)
  22 {
  23         /* True stack frames are always 16-byte aligned. Leaf procedures
  24         that don't create a stack frame will be out of alignment by sizeof(cell)
  25         bytes. */
  26         cell offset = *sp % 16;
  27         if (offset == 0) {
  28                 signal_from_leaf = false;
  29                 cell newsp = *sp - sizeof(cell);
  30                 *sp = newsp;
  31                 *(cell*)newsp = *pc;
  32                 *pc = newpc;
  33                 ctx->callstack_top = (stack_frame*)newsp;
  34         } else if (offset == 16 - sizeof(cell)) {
  35                 dispatch_signal_handler_from_leaf(sp, pc, newpc);
  36         } else {
  37                 fatal_error("Invalid stack frame during signal handler", *sp);
  38         }
  39 }
  40
  41 void factor_vm::dispatch_signal_handler_from_leaf(cell *sp, cell *pc, cell newpc)
  42 {
  43         /* We should try to conjure a stack frame here, but we may need to deal
  44         with callstack overflows or the GC moving code around.
  45         For now leave the stack untouched so the signal handler returns into
  46         the parent procedure. This will cause things to blow up if the stack
  47         is left unbalanced. */
  48         signal_from_leaf = true;
  49         *pc = newpc;
  50 }
  51
  52 /* We ignore the two topmost frames, the 'callstack' primitive
  53 frame itself, and the frame calling the 'callstack' primitive,
  54 so that set-callstack doesn't get stuck in an infinite loop.
  55
  56 This means that if 'callstack' is called in tail position, we
  57 will have popped a necessary frame... however this word is only
  58 called by continuation implementation, and user code shouldn't
  59 be calling it at all, so we leave it as it is for now. */
  60 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
  61 {
  62         stack_frame *frame = ctx->callstack_bottom - 1;
  63         while(frame >= ctx->callstack_top
  64                 && frame_successor(frame) >= ctx->callstack_top
  65                 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
  66         {
  67                 frame = frame_successor(frame);
  68         }
  69         return frame + 1;
  70 }
  71
  72 cell factor_vm::capture_callstack(context *ctx)
  73 {
  74         stack_frame *top = second_from_top_stack_frame(ctx);
  75         stack_frame *bottom = ctx->callstack_bottom;
  76
  77         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
  78
  79         callstack *stack = allot_callstack(size);
  80         memcpy(stack->top(),top,size);
  81         return tag<callstack>(stack);
  82 }
  83
  84 void factor_vm::primitive_callstack()
  85 {
  86         ctx->push(capture_callstack(ctx));
  87 }
  88
  89 void factor_vm::primitive_callstack_for()
  90 {
  91         context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
  92         ctx->push(capture_callstack(other_ctx));
  93 }
  94
  95 code_block *factor_vm::frame_code(stack_frame *frame)
  96 {
  97         check_frame(frame);
  98         return (code_block *)frame->entry_point - 1;
  99 }
 100
 101 code_block_type factor_vm::frame_type(stack_frame *frame)
 102 {
 103         return frame_code(frame)->type();
 104 }
 105
 106 cell factor_vm::frame_executing(stack_frame *frame)
 107 {
 108         return frame_code(frame)->owner;
 109 }
 110
 111 cell factor_vm::frame_executing_quot(stack_frame *frame)
 112 {
 113         tagged<object> executing(frame_executing(frame));
 114         code_block *compiled = frame_code(frame);
 115         if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
 116                 executing = executing.as<word>()->def;
 117         return executing.value();
 118 }
 119
 120 stack_frame *factor_vm::frame_successor(stack_frame *frame)
 121 {
 122         check_frame(frame);
 123         return (stack_frame *)((cell)frame - frame->size);
 124 }
 125
 126 cell factor_vm::frame_offset(stack_frame *frame)
 127 {
 128         char *entry_point = (char *)frame_code(frame)->entry_point();
 129         char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
 130         if(return_address)
 131                 return return_address - entry_point;
 132         else
 133                 return (cell)-1;
 134 }
 135
 136 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
 137 {
 138         char *entry_point = (char *)frame_code(frame)->entry_point();
 139         if(offset == (cell)-1)
 140                 FRAME_RETURN_ADDRESS(frame,this) = NULL;
 141         else
 142                 FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
 143 }
 144
 145 cell factor_vm::frame_scan(stack_frame *frame)
 146 {
 147         switch(frame_type(frame))
 148         {
 149         case code_block_unoptimized:
 150                 {
 151                         tagged<object> obj(frame_executing(frame));
 152                         if(obj.type_p(WORD_TYPE))
 153                                 obj = obj.as<word>()->def;
 154
 155                         if(obj.type_p(QUOTATION_TYPE))
 156                                 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
 157                         else
 158                                 return false_object;
 159                 }
 160         case code_block_optimized:
 161                 return false_object;
 162         default:
 163                 critical_error("Bad frame type",frame_type(frame));
 164                 return false_object;
 165         }
 166 }
 167
 168 struct stack_frame_accumulator {
 169         factor_vm *parent;
 170         growable_array frames;
 171
 172         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
 173
 174         void operator()(stack_frame *frame)
 175         {
 176                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
 177                 data_root<object> executing(parent->frame_executing(frame),parent);
 178                 data_root<object> scan(parent->frame_scan(frame),parent);
 179
 180                 frames.add(executing.value());
 181                 frames.add(executing_quot.value());
 182                 frames.add(scan.value());
 183         }
 184 };
 185
 186 void factor_vm::primitive_callstack_to_array()
 187 {
 188         data_root<callstack> callstack(ctx->pop(),this);
 189
 190         stack_frame_accumulator accum(this);
 191         iterate_callstack_object(callstack.untagged(),accum);
 192         accum.frames.trim();
 193
 194         ctx->push(accum.frames.elements.value());
 195 }
 196
 197 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
 198 {
 199         stack_frame *frame = bottom - 1;
 200
 201         while(frame >= top && frame_successor(frame) >= top)
 202                 frame = frame_successor(frame);
 203
 204         return frame;
 205 }
 206
 207 /* Some primitives implementing a limited form of callstack mutation.
 208 Used by the single stepper. */
 209 void factor_vm::primitive_innermost_stack_frame_executing()
 210 {
 211         callstack *stack = untag_check<callstack>(ctx->pop());
 212         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 213         ctx->push(frame_executing_quot(frame));
 214 }
 215
 216 void factor_vm::primitive_innermost_stack_frame_scan()
 217 {
 218         callstack *stack = untag_check<callstack>(ctx->pop());
 219         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 220         ctx->push(frame_scan(frame));
 221 }
 222
 223 void factor_vm::primitive_set_innermost_stack_frame_quot()
 224 {
 225         data_root<callstack> stack(ctx->pop(),this);
 226         data_root<quotation> quot(ctx->pop(),this);
 227
 228         stack.untag_check(this);
 229         quot.untag_check(this);
 230
 231         jit_compile_quot(quot.value(),true);
 232
 233         stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
 234         cell offset = frame_offset(inner);
 235         inner->entry_point = quot->entry_point;
 236         set_frame_offset(inner,offset);
 237 }
 238
 239 void factor_vm::primitive_callstack_bounds()
 240 {
 241         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 242         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 243 }
 244
 245 }