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 = ctx->callstack_bottom - 1;
  41         while(frame >= ctx->callstack_top && frame_successor(frame) >= ctx->callstack_top)
  42                 frame = frame_successor(frame);
  43         return frame + 1;
  44 }
  45
  46 void factor_vm::primitive_callstack()
  47 {
  48         stack_frame *top = capture_start();
  49         stack_frame *bottom = ctx->callstack_bottom;
  50
  51         fixnum size = (cell)bottom - (cell)top;
  52         if(size < 0)
  53                 size = 0;
  54
  55         callstack *stack = allot_callstack(size);
  56         memcpy(stack->top(),top,size);
  57         dpush(tag<callstack>(stack));
  58 }
  59
  60 void factor_vm::primitive_set_callstack()
  61 {
  62         callstack *stack = untag_check<callstack>(dpop());
  63
  64         set_callstack(ctx->callstack_bottom,
  65                 stack->top(),
  66                 untag_fixnum(stack->length),
  67                 memcpy);
  68
  69         /* We cannot return here ... */
  70         critical_error("Bug in set_callstack()",0);
  71 }
  72
  73 code_block *factor_vm::frame_code(stack_frame *frame)
  74 {
  75         check_frame(frame);
  76         return (code_block *)frame->xt - 1;
  77 }
  78
  79 cell factor_vm::frame_type(stack_frame *frame)
  80 {
  81         return frame_code(frame)->type();
  82 }
  83
  84 cell factor_vm::frame_executing(stack_frame *frame)
  85 {
  86         return frame_code(frame)->owner;
  87 }
  88
  89 stack_frame *factor_vm::frame_successor(stack_frame *frame)
  90 {
  91         check_frame(frame);
  92         return (stack_frame *)((cell)frame - frame->size);
  93 }
  94
  95 /* Allocates memory */
  96 cell factor_vm::frame_scan(stack_frame *frame)
  97 {
  98         switch(frame_type(frame))
  99         {
 100         case QUOTATION_TYPE:
 101                 {
 102                         cell quot = frame_executing(frame);
 103                         if(quot == F)
 104                                 return F;
 105                         else
 106                         {
 107                                 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
 108                                 char *quot_xt = (char *)(frame_code(frame) + 1);
 109
 110                                 return tag_fixnum(quot_code_offset_to_scan(
 111                                         quot,(cell)(return_addr - quot_xt)));
 112                         }
 113                 }
 114         case WORD_TYPE:
 115                 return F;
 116         default:
 117                 critical_error("Bad frame type",frame_type(frame));
 118                 return F;
 119         }
 120 }
 121
 122 namespace
 123 {
 124
 125 struct stack_frame_accumulator {
 126         factor_vm *myvm;
 127         growable_array frames;
 128
 129         explicit stack_frame_accumulator(factor_vm *myvm_) : myvm(myvm_), frames(myvm_) {}
 130
 131         void operator()(stack_frame *frame)
 132         {
 133                 gc_root<object> executing(myvm->frame_executing(frame),myvm);
 134                 gc_root<object> scan(myvm->frame_scan(frame),myvm);
 135
 136                 frames.add(executing.value());
 137                 frames.add(scan.value());
 138         }
 139 };
 140
 141 }
 142
 143 void factor_vm::primitive_callstack_to_array()
 144 {
 145         gc_root<callstack> callstack(dpop(),this);
 146
 147         stack_frame_accumulator accum(this);
 148         iterate_callstack_object(callstack.untagged(),accum);
 149         accum.frames.trim();
 150
 151         dpush(accum.frames.elements.value());
 152 }
 153
 154 stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
 155 {
 156         stack_frame *top = stack->top();
 157         stack_frame *bottom = stack->bottom();
 158         stack_frame *frame = bottom - 1;
 159
 160         while(frame >= top && frame_successor(frame) >= top)
 161                 frame = frame_successor(frame);
 162
 163         return frame;
 164 }
 165
 166 stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
 167 {
 168         stack_frame *inner = innermost_stack_frame(callstack);
 169         tagged<quotation>(frame_executing(inner)).untag_check(this);
 170         return inner;
 171 }
 172
 173 /* Some primitives implementing a limited form of callstack mutation.
 174 Used by the single stepper. */
 175 void factor_vm::primitive_innermost_stack_frame_executing()
 176 {
 177         dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
 178 }
 179
 180 void factor_vm::primitive_innermost_stack_frame_scan()
 181 {
 182         dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
 183 }
 184
 185 void factor_vm::primitive_set_innermost_stack_frame_quot()
 186 {
 187         gc_root<callstack> callstack(dpop(),this);
 188         gc_root<quotation> quot(dpop(),this);
 189
 190         callstack.untag_check(this);
 191         quot.untag_check(this);
 192
 193         jit_compile(quot.value(),true);
 194
 195         stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
 196         cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
 197         inner->xt = quot->xt;
 198         FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
 199 }
 200
 201 /* called before entry into Factor code. */
 202 void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
 203 {
 204         ctx->callstack_bottom = callstack_bottom;
 205 }
 206
 207 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm)
 208 {
 209         return myvm->save_callstack_bottom(callstack_bottom);
 210 }
 211
 212 }