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