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 void printActFrm(int p) {
   8     unsigned int fp,ret,env,n;
   9     unsigned int i;
  10
  11     fp = stack[p-1];
  12     ret = stack[p-2];
  13     env = stack[p-3];
  14     n = stack[p-4];
  15
  16     fprintf( stderr, "fp=0x%x\n", fp );
  17     fprintf( stderr, "ret=0x%x\n", ret );
  18     fprintf( stderr, "env=0x%x\n", env );
  19     fprintf( stderr, "n=%d\n"  , n );
  20     for (i=p-5; i>=p-5-n+1; i--)
  21         fprintf( stderr, "a[%d]=%s\n", -i+p-5, sobToString((SchemeObject*)(stack[i])) );
  22 }
  23
  24 /* Copies the enviroment vector currenv to a new vector of size
  25    (currenv_size+1) starting from element #1.
  26    Copies the arguments from the stack to element #0 of the new vector.
  27    Returns the new env. vector.
  28
  29    @param currenv: points to the current enviroment vector
  30    @param currenv_size: size of the current enviroment vector
  31 */
  32 int** extendEnviroment(int** currenv, int currenv_size)
  33 {
  34     int** newenv;   /* newenv: points to the new envoriment vector */
  35     int ndx;        /* ndx: loop index */
  36
  37     ASSERT_ALWAYS(currenv_size>=0,"");
  38
  39     /* allocate new enviroment vector */
  40     newenv = autoMalloc( sizeof(int) * (currenv_size + 1) );
  41
  42     /* copy current enviroment to new enviroment */
  43     ndx = currenv_size;
  44 Lfor1:
  45     if (ndx<=0) goto LendFor1;
  46     newenv[ndx] = currenv[ndx-1];
  47     --ndx;
  48     goto Lfor1;
  49 LendFor1:
  50     /* copy arguments from stack to new enviroment vector (extend env.) */
  51     if (currenv_size<=0) goto LendExtend1; /* no activation frame at all */
  52     if (ST_ARG_COUNT()<=0) goto LendExtend1; /* no args in act. frame */
  53     newenv[0] = autoMalloc( sizeof(int) * ST_ARG_COUNT() );
  54     ndx = 0;
  55 Lfor2:
  56     if (ndx>=ST_ARG_COUNT()) goto LendFor2;
  57     newenv[0][ndx] = ST_ARG(ndx);
  58     ++ndx;
  59     goto Lfor2;
  60 LendFor2:
  61 LendExtend1:
  62
  63     return newenv;
  64 }
  65
  66 /* Prepares the stack for a tail-call.
  67    Overrides the current activation frame with the new one,
  68    fixes sp,fp
  69 */
  70 void shiftActFrmDown()
  71 {
  72     int low;       /* lowest address of the new activation frame (included) */
  73     int high;      /* highest address of the new activation frame (included) */
  74     int dest_low;  /* lowest address where to put the new activation frame */
  75
  76     int old_fp = ST_OLDFP(); /* save it as its about to be overwritten */
  77
  78     /* Shift activation frame down the stack */
  79     low = fp;
  80     high = sp-1;
  81     dest_low = ST_FRMEND();
  82
  83     while (low <= high) {
  84         stack[dest_low] = stack[low];
  85         ++dest_low;
  86         ++low;
  87     }
  88
  89     /* Fix sp,fp */
  90     fp = old_fp;
  91     sp = dest_low;
  92 }
  93
  94 /* Shifts the elements in the stack upwards.
  95
  96    @param pos: index of the first element to shift
  97    @param amount: the number of elements to shift up each element by
  98
  99    Shifts up each element between `pos` and sp (inclusive) by `amount`.
 100 */
 101 void shiftStackUp(int pos, unsigned int amount)
 102 {
 103     int i;
 104
 105     /* shift elements upwards */
 106     for (i=sp-1; i>=pos; --i) {
 107         stack[i+amount] = stack[i];
 108     }
 109
 110     /* fix sp,fp */
 111     sp = sp + amount;
 112     fp = fp + amount;
 113 }
 114
 115 /* Shifts the elements in the stack downwards.
 116
 117    @param pos: index of the first element to shift
 118    @param amount: the number of elements to shift down each element by
 119
 120    Shifts down each element between `pos` and sp (inclusive) by `amount`.
 121 */
 122 void shiftStackDown(int pos, unsigned int amount)
 123 {
 124     int i;
 125
 126     /* shift elements downwards */
 127     for (i=pos; i<=sp-1; ++i) {
 128         stack[i-amount] = stack[i];
 129     }
 130
 131     /* fix sp,fp */
 132     sp = sp - amount;
 133     fp = fp - amount;
 134 }
 135
 136 /* Prepares the stack for an application of lambda-optional.
 137
 138    @param formalParams: the number of formal parameters the lambda
 139           expects, including the optional one.
 140
 141    Moves the optional parameters to a list in the heap.
 142 */
 143 void prepareStackForAbsOpt(int formalParams)
 144 {
 145     int actualParams = ST_ARG_COUNT();
 146     int optionalsUsed = actualParams-(formalParams-1);
 147
 148     ASSERT_ALWAYS( optionalsUsed>=0, "" );
 149
 150     if (optionalsUsed==0) {
 151         /* if the optional parameter was not used, initialize it to an
 152            empty list: */
 153
 154         /* make room for the optional param */
 155         shiftStackUp( ST_FRMEND(), 1 );
 156
 157         /* fix actual arguments number (also affects ST_FRMEND)*/
 158         ST_ARG_COUNT() = formalParams;
 159
 160         /* set it to () */
 161         stack[ ST_FRMEND() ] = (int)makeSchemeNil();
 162     }
 163     else {
 164         /* if the optional parameters were used, move them to a list
 165            on the heap: */
 166
 167         SchemeObject* opt;  /* the list of optional params */
 168         int lastOptional;   /* last opt. param. (lowest index) */
 169         int firstOptional;  /* first opt. param. (highest index) */
 170         int i;
 171
 172         /* copy optional params to a list on the heap */
 173         opt = makeSchemeNil();
 174         lastOptional = ST_FRMEND();
 175         firstOptional = lastOptional + (optionalsUsed-1);
 176
 177         for (i=lastOptional; i<=firstOptional; ++i) {
 178             opt = makeSchemePair( (SchemeObject*)(stack[i]), opt );
 179         }
 180
 181         /* override all but one optional */
 182         shiftStackDown( firstOptional, optionalsUsed-1 );
 183
 184         /* fix actual arguments number (also affects ST_FRMEND) */
 185         ST_ARG_COUNT() = formalParams;
 186
 187         /* the last parameter is a pointer to the new list */
 188         stack[ ST_FRMEND() ] = (int)opt;
 189     }
 190
 191 }