vm/callstack.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 void factorvm::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 *factorvm::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 *factorvm::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 *factorvm::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 inline void factorvm::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 PRIMITIVE(callstack)
  64 {
  65         PRIMITIVE_GETVM()->primitive_callstack();
  66 }
  67
  68 inline void factorvm::primitive_set_callstack()
  69 {
  70         callstack *stack = untag_check<callstack>(dpop());
  71
  72         set_callstack(stack_chain->callstack_bottom,
  73                 stack->top(),
  74                 untag_fixnum(stack->length),
  75                 memcpy);
  76
  77         /* We cannot return here ... */
  78         critical_error("Bug in set_callstack()",0);
  79 }
  80
  81 PRIMITIVE(set_callstack)
  82 {
  83         PRIMITIVE_GETVM()->primitive_set_callstack();
  84 }
  85
  86 code_block *factorvm::frame_code(stack_frame *frame)
  87 {
  88         check_frame(frame);
  89         return (code_block *)frame->xt - 1;
  90 }
  91
  92 cell factorvm::frame_type(stack_frame *frame)
  93 {
  94         return frame_code(frame)->type;
  95 }
  96
  97 cell factorvm::frame_executing(stack_frame *frame)
  98 {
  99         code_block *compiled = frame_code(frame);
 100         if(compiled->literals == F || !stack_traces_p())
 101                 return F;
 102         else
 103         {
 104                 array *literals = untag<array>(compiled->literals);
 105                 cell executing = array_nth(literals,0);
 106                 check_data_pointer((object *)executing);
 107                 return executing;
 108         }
 109 }
 110
 111 stack_frame *factorvm::frame_successor(stack_frame *frame)
 112 {
 113         check_frame(frame);
 114         return (stack_frame *)((cell)frame - frame->size);
 115 }
 116
 117 /* Allocates memory */
 118 cell factorvm::frame_scan(stack_frame *frame)
 119 {
 120         switch(frame_type(frame))
 121         {
 122         case QUOTATION_TYPE:
 123                 {
 124                         cell quot = frame_executing(frame);
 125                         if(quot == F)
 126                                 return F;
 127                         else
 128                         {
 129                                 char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
 130                                 char *quot_xt = (char *)(frame_code(frame) + 1);
 131
 132                                 return tag_fixnum(quot_code_offset_to_scan(
 133                                         quot,(cell)(return_addr - quot_xt)));
 134                         }
 135                 }
 136         case WORD_TYPE:
 137                 return F;
 138         default:
 139                 critical_error("Bad frame type",frame_type(frame));
 140                 return F;
 141         }
 142 }
 143
 144 namespace
 145 {
 146
 147 struct stack_frame_accumulator {
 148         growable_array frames;
 149
 150         stack_frame_accumulator(factorvm *vm) : frames(vm) {}
 151
 152         void operator()(stack_frame *frame, factorvm *myvm)
 153         {
 154                 gc_root<object> executing(myvm->frame_executing(frame),myvm);
 155                 gc_root<object> scan(myvm->frame_scan(frame),myvm);
 156
 157                 frames.add(executing.value());
 158                 frames.add(scan.value());
 159         }
 160 };
 161
 162 }
 163
 164 inline void factorvm::primitive_callstack_to_array()
 165 {
 166         gc_root<callstack> callstack(dpop(),this);
 167
 168         stack_frame_accumulator accum(this);
 169         iterate_callstack_object(callstack.untagged(),accum);
 170         accum.frames.trim();
 171
 172         dpush(accum.frames.elements.value());
 173 }
 174
 175 PRIMITIVE(callstack_to_array)
 176 {
 177         PRIMITIVE_GETVM()->primitive_callstack_to_array();
 178 }
 179
 180 stack_frame *factorvm::innermost_stack_frame(callstack *stack)
 181 {
 182         stack_frame *top = stack->top();
 183         stack_frame *bottom = stack->bottom();
 184         stack_frame *frame = bottom - 1;
 185
 186         while(frame >= top && frame_successor(frame) >= top)
 187                 frame = frame_successor(frame);
 188
 189         return frame;
 190 }
 191
 192 stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
 193 {
 194         stack_frame *inner = innermost_stack_frame(callstack);
 195         tagged<quotation>(frame_executing(inner)).untag_check(this);
 196         return inner;
 197 }
 198
 199 /* Some primitives implementing a limited form of callstack mutation.
 200 Used by the single stepper. */
 201 inline void factorvm::primitive_innermost_stack_frame_executing()
 202 {
 203         dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
 204 }
 205
 206 PRIMITIVE(innermost_stack_frame_executing)
 207 {
 208         PRIMITIVE_GETVM()->primitive_innermost_stack_frame_executing();
 209 }
 210
 211 inline void factorvm::primitive_innermost_stack_frame_scan()
 212 {
 213         dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
 214 }
 215
 216 PRIMITIVE(innermost_stack_frame_scan)
 217 {
 218         PRIMITIVE_GETVM()->primitive_innermost_stack_frame_scan();
 219 }
 220
 221 inline void factorvm::primitive_set_innermost_stack_frame_quot()
 222 {
 223         gc_root<callstack> callstack(dpop(),this);
 224         gc_root<quotation> quot(dpop(),this);
 225
 226         callstack.untag_check(this);
 227         quot.untag_check(this);
 228
 229         jit_compile(quot.value(),true);
 230
 231         stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
 232         cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
 233         inner->xt = quot->xt;
 234         FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
 235 }
 236
 237 PRIMITIVE(set_innermost_stack_frame_quot)
 238 {
 239         PRIMITIVE_GETVM()->primitive_set_innermost_stack_frame_quot();
 240 }
 241
 242 /* called before entry into Factor code. */
 243 void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
 244 {
 245         stack_chain->callstack_bottom = callstack_bottom;
 246 }
 247
 248 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factorvm *myvm)
 249 {
 250         ASSERTVM();
 251         return VM_PTR->save_callstack_bottom(callstack_bottom);
 252 }
 253
 254 }