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