src/c/rtemgr.c

   1 #include "rtemgr.h"
   2 #include "scheme.h"
   3 #include "arch.h"
   4 #include "assertions.h"
   5 #include "strings.h"
   6
   7 extern SchemeObject sc_nil;
   8
   9 void printActFrm(int p) {
  10     unsigned int fp,ret,env,n;
  11     unsigned int i;
  12
  13     fp = stack[p-1];
  14     ret = stack[p-2];
  15     env = stack[p-3];
  16     n = stack[p-4];
  17
  18     fprintf( stderr, "[%d] fp=0x%x\n", p-1, fp );  fflush(stderr);
  19     fprintf( stderr, "[%d] ret=0x%x\n", p-2, ret );  fflush(stderr);
  20     fprintf( stderr, "[%d] env=0x%x\n", p-3, env );  fflush(stderr);
  21     fprintf( stderr, "[%d] n=%d\n", p-4, n );  fflush(stderr);
  22     for (i=p-5; i>=p-5-n+1; i--) {
  23         fprintf( stderr, "[%d] a[%d]=%s\n",i, -i+p-5, sobToString((SchemeObject*)(stack[i])) );
  24         fflush(stderr);
  25     }
  26 }
  27
  28 /* Copies the enviroment vector currenv to a new vector of size
  29    (currenv_size+1) starting from element #1.
  30    Copies the arguments from the stack to element #0 of the new vector.
  31    Returns the new env. vector.
  32
  33    @param currenv: points to the current enviroment vector
  34    @param currenv_size: size of the current enviroment vector
  35 */
  36 int** extendEnviroment(int** currenv, int currenv_size)
  37 {
  38     int** newenv;   /* newenv: points to the new envoriment vector */
  39     int ndx;        /* ndx: loop index */
  40
  41     ASSERT_ALWAYS(currenv_size>=0,"");
  42
  43     /* allocate new enviroment vector */
  44     newenv = autoMalloc( sizeof(int) * (currenv_size + 1) );
  45
  46     /* copy current enviroment to new enviroment */
  47     ndx = currenv_size;
  48 Lfor1:
  49     if (ndx<=0) goto LendFor1;
  50     newenv[ndx] = currenv[ndx-1];
  51     --ndx;
  52     goto Lfor1;
  53 LendFor1:
  54     /* copy arguments from stack to new enviroment vector (extend env.) */
  55     if (currenv_size<=0) goto LendExtend1; /* no activation frame at all */
  56     if (ST_ARG_COUNT()<=0) goto LendExtend1; /* no args in act. frame */
  57     newenv[0] = autoMalloc( sizeof(int) * ST_ARG_COUNT() );
  58     ndx = 0;
  59 Lfor2:
  60     if (ndx>=ST_ARG_COUNT()) goto LendFor2;
  61     newenv[0][ndx] = ST_ARG(ndx);
  62     ++ndx;
  63     goto Lfor2;
  64 LendFor2:
  65 LendExtend1:
  66
  67     return newenv;
  68 }
  69
  70 /* Prepares the stack for a tail-call.
  71    Overrides the current activation frame with the new one,
  72    fixes sp,fp
  73 */
  74 void shiftActFrmDown()
  75 {
  76     int low;       /* lowest address of the new activation frame (included) */
  77     int high;      /* highest address of the new activation frame (included) */
  78     int dest_low;  /* lowest address where to put the new activation frame */
  79
  80     int old_fp = ST_OLDFP(); /* save it as its about to be overwritten */
  81
  82     /* Shift activation frame down the stack */
  83     low = fp;
  84     high = sp-1;
  85     dest_low = ST_FRMEND();
  86
  87     while (low <= high) {
  88         stack[dest_low] = stack[low];
  89         ++dest_low;
  90         ++low;
  91     }
  92
  93     /* Fix sp,fp */
  94     fp = old_fp;
  95     sp = dest_low;
  96 }
  97
  98 /* Shifts the elements in the stack upwards.
  99
 100    @param pos: index of the first element to shift
 101    @param amount: the number of elements to shift up each element by
 102
 103    Shifts up each element between `pos` and sp (inclusive) by `amount`.
 104 */
 105 void shiftStackUp(int pos, unsigned int amount)
 106 {
 107     int i;
 108
 109     /* shift elements upwards */
 110     for (i=sp-1; i>=pos; --i) {
 111         stack[i+amount] = stack[i];
 112     }
 113
 114     /* fix sp,fp */
 115     sp = sp + amount;
 116     fp = fp + amount;
 117 }
 118
 119 /* Shifts the elements in the stack downwards.
 120
 121    @param pos: index of the first element to shift
 122    @param amount: the number of elements to shift down each element by
 123
 124    Shifts down each element between `pos` and sp (inclusive) by `amount`.
 125 */
 126 void shiftStackDown(int pos, unsigned int amount)
 127 {
 128     int i;
 129
 130     /* shift elements downwards */
 131     for (i=pos; i<=sp-1; ++i) {
 132         stack[i-amount] = stack[i];
 133     }
 134
 135     /* fix sp,fp */
 136     sp = sp - amount;
 137     fp = fp - amount;
 138 }
 139
 140 /* Prepares the stack for an application of lambda-optional.
 141
 142    @param formalParams: the number of formal parameters the lambda
 143           expects, including the optional one.
 144
 145    Moves the optional parameters to a list in the heap.
 146 */
 147 void prepareStackForAbsOpt(int formalParams)
 148 {
 149     int actualParams = ST_ARG_COUNT();
 150     int optionalsUsed = actualParams-(formalParams-1);
 151
 152     ASSERT_ALWAYS( optionalsUsed>=0, "" );
 153
 154     if (optionalsUsed==0) {
 155         /* if the optional parameter was not used, initialize it to an
 156            empty list: */
 157
 158         /* make room for the optional param */
 159         shiftStackUp( ST_FRMEND(), 1 );
 160
 161         /* fix actual arguments number (also affects ST_FRMEND)*/
 162         ST_ARG_COUNT() = formalParams;
 163
 164         /* set it to () */
 165         stack[ ST_FRMEND() ] = (int)&sc_nil;
 166     }
 167     else {
 168         /* if the optional parameters were used, move them to a list
 169            on the heap: */
 170
 171         SchemeObject* opt;  /* the list of optional params */
 172         int lastOptional;   /* last opt. param. (lowest index) */
 173         int firstOptional;  /* first opt. param. (highest index) */
 174         int i;
 175
 176         /* copy optional params to a list on the heap */
 177         opt = &sc_nil;
 178         lastOptional = ST_FRMEND();
 179         firstOptional = lastOptional + (optionalsUsed-1);
 180
 181         for (i=lastOptional; i<=firstOptional; ++i) {
 182             opt = makeSchemePair( (SchemeObject*)(stack[i]), opt );
 183         }
 184
 185         /* override all but one optional */
 186         shiftStackDown( firstOptional, optionalsUsed-1 );
 187
 188         /* fix actual arguments number (also affects ST_FRMEND) */
 189         ST_ARG_COUNT() = formalParams;
 190
 191         /* the last parameter is a pointer to the new list */
 192         stack[ ST_FRMEND() ] = (int)opt;
 193     }
 194
 195 }
 196
 197 /* Reverses a Scheme list (in place)
 198
 199    @param list: the list to reverse
 200    @return: the reversed list
 201 */
 202 SchemeObject* reverseSchemeList( SchemeObject* list )
 203 {
 204     SchemeObject* prev;
 205     SchemeObject* curr;
 206     SchemeObject* next;
 207
 208     prev = &sc_nil;
 209     curr = list;
 210
 211     while ( curr!=&sc_nil ) {
 212         ASSERT_ALWAYS( IS_SOB_PAIR(curr), MSG_ERR_NOTLIST );
 213         next = SOB_PAIR_CDR(curr);
 214         SOB_PAIR_CDR(curr) = prev;
 215         prev = curr;
 216         curr = next;
 217     }
 218
 219     return prev;
 220 }
 221
 222 /* Pushes the argument list (and the number of arguments in the list
 223    onto the stack
 224
 225    @param list: the arguments list
 226
 227    The arguments are pushed backwards.
 228 */
 229 void pushArgsList(SchemeObject* list)
 230 {
 231     /* strategy:
 232         1. reverse list
 233         2. push each argument
 234         3. push the number of arguments
 235         4. reverse again
 236     */
 237
 238     SchemeObject* pair;
 239     int args_count;
 240
 241     list = reverseSchemeList( list );
 242
 243     args_count = 0;
 244     pair = list;
 245     while (pair != &sc_nil) {
 246         push( (int)SOB_PAIR_CAR(pair) );
 247         pair = SOB_PAIR_CDR(pair);
 248         args_count++;
 249     }
 250     push( args_count );
 251
 252     list = reverseSchemeList( list );
 253 }