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         return frame_code(frame)->owner;
  90 }
  91
  92 stack_frame *factor_vm::frame_successor(stack_frame *frame)
  93 {
  94         check_frame(frame);
  95         return (stack_frame *)((cell)frame - frame->size);
  96 }
  97
  98 /* Allocates memory */
  99 cell factor_vm::frame_scan(stack_frame *frame)
 100 {
 101         switch(frame_type(frame))
 102         {
 103         case QUOTATION_TYPE:
 104                 {
 105                         cell quot = frame_executing(frame);
 106                         if(quot == F)
 107                                 return F;
 108                         else
 109                         {
 110                                 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
 111                                 char *quot_xt = (char *)(frame_code(frame) + 1);
 112
 113                                 return tag_fixnum(quot_code_offset_to_scan(
 114                                         quot,(cell)(return_addr - quot_xt)));
 115                         }
 116                 }
 117         case WORD_TYPE:
 118                 return F;
 119         default:
 120                 critical_error("Bad frame type",frame_type(frame));
 121                 return F;
 122         }
 123 }
 124
 125 namespace
 126 {
 127
 128 struct stack_frame_accumulator {
 129         factor_vm *myvm;
 130         growable_array frames;
 131
 132         explicit stack_frame_accumulator(factor_vm *myvm_) : myvm(myvm_), frames(myvm_) {}
 133
 134         void operator()(stack_frame *frame)
 135         {
 136                 gc_root<object> executing(myvm->frame_executing(frame),myvm);
 137                 gc_root<object> scan(myvm->frame_scan(frame),myvm);
 138
 139                 frames.add(executing.value());
 140                 frames.add(scan.value());
 141         }
 142 };
 143
 144 }
 145
 146 void factor_vm::primitive_callstack_to_array()
 147 {
 148         gc_root<callstack> callstack(dpop(),this);
 149
 150         stack_frame_accumulator accum(this);
 151         iterate_callstack_object(callstack.untagged(),accum);
 152         accum.frames.trim();
 153
 154         dpush(accum.frames.elements.value());
 155 }
 156
 157 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
 158 {
 159         stack_frame *top = stack->top();
 160         stack_frame *bottom = stack->bottom();
 161         stack_frame *frame = bottom - 1;
 162
 163         while(frame >= top && frame_successor(frame) >= top)
 164                 frame = frame_successor(frame);
 165
 166         return frame;
 167 }
 168
 169 stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
 170 {
 171         stack_frame *inner = innermost_stack_frame(callstack);
 172         tagged<quotation>(frame_executing(inner)).untag_check(this);
 173         return inner;
 174 }
 175
 176 /* Some primitives implementing a limited form of callstack mutation.
 177 Used by the single stepper. */
 178 void factor_vm::primitive_innermost_stack_frame_executing()
 179 {
 180         dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
 181 }
 182
 183 void factor_vm::primitive_innermost_stack_frame_scan()
 184 {
 185         dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
 186 }
 187
 188 void factor_vm::primitive_set_innermost_stack_frame_quot()
 189 {
 190         gc_root<callstack> callstack(dpop(),this);
 191         gc_root<quotation> quot(dpop(),this);
 192
 193         callstack.untag_check(this);
 194         quot.untag_check(this);
 195
 196         jit_compile(quot.value(),true);
 197
 198         stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
 199         cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
 200         inner->xt = quot->xt;
 201         FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
 202 }
 203
 204 /* called before entry into Factor code. */
 205 void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
 206 {
 207         stack_chain->callstack_bottom = callstack_bottom;
 208 }
 209
 210 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm)
 211 {
 212         return myvm->save_callstack_bottom(callstack_bottom);
 213 }
 214
 215 }