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         if (!code->seg->in_segment_p(*pc) || *sp < ctx->callstack_seg->start + stack_reserved)
  24         {
  25                 /* Fault came from foreign code, a callstack overflow, or we would probably
  26                 overflow if we tried the resumable handler. We can't resume, so cut the
  27                 callstack down to the shallowest Factor stack frame that leaves room for
  28                 the signal handler to do its thing and launch the handler without going
  29                 through the resumable subprimitive. */
  30                 signal_resumable = false;
  31                 stack_frame *frame = ctx->callstack_bottom - 1;
  32
  33                 while((cell)frame >= *sp
  34                         && frame >= ctx->callstack_top
  35                         && (cell)frame >= ctx->callstack_seg->start + stack_reserved)
  36                 {
  37                         frame = frame_successor(frame);
  38                 }
  39
  40                 // XXX FRAME_RETURN_ADDRESS
  41                 cell newsp = (cell)(frame+1);
  42                 *sp = newsp;
  43                 ctx->callstack_top = (stack_frame*)newsp;
  44                 *pc = handler;
  45         } else {
  46                 signal_resumable = true;
  47                 // Fault came from Factor, and we've got a good callstack. Route the signal
  48                 // handler through the resumable signal handler subprimitive.
  49                 cell offset = *sp % 16;
  50
  51                 signal_handler_addr = handler;
  52                 tagged<word> handler_word = tagged<word>(special_objects[SIGNAL_HANDLER_WORD]);
  53
  54                 /* XXX horribly x86-centric */
  55                 /* True stack frames are always 16-byte aligned. Leaf procedures
  56                 that don't create a stack frame will be out of alignment by sizeof(cell)
  57                 bytes. */
  58                 /* On architectures with a link register we would have to check for leafness
  59                 by matching the PC to a word. We should also use FRAME_RETURN_ADDRESS instead
  60                 of assuming the stack pointer is the right place to put the resume address. */
  61                 if (offset == 0)
  62                 {
  63                         cell newsp = *sp - sizeof(cell);
  64                         *sp = newsp;
  65                         *(cell*)newsp = *pc;
  66                 }
  67                 else if (offset == 16 - sizeof(cell))
  68                 {
  69                         // Make a fake frame for the leaf procedure
  70                         code_block *leaf_block = code->code_block_for_address(*pc);
  71                         assert(leaf_block != NULL);
  72
  73                         // XXX get platform-appropriate stack frame size
  74                         cell newsp = *sp - 32;
  75                         *(cell*)(newsp + 32 -   sizeof(cell)) = 32;
  76                         *(cell*)(newsp + 32 - 2*sizeof(cell)) = (cell)leaf_block->entry_point();
  77                         *(cell*) newsp                        = *pc;
  78                         *sp = newsp;
  79                         handler_word = tagged<word>(special_objects[LEAF_SIGNAL_HANDLER_WORD]);
  80                 }
  81                 else
  82                 {
  83                         fatal_error("Invalid stack frame during signal handler", *sp);
  84                 }
  85
  86                 *pc = (cell)handler_word->code->entry_point();
  87         }
  88 }
  89
  90 /* We ignore the two topmost frames, the 'callstack' primitive
  91 frame itself, and the frame calling the 'callstack' primitive,
  92 so that set-callstack doesn't get stuck in an infinite loop.
  93
  94 This means that if 'callstack' is called in tail position, we
  95 will have popped a necessary frame... however this word is only
  96 called by continuation implementation, and user code shouldn't
  97 be calling it at all, so we leave it as it is for now. */
  98 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
  99 {
 100         stack_frame *frame = ctx->callstack_bottom - 1;
 101         while(frame >= ctx->callstack_top
 102                 && frame_successor(frame) >= ctx->callstack_top
 103                 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
 104         {
 105                 frame = frame_successor(frame);
 106         }
 107         return frame + 1;
 108 }
 109
 110 cell factor_vm::capture_callstack(context *ctx)
 111 {
 112         stack_frame *top = second_from_top_stack_frame(ctx);
 113         stack_frame *bottom = ctx->callstack_bottom;
 114
 115         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
 116
 117         callstack *stack = allot_callstack(size);
 118         memcpy(stack->top(),top,size);
 119         return tag<callstack>(stack);
 120 }
 121
 122 void factor_vm::primitive_callstack()
 123 {
 124         ctx->push(capture_callstack(ctx));
 125 }
 126
 127 void factor_vm::primitive_callstack_for()
 128 {
 129         context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
 130         ctx->push(capture_callstack(other_ctx));
 131 }
 132
 133 code_block *factor_vm::frame_code(stack_frame *frame)
 134 {
 135         check_frame(frame);
 136         return (code_block *)frame->entry_point - 1;
 137 }
 138
 139 code_block_type factor_vm::frame_type(stack_frame *frame)
 140 {
 141         return frame_code(frame)->type();
 142 }
 143
 144 cell factor_vm::frame_executing(stack_frame *frame)
 145 {
 146         return frame_code(frame)->owner;
 147 }
 148
 149 cell factor_vm::frame_executing_quot(stack_frame *frame)
 150 {
 151         tagged<object> executing(frame_executing(frame));
 152         code_block *compiled = frame_code(frame);
 153         if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
 154                 executing = executing.as<word>()->def;
 155         return executing.value();
 156 }
 157
 158 stack_frame *factor_vm::frame_successor(stack_frame *frame)
 159 {
 160         check_frame(frame);
 161         return (stack_frame *)((cell)frame - frame->size);
 162 }
 163
 164 cell factor_vm::frame_offset(stack_frame *frame)
 165 {
 166         char *entry_point = (char *)frame_code(frame)->entry_point();
 167         char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
 168         if(return_address)
 169                 return return_address - entry_point;
 170         else
 171                 return (cell)-1;
 172 }
 173
 174 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
 175 {
 176         char *entry_point = (char *)frame_code(frame)->entry_point();
 177         if(offset == (cell)-1)
 178                 FRAME_RETURN_ADDRESS(frame,this) = NULL;
 179         else
 180                 FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
 181 }
 182
 183 cell factor_vm::frame_scan(stack_frame *frame)
 184 {
 185         switch(frame_type(frame))
 186         {
 187         case code_block_unoptimized:
 188                 {
 189                         tagged<object> obj(frame_executing(frame));
 190                         if(obj.type_p(WORD_TYPE))
 191                                 obj = obj.as<word>()->def;
 192
 193                         if(obj.type_p(QUOTATION_TYPE))
 194                                 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
 195                         else
 196                                 return false_object;
 197                 }
 198         case code_block_optimized:
 199                 return false_object;
 200         default:
 201                 critical_error("Bad frame type",frame_type(frame));
 202                 return false_object;
 203         }
 204 }
 205
 206 struct stack_frame_accumulator {
 207         factor_vm *parent;
 208         growable_array frames;
 209
 210         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
 211
 212         void operator()(stack_frame *frame)
 213         {
 214                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
 215                 data_root<object> executing(parent->frame_executing(frame),parent);
 216                 data_root<object> scan(parent->frame_scan(frame),parent);
 217
 218                 frames.add(executing.value());
 219                 frames.add(executing_quot.value());
 220                 frames.add(scan.value());
 221         }
 222 };
 223
 224 void factor_vm::primitive_callstack_to_array()
 225 {
 226         data_root<callstack> callstack(ctx->pop(),this);
 227
 228         stack_frame_accumulator accum(this);
 229         iterate_callstack_object(callstack.untagged(),accum);
 230         accum.frames.trim();
 231
 232         ctx->push(accum.frames.elements.value());
 233 }
 234
 235 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
 236 {
 237         stack_frame *frame = bottom - 1;
 238
 239         while(frame >= top && frame_successor(frame) >= top)
 240                 frame = frame_successor(frame);
 241
 242         return frame;
 243 }
 244
 245 /* Some primitives implementing a limited form of callstack mutation.
 246 Used by the single stepper. */
 247 void factor_vm::primitive_innermost_stack_frame_executing()
 248 {
 249         callstack *stack = untag_check<callstack>(ctx->pop());
 250         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 251         ctx->push(frame_executing_quot(frame));
 252 }
 253
 254 void factor_vm::primitive_innermost_stack_frame_scan()
 255 {
 256         callstack *stack = untag_check<callstack>(ctx->pop());
 257         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 258         ctx->push(frame_scan(frame));
 259 }
 260
 261 void factor_vm::primitive_set_innermost_stack_frame_quot()
 262 {
 263         data_root<callstack> stack(ctx->pop(),this);
 264         data_root<quotation> quot(ctx->pop(),this);
 265
 266         stack.untag_check(this);
 267         quot.untag_check(this);
 268
 269         jit_compile_quot(quot.value(),true);
 270
 271         stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
 272         cell offset = frame_offset(inner);
 273         inner->entry_point = quot->entry_point;
 274         set_frame_offset(inner,offset);
 275 }
 276
 277 void factor_vm::primitive_callstack_bounds()
 278 {
 279         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 280         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 281 }
 282
 283 }