vm/run.c

   1 #include "master.h"
   2
   3 void reset_datastack(void)
   4 {
   5         ds = ds_bot - CELLS;
   6 }
   7
   8 void reset_retainstack(void)
   9 {
  10         rs = rs_bot - CELLS;
  11 }
  12
  13 #define RESERVED (64 * CELLS)
  14
  15 void fix_stacks(void)
  16 {
  17         if(ds + CELLS < ds_bot || ds + RESERVED >= ds_top) reset_datastack();
  18         if(rs + CELLS < rs_bot || rs + RESERVED >= rs_top) reset_retainstack();
  19 }
  20
  21 /* called before entry into foreign C code. Note that ds and rs might
  22 be stored in registers, so callbacks must save and restore the correct values */
  23 void save_stacks(void)
  24 {
  25         if(stack_chain)
  26         {
  27                 stack_chain->datastack = ds;
  28                 stack_chain->retainstack = rs;
  29         }
  30 }
  31
  32 F_CONTEXT *alloc_context(void)
  33 {
  34         F_CONTEXT *context;
  35
  36         if(unused_contexts)
  37         {
  38                 context = unused_contexts;
  39                 unused_contexts = unused_contexts->next;
  40         }
  41         else
  42         {
  43                 context = safe_malloc(sizeof(F_CONTEXT));
  44                 context->datastack_region = alloc_segment(ds_size);
  45                 context->retainstack_region = alloc_segment(rs_size);
  46         }
  47
  48         return context;
  49 }
  50
  51 void dealloc_context(F_CONTEXT *context)
  52 {
  53         context->next = unused_contexts;
  54         unused_contexts = context;
  55 }
  56
  57 /* called on entry into a compiled callback */
  58 void nest_stacks(void)
  59 {
  60         F_CONTEXT *new_stacks = alloc_context();
  61
  62         new_stacks->callstack_bottom = (F_STACK_FRAME *)-1;
  63         new_stacks->callstack_top = (F_STACK_FRAME *)-1;
  64
  65         /* note that these register values are not necessarily valid stack
  66         pointers. they are merely saved non-volatile registers, and are
  67         restored in unnest_stacks(). consider this scenario:
  68         - factor code calls C function
  69         - C function saves ds/cs registers (since they're non-volatile)
  70         - C function clobbers them
  71         - C function calls Factor callback
  72         - Factor callback returns
  73         - C function restores registers
  74         - C function returns to Factor code */
  75         new_stacks->datastack_save = ds;
  76         new_stacks->retainstack_save = rs;
  77
  78         /* save per-callback userenv */
  79         new_stacks->current_callback_save = userenv[CURRENT_CALLBACK_ENV];
  80         new_stacks->catchstack_save = userenv[CATCHSTACK_ENV];
  81
  82         new_stacks->next = stack_chain;
  83         stack_chain = new_stacks;
  84
  85         reset_datastack();
  86         reset_retainstack();
  87 }
  88
  89 /* called when leaving a compiled callback */
  90 void unnest_stacks(void)
  91 {
  92         ds = stack_chain->datastack_save;
  93         rs = stack_chain->retainstack_save;
  94
  95         /* restore per-callback userenv */
  96         userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save;
  97         userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save;
  98
  99         F_CONTEXT *old_stacks = stack_chain;
 100         stack_chain = old_stacks->next;
 101         dealloc_context(old_stacks);
 102 }
 103
 104 /* called on startup */
 105 void init_stacks(CELL ds_size_, CELL rs_size_)
 106 {
 107         ds_size = ds_size_;
 108         rs_size = rs_size_;
 109         stack_chain = NULL;
 110         unused_contexts = NULL;
 111 }
 112
 113 bool stack_to_array(CELL bottom, CELL top)
 114 {
 115         F_FIXNUM depth = (F_FIXNUM)(top - bottom + CELLS);
 116
 117         if(depth < 0)
 118                 return false;
 119         else
 120         {
 121                 F_ARRAY *a = allot_array_internal(ARRAY_TYPE,depth / CELLS);
 122                 memcpy(a + 1,(void*)bottom,depth);
 123                 dpush(tag_object(a));
 124                 return true;
 125         }
 126 }
 127
 128 void primitive_datastack(void)
 129 {
 130         if(!stack_to_array(ds_bot,ds))
 131                 general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
 132 }
 133
 134 void primitive_retainstack(void)
 135 {
 136         if(!stack_to_array(rs_bot,rs))
 137                 general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
 138 }
 139
 140 /* returns pointer to top of stack */
 141 CELL array_to_stack(F_ARRAY *array, CELL bottom)
 142 {
 143         CELL depth = array_capacity(array) * CELLS;
 144         memcpy((void*)bottom,array + 1,depth);
 145         return bottom + depth - CELLS;
 146 }
 147
 148 void primitive_set_datastack(void)
 149 {
 150         ds = array_to_stack(untag_array(dpop()),ds_bot);
 151 }
 152
 153 void primitive_set_retainstack(void)
 154 {
 155         rs = array_to_stack(untag_array(dpop()),rs_bot);
 156 }
 157
 158 void primitive_getenv(void)
 159 {
 160         F_FIXNUM e = untag_fixnum_fast(dpeek());
 161         drepl(userenv[e]);
 162 }
 163
 164 void primitive_setenv(void)
 165 {
 166         F_FIXNUM e = untag_fixnum_fast(dpop());
 167         CELL value = dpop();
 168         userenv[e] = value;
 169 }
 170
 171 void primitive_exit(void)
 172 {
 173         exit(to_fixnum(dpop()));
 174 }
 175
 176 void primitive_micros(void)
 177 {
 178         box_unsigned_8(current_micros());
 179 }
 180
 181 void primitive_sleep(void)
 182 {
 183         sleep_micros(to_cell(dpop()));
 184 }
 185
 186 void primitive_set_slot(void)
 187 {
 188         F_FIXNUM slot = untag_fixnum_fast(dpop());
 189         CELL obj = dpop();
 190         CELL value = dpop();
 191         set_slot(obj,slot,value);
 192 }
 193
 194 void primitive_load_locals(void)
 195 {
 196         F_FIXNUM count = untag_fixnum_fast(dpop());
 197         memcpy((CELL *)(rs + CELLS),(CELL *)(ds - CELLS * (count - 1)),CELLS * count);
 198         ds -= CELLS * count;
 199         rs += CELLS * count;
 200 }