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                         // XXX get platform-appropriate stack frame size
 106                         cell newsp = *sp - 32;
 107                         *(cell*)(newsp + 32 -   sizeof(cell)) = 32;
 108                         *(cell*)(newsp + 32 - 2*sizeof(cell)) = leaf_word;
 109                         *(cell*) newsp                        = *pc;
 110                         *sp = newsp;
 111                         handler_word = tagged<word>(special_objects[LEAF_SIGNAL_HANDLER_WORD]);
 112                 }
 113                 else
 114                 {
 115                         fatal_error("Invalid stack frame during signal handler", *sp);
 116                 }
 117
 118                 *pc = (cell)handler_word->code->entry_point();
 119         }
 120 }
 121
 122 /* We ignore the two topmost frames, the 'callstack' primitive
 123 frame itself, and the frame calling the 'callstack' primitive,
 124 so that set-callstack doesn't get stuck in an infinite loop.
 125
 126 This means that if 'callstack' is called in tail position, we
 127 will have popped a necessary frame... however this word is only
 128 called by continuation implementation, and user code shouldn't
 129 be calling it at all, so we leave it as it is for now. */
 130 stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
 131 {
 132         stack_frame *frame = ctx->callstack_bottom - 1;
 133         while(frame >= ctx->callstack_top
 134                 && frame_successor(frame) >= ctx->callstack_top
 135                 && frame_successor(frame_successor(frame)) >= ctx->callstack_top)
 136         {
 137                 frame = frame_successor(frame);
 138         }
 139         return frame + 1;
 140 }
 141
 142 cell factor_vm::capture_callstack(context *ctx)
 143 {
 144         stack_frame *top = second_from_top_stack_frame(ctx);
 145         stack_frame *bottom = ctx->callstack_bottom;
 146
 147         fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
 148
 149         callstack *stack = allot_callstack(size);
 150         memcpy(stack->top(),top,size);
 151         return tag<callstack>(stack);
 152 }
 153
 154 void factor_vm::primitive_callstack()
 155 {
 156         ctx->push(capture_callstack(ctx));
 157 }
 158
 159 void factor_vm::primitive_callstack_for()
 160 {
 161         context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
 162         ctx->push(capture_callstack(other_ctx));
 163 }
 164
 165 code_block *factor_vm::frame_code(stack_frame *frame)
 166 {
 167         check_frame(frame);
 168         return (code_block *)frame->entry_point - 1;
 169 }
 170
 171 code_block_type factor_vm::frame_type(stack_frame *frame)
 172 {
 173         return frame_code(frame)->type();
 174 }
 175
 176 cell factor_vm::frame_executing(stack_frame *frame)
 177 {
 178         return frame_code(frame)->owner;
 179 }
 180
 181 cell factor_vm::frame_executing_quot(stack_frame *frame)
 182 {
 183         tagged<object> executing(frame_executing(frame));
 184         code_block *compiled = frame_code(frame);
 185         if(!compiled->optimized_p() && executing->type() == WORD_TYPE)
 186                 executing = executing.as<word>()->def;
 187         return executing.value();
 188 }
 189
 190 stack_frame *factor_vm::frame_successor(stack_frame *frame)
 191 {
 192         check_frame(frame);
 193         return (stack_frame *)((cell)frame - frame->size);
 194 }
 195
 196 cell factor_vm::frame_offset(stack_frame *frame)
 197 {
 198         char *entry_point = (char *)frame_code(frame)->entry_point();
 199         char *return_address = (char *)FRAME_RETURN_ADDRESS(frame,this);
 200         if(return_address)
 201                 return return_address - entry_point;
 202         else
 203                 return (cell)-1;
 204 }
 205
 206 void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
 207 {
 208         char *entry_point = (char *)frame_code(frame)->entry_point();
 209         if(offset == (cell)-1)
 210                 FRAME_RETURN_ADDRESS(frame,this) = NULL;
 211         else
 212                 FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
 213 }
 214
 215 cell factor_vm::frame_scan(stack_frame *frame)
 216 {
 217         switch(frame_type(frame))
 218         {
 219         case code_block_unoptimized:
 220                 {
 221                         tagged<object> obj(frame_executing(frame));
 222                         if(obj.type_p(WORD_TYPE))
 223                                 obj = obj.as<word>()->def;
 224
 225                         if(obj.type_p(QUOTATION_TYPE))
 226                                 return tag_fixnum(quot_code_offset_to_scan(obj.value(),frame_offset(frame)));
 227                         else
 228                                 return false_object;
 229                 }
 230         case code_block_optimized:
 231                 return false_object;
 232         default:
 233                 critical_error("Bad frame type",frame_type(frame));
 234                 return false_object;
 235         }
 236 }
 237
 238 struct stack_frame_accumulator {
 239         factor_vm *parent;
 240         growable_array frames;
 241
 242         explicit stack_frame_accumulator(factor_vm *parent_) : parent(parent_), frames(parent_) {}
 243
 244         void operator()(stack_frame *frame)
 245         {
 246                 data_root<object> executing_quot(parent->frame_executing_quot(frame),parent);
 247                 data_root<object> executing(parent->frame_executing(frame),parent);
 248                 data_root<object> scan(parent->frame_scan(frame),parent);
 249
 250                 frames.add(executing.value());
 251                 frames.add(executing_quot.value());
 252                 frames.add(scan.value());
 253         }
 254 };
 255
 256 void factor_vm::primitive_callstack_to_array()
 257 {
 258         data_root<callstack> callstack(ctx->pop(),this);
 259
 260         stack_frame_accumulator accum(this);
 261         iterate_callstack_object(callstack.untagged(),accum);
 262         accum.frames.trim();
 263
 264         ctx->push(accum.frames.elements.value());
 265 }
 266
 267 stack_frame *factor_vm::innermost_stack_frame(stack_frame *bottom, stack_frame *top)
 268 {
 269         stack_frame *frame = bottom - 1;
 270
 271         while(frame >= top && frame_successor(frame) >= top)
 272                 frame = frame_successor(frame);
 273
 274         return frame;
 275 }
 276
 277 /* Some primitives implementing a limited form of callstack mutation.
 278 Used by the single stepper. */
 279 void factor_vm::primitive_innermost_stack_frame_executing()
 280 {
 281         callstack *stack = untag_check<callstack>(ctx->pop());
 282         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 283         ctx->push(frame_executing_quot(frame));
 284 }
 285
 286 void factor_vm::primitive_innermost_stack_frame_scan()
 287 {
 288         callstack *stack = untag_check<callstack>(ctx->pop());
 289         stack_frame *frame = innermost_stack_frame(stack->bottom(), stack->top());
 290         ctx->push(frame_scan(frame));
 291 }
 292
 293 void factor_vm::primitive_set_innermost_stack_frame_quot()
 294 {
 295         data_root<callstack> stack(ctx->pop(),this);
 296         data_root<quotation> quot(ctx->pop(),this);
 297
 298         stack.untag_check(this);
 299         quot.untag_check(this);
 300
 301         jit_compile_quot(quot.value(),true);
 302
 303         stack_frame *inner = innermost_stack_frame(stack->bottom(), stack->top());
 304         cell offset = frame_offset(inner);
 305         inner->entry_point = quot->entry_point;
 306         set_frame_offset(inner,offset);
 307 }
 308
 309 void factor_vm::primitive_callstack_bounds()
 310 {
 311         ctx->push(allot_alien((void*)ctx->callstack_seg->start));
 312         ctx->push(allot_alien((void*)ctx->callstack_seg->end));
 313 }
 314
 315 }