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