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->xt);
  10         assert(frame->size != 0);
  11 #endif
  12 }
  13
  14 callstack *factor_vm::allot_callstack(cell size)
  15 {
  16         callstack *stack = allot<callstack>(callstack_size(size));
  17         stack->length = tag_fixnum(size);
  18         return stack;
  19 }
  20
  21 stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
  22 {
  23         stack_frame *frame = bottom - 1;
  24
  25         while(frame >= top)
  26                 frame = frame_successor(frame);
  27
  28         return frame + 1;
  29 }
  30
  31 /* We ignore the topmost frame, the one calling 'callstack',
  32 so that set-callstack doesn't get stuck in an infinite loop.
  33
  34 This means that if 'callstack' is called in tail position, we
  35 will have popped a necessary frame... however this word is only
  36 called by continuation implementation, and user code shouldn't
  37 be calling it at all, so we leave it as it is for now. */
  38 stack_frame *factor_vm::capture_start()
  39 {
  40         stack_frame *frame = stack_chain->callstack_bottom - 1;
  41         while(frame >= stack_chain->callstack_top
  42                 && frame_successor(frame) >= stack_chain->callstack_top)
  43         {
  44                 frame = frame_successor(frame);
  45         }
  46         return frame + 1;
  47 }
  48
  49 void factor_vm::primitive_callstack()
  50 {
  51         stack_frame *top = capture_start();
  52         stack_frame *bottom = stack_chain->callstack_bottom;
  53
  54         fixnum size = (cell)bottom - (cell)top;
  55         if(size < 0)
  56                 size = 0;
  57
  58         callstack *stack = allot_callstack(size);
  59         memcpy(stack->top(),top,size);
  60         dpush(tag<callstack>(stack));
  61 }
  62
  63 void factor_vm::primitive_set_callstack()
  64 {
  65         callstack *stack = untag_check<callstack>(dpop());
  66
  67         set_callstack(stack_chain->callstack_bottom,
  68                 stack->top(),
  69                 untag_fixnum(stack->length),
  70                 memcpy);
  71
  72         /* We cannot return here ... */
  73         critical_error("Bug in set_callstack()",0);
  74 }
  75
  76 code_block *factor_vm::frame_code(stack_frame *frame)
  77 {
  78         check_frame(frame);
  79         return (code_block *)frame->xt - 1;
  80 }
  81
  82 cell factor_vm::frame_type(stack_frame *frame)
  83 {
  84         return frame_code(frame)->type;
  85 }
  86
  87 cell factor_vm::frame_executing(stack_frame *frame)
  88 {
  89         code_block *compiled = frame_code(frame);
  90         if(compiled->literals == F || !stack_traces_p())
  91                 return F;
  92         else
  93         {
  94                 array *literals = untag<array>(compiled->literals);
  95                 cell executing = array_nth(literals,0);
  96                 check_data_pointer((object *)executing);
  97                 return executing;
  98         }
  99 }
 100
 101 stack_frame *factor_vm::frame_successor(stack_frame *frame)
 102 {
 103         check_frame(frame);
 104         return (stack_frame *)((cell)frame - frame->size);
 105 }
 106
 107 /* Allocates memory */
 108 cell factor_vm::frame_scan(stack_frame *frame)
 109 {
 110         switch(frame_type(frame))
 111         {
 112         case QUOTATION_TYPE:
 113                 {
 114                         cell quot = frame_executing(frame);
 115                         if(quot == F)
 116                                 return F;
 117                         else
 118                         {
 119                                 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
 120                                 char *quot_xt = (char *)(frame_code(frame) + 1);
 121
 122                                 return tag_fixnum(quot_code_offset_to_scan(
 123                                         quot,(cell)(return_addr - quot_xt)));
 124                         }
 125                 }
 126         case WORD_TYPE:
 127                 return F;
 128         default:
 129                 critical_error("Bad frame type",frame_type(frame));
 130                 return F;
 131         }
 132 }
 133
 134 namespace
 135 {
 136
 137 struct stack_frame_accumulator {
 138         growable_array frames;
 139
 140         stack_frame_accumulator(factor_vm *vm) : frames(vm) {}
 141
 142         void operator()(stack_frame *frame, factor_vm *myvm)
 143         {
 144                 gc_root<object> executing(myvm->frame_executing(frame),myvm);
 145                 gc_root<object> scan(myvm->frame_scan(frame),myvm);
 146
 147                 frames.add(executing.value());
 148                 frames.add(scan.value());
 149         }
 150 };
 151
 152 }
 153
 154 void factor_vm::primitive_callstack_to_array()
 155 {
 156         gc_root<callstack> callstack(dpop(),this);
 157
 158         stack_frame_accumulator accum(this);
 159         iterate_callstack_object(callstack.untagged(),accum);
 160         accum.frames.trim();
 161
 162         dpush(accum.frames.elements.value());
 163 }
 164
 165 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
 166 {
 167         stack_frame *top = stack->top();
 168         stack_frame *bottom = stack->bottom();
 169         stack_frame *frame = bottom - 1;
 170
 171         while(frame >= top && frame_successor(frame) >= top)
 172                 frame = frame_successor(frame);
 173
 174         return frame;
 175 }
 176
 177 stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
 178 {
 179         stack_frame *inner = innermost_stack_frame(callstack);
 180         tagged<quotation>(frame_executing(inner)).untag_check(this);
 181         return inner;
 182 }
 183
 184 /* Some primitives implementing a limited form of callstack mutation.
 185 Used by the single stepper. */
 186 void factor_vm::primitive_innermost_stack_frame_executing()
 187 {
 188         dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
 189 }
 190
 191 void factor_vm::primitive_innermost_stack_frame_scan()
 192 {
 193         dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
 194 }
 195
 196 void factor_vm::primitive_set_innermost_stack_frame_quot()
 197 {
 198         gc_root<callstack> callstack(dpop(),this);
 199         gc_root<quotation> quot(dpop(),this);
 200
 201         callstack.untag_check(this);
 202         quot.untag_check(this);
 203
 204         jit_compile(quot.value(),true);
 205
 206         stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
 207         cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
 208         inner->xt = quot->xt;
 209         FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
 210 }
 211
 212 /* called before entry into Factor code. */
 213 void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
 214 {
 215         stack_chain->callstack_bottom = callstack_bottom;
 216 }
 217
 218 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm)
 219 {
 220         ASSERTVM();
 221         return VM_PTR->save_callstack_bottom(callstack_bottom);
 222 }
 223
 224 }