vm/callstack.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 static void 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 *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 *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 *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 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(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 *frame_code(stack_frame *frame)
  77 {
  78         check_frame(frame);
  79         return (code_block *)frame->xt - 1;
  80 }
  81
  82 cell frame_type(stack_frame *frame)
  83 {
  84         return frame_code(frame)->type;
  85 }
  86
  87 cell 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 *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 frame_scan(stack_frame *frame)
 109 {
 110         if(frame_type(frame) == QUOTATION_TYPE)
 111         {
 112                 cell quot = frame_executing(frame);
 113                 if(quot == F)
 114                         return F;
 115                 else
 116                 {
 117                         char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
 118                         char *quot_xt = (char *)(frame_code(frame) + 1);
 119
 120                         return tag_fixnum(quot_code_offset_to_scan(
 121                                 quot,(cell)(return_addr - quot_xt)));
 122                 }
 123         }
 124         else
 125                 return F;
 126 }
 127
 128 namespace
 129 {
 130
 131 struct stack_frame_counter {
 132         cell count;
 133         stack_frame_counter() : count(0) {}
 134         void operator()(stack_frame *frame) { count += 2; }
 135 };
 136
 137 struct stack_frame_accumulator {
 138         cell index;
 139         gc_root<array> frames;
 140         stack_frame_accumulator(cell count) : index(0), frames(allot_array(count,F)) {}
 141         void operator()(stack_frame *frame)
 142         {
 143                 set_array_nth(frames.untagged(),index++,frame_executing(frame));
 144                 set_array_nth(frames.untagged(),index++,frame_scan(frame));
 145         }
 146 };
 147
 148 }
 149
 150 PRIMITIVE(callstack_to_array)
 151 {
 152         gc_root<callstack> callstack(dpop());
 153
 154         stack_frame_counter counter;
 155         iterate_callstack_object(callstack.untagged(),counter);
 156
 157         stack_frame_accumulator accum(counter.count);
 158         iterate_callstack_object(callstack.untagged(),accum);
 159
 160         dpush(accum.frames.value());
 161 }
 162
 163 stack_frame *innermost_stack_frame(callstack *stack)
 164 {
 165         stack_frame *top = stack->top();
 166         stack_frame *bottom = stack->bottom();
 167         stack_frame *frame = bottom - 1;
 168
 169         while(frame >= top && frame_successor(frame) >= top)
 170                 frame = frame_successor(frame);
 171
 172         return frame;
 173 }
 174
 175 stack_frame *innermost_stack_frame_quot(callstack *callstack)
 176 {
 177         stack_frame *inner = innermost_stack_frame(callstack);
 178         tagged<quotation>(frame_executing(inner)).untag_check();
 179         return inner;
 180 }
 181
 182 /* Some primitives implementing a limited form of callstack mutation.
 183 Used by the single stepper. */
 184 PRIMITIVE(innermost_stack_frame_executing)
 185 {
 186         dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
 187 }
 188
 189 PRIMITIVE(innermost_stack_frame_scan)
 190 {
 191         dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
 192 }
 193
 194 PRIMITIVE(set_innermost_stack_frame_quot)
 195 {
 196         gc_root<callstack> callstack(dpop());
 197         gc_root<quotation> quot(dpop());
 198
 199         callstack.untag_check();
 200         quot.untag_check();
 201
 202         jit_compile(quot.value(),true);
 203
 204         stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
 205         cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
 206         inner->xt = quot->xt;
 207         FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
 208 }
 209
 210 /* called before entry into Factor code. */
 211 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
 212 {
 213         stack_chain->callstack_bottom = callstack_bottom;
 214 }
 215
 216 }